close Warning: Can't synchronize with repository "(default)" (The repository directory has changed, you should resynchronize the repository with: trac-admin $ENV repository resync '(default)'). Look in the Trac log for more information.

source: branches/f4grobner/mx-grobner.lisp

Last change on this file was 1940, checked in by Marek Rychlik, 9 years ago

* empty log message *
File size: 21.9 KB
Line 
1;;; -*- Mode: Lisp -*-
2;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
3;;;
4;;; Copyright (C) 1999, 2002, 2009, 2015 Marek Rychlik <rychlik@u.arizona.edu>
5;;;
6;;; This program is free software; you can redistribute it and/or modify
7;;; it under the terms of the GNU General Public License as published by
8;;; the Free Software Foundation; either version 2 of the License, or
9;;; (at your option) any later version.
10;;;
11;;; This program is distributed in the hope that it will be useful,
12;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
13;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
14;;; GNU General Public License for more details.
15;;;
16;;; You should have received a copy of the GNU General Public License
17;;; along with this program; if not, write to the Free Software
18;;; Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
19;;;
20;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
21
22;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
23;;
24;; Load this file into Maxima to bootstrap the Grobner package.
25;; NOTE: This file does use symbols defined by Maxima, so it
26;; will not work when loaded in Common Lisp.
27;;
28;; DETAILS: This file implements an interface between the Grobner
29;; basis package NGROBNER, which is a pure Common Lisp package, and
30;; Maxima. NGROBNER for efficiency uses its own representation of
31;; polynomials. Thus, it is necessary to convert Maxima representation
32;; to the internal representation and back. The facilities to do so
33;; are implemented in this file.
34;;
35;; Also, since the NGROBNER package consists of many Lisp files, it is
36;; necessary to load the files. It is possible and preferrable to use
37;; ASDF for this purpose. The default is ASDF. It is also possible to
38;; simply used LOAD and COMPILE-FILE to accomplish this task.
39;;
40;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
41
42(in-package :maxima)
43
44(macsyma-module cgb-maxima)
45
46
47(eval-when
48 #+gcl (load eval)
49 #-gcl (:load-toplevel :execute)
50 (format t "~&Loading maxima-grobner ~a ~a~%"
51 "$Revision: 2.0 $" "$Date: 2015/06/02 0:34:17 $"))
52
53;;FUNCTS is loaded because it contains the definition of LCM
54($load "functs")
55#+sbcl(progn (require 'asdf) (load "ngrobner.asd")(asdf:load-system :ngrobner))
56
57(use-package :ngrobner)
58
59;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
60;;
61;; Global switches
62;;
63;; Can be used in Maxima just fine, as they observe the
64;; Maxima naming convention, i.e. all names visible at the
65;; Maxima toplevel begin with a '$'.
66;;
67;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
68
69(defvar $poly_monomial_order '$lex
70 "This switch controls which monomial order is used in polynomial
71and Grobner basis calculations. If not set, LEX will be used")
72
73(defvar $poly_coefficient_ring '$expression_ring
74 "This switch indicates the coefficient ring of the polynomials
75that will be used in grobner calculations. If not set, Maxima's
76general expression ring will be used. This variable may be set
77to RING_OF_INTEGERS if desired.")
78
79(defvar $poly_primary_elimination_order nil
80 "Name of the default order for eliminated variables in elimination-based functions.
81If not set, LEX will be used.")
82
83(defvar $poly_secondary_elimination_order nil
84 "Name of the default order for kept variables in elimination-based functions.
85If not set, LEX will be used.")
86
87(defvar $poly_elimination_order nil
88 "Name of the default elimination order used in elimination calculations.
89If set, it overrides the settings in variables POLY_PRIMARY_ELIMINATION_ORDER
90and SECONDARY_ELIMINATION_ORDER. The user must ensure that this is a true
91elimination order valid for the number of eliminated variables.")
92
93(defvar $poly_return_term_list nil
94 "If set to T, all functions in this package will return each polynomial as a
95list of terms in the current monomial order rather than a Maxima general expression.")
96
97
98;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
99;;
100;; Maxima expression ring
101;;
102;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
103;;
104;; This is how we perform operations on coefficients
105;; using Maxima functions.
106;;
107;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
108
109(defparameter +maxima-ring+
110 (make-ring
111 ;;(defun coeff-zerop (expr) (meval1 `(($is) (($equal) ,expr 0))))
112 :parse #'(lambda (expr)
113 (when modulus (setf expr ($rat expr)))
114 expr)
115 :unit #'(lambda () (if modulus ($rat 1) 1))
116 :zerop #'(lambda (expr)
117 ;;When is exactly a maxima expression equal to 0?
118 (cond ((numberp expr)
119 (= expr 0))
120 ((atom expr) nil)
121 (t
122 (case (caar expr)
123 (mrat (eql ($ratdisrep expr) 0))
124 (otherwise (eql ($totaldisrep expr) 0))))))
125 :add #'(lambda (x y) (m+ x y))
126 :sub #'(lambda (x y) (m- x y))
127 :uminus #'(lambda (x) (m- x))
128 :mul #'(lambda (x y) (m* x y))
129 ;;(defun coeff-div (x y) (cadr ($divide x y)))
130 :div #'(lambda (x y) (m// x y))
131 :lcm #'(lambda (x y) (meval1 `((|$LCM|) ,x ,y)))
132 :ezgcd #'(lambda (x y) (apply #'values (cdr ($ezgcd ($totaldisrep x) ($totaldisrep y)))))
133 ;; :gcd #'(lambda (x y) (second ($ezgcd x y)))))
134 :gcd #'(lambda (x y) ($gcd x y))))
135
136;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
137;;
138;; Maxima expression parsing
139;;
140;;
141;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
142;;
143;; Functions and macros dealing with internal representation
144;; structure.
145;;
146;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
147
148(defun equal-test-p (expr1 expr2)
149 (alike1 expr1 expr2))
150
151(defun coerce-maxima-list (expr)
152 "Convert a Maxima list to Lisp list."
153 (cond
154 ((and (consp (car expr)) (eql (caar expr) 'mlist)) (cdr expr))
155 (t expr)))
156
157(defun free-of-vars (expr vars) (apply #'$freeof `(,@vars ,expr)))
158
159;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
160;;
161;; Order utilities
162;;
163;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
164
165(defun find-ring-by-name (ring)
166 "This function returns the ring structure bases on input symbol."
167 (cond
168 ((null ring) nil)
169 ((symbolp ring)
170 (case ring
171 ((maxima-ring :maxima-ring #:maxima-ring $expression_ring #:expression_ring)
172 +maxima-ring+)
173 ((ring-of-integers :ring-of-integers #:ring-of-integers $ring_of_integers) +ring-of-integers+)
174 (otherwise
175 (mtell "~%Warning: Ring ~M not found. Using default.~%" ring))))
176 (t
177 (mtell "~%Ring specification ~M is not recognized. Using default.~%" ring)
178 nil)))
179
180(defun find-order-by-name (order)
181 "This function returns the order function bases on its name."
182 (cond
183 ((null order) nil)
184 ((symbolp order)
185 (case order
186 ((lex :lex $lex #:lex)
187 #'lex>)
188 ((grlex :grlex $grlex #:grlex)
189 #'grlex>)
190 ((grevlex :grevlex $grevlex #:grevlex)
191 #'grevlex>)
192 ((invlex :invlex $invlex #:invlex)
193 #'invlex>)
194 (otherwise
195 (mtell "~%Warning: Order ~M not found. Using default.~%" order))))
196 (t
197 (mtell "~%Order specification ~M is not recognized. Using default.~%" order)
198 nil)))
199
200(defun find-ring-and-order-by-name (&optional
201 (ring (find-ring-by-name $poly_coefficient_ring))
202 (order (find-order-by-name $poly_monomial_order))
203 (primary-elimination-order (find-order-by-name $poly_primary_elimination_order))
204 (secondary-elimination-order (find-order-by-name $poly_secondary_elimination_order))
205 &aux
206 (ring-and-order (make-ring-and-order
207 :ring ring
208 :order order
209 :primary-elimination-order primary-elimination-order
210 :secondary-elimination-order secondary-elimination-order)))
211 "Build RING-AND-ORDER structure. The defaults are determined by various Maxima-level switches,
212which are names of ring and orders."
213 ring-and-order)
214
215(defun maxima->poly (expr vars
216 &optional
217 (ring-and-order (find-ring-and-order-by-name))
218 &aux
219 (vars (coerce-maxima-list vars))
220 (ring (ro-ring ring-and-order)))
221 "Convert a maxima polynomial expression EXPR in variables VARS to
222internal form. This works by first converting the expression to Lisp,
223and then evaluating the expression using polynomial arithmetic
224implemented by the POLYNOMIAL package."
225 (declare (type ring-and-order ring-and-order))
226 (labels ((parse (arg) (maxima->poly arg vars ring-and-order))
227 (parse-list (args) (mapcar #'parse args)))
228 (cond
229 ((eql expr 0) (make-poly-zero))
230 ((member expr vars :test #'equal-test-p)
231 (let ((pos (position expr vars :test #'equal-test-p)))
232 (make-poly-variable ring (length vars) pos)))
233 ((free-of-vars expr vars)
234 ;;This means that variable-free CRE and Poisson forms will be converted
235 ;;to coefficients intact
236 (coerce-coeff ring expr vars))
237 (t
238 (case (caar expr)
239 (mplus (reduce #'(lambda (x y) (poly-add ring-and-order x y)) (parse-list (cdr expr))))
240 (mminus (poly-uminus ring (parse (cadr expr))))
241 (mtimes
242 (if (endp (cddr expr)) ;unary
243 (parse (cdr expr))
244 (reduce #'(lambda (p q) (poly-mul ring-and-order p q)) (parse-list (cdr expr)))))
245 (mexpt
246 (cond
247 ((member (cadr expr) vars :test #'equal-test-p)
248 ;;Special handling of (expt var pow)
249 (let ((pos (position (cadr expr) vars :test #'equal-test-p)))
250 (make-poly-variable ring (length vars) pos (caddr expr))))
251 ((not (and (integerp (caddr expr)) (plusp (caddr expr))))
252 ;; Negative power means division in coefficient ring
253 ;; Non-integer power means non-polynomial coefficient
254 (mtell "~%Warning: Expression ~%~M~%contains power which is not a positive integer. Parsing as coefficient.~%"
255 expr)
256 (coerce-coeff ring expr vars))
257 (t (poly-expt ring-and-order (parse (cadr expr)) (caddr expr)))))
258 (mrat (parse ($ratdisrep expr)))
259 (mpois (parse ($outofpois expr)))
260 (otherwise
261 (coerce-coeff ring expr vars)))))))
262
263(defun maxima->poly-list (expr vars
264 &optional
265 (ring-and-order (find-ring-and-order-by-name)))
266 "Convert a Maxima representation of a list of polynomials to the internal form."
267 (declare (type ring-and-order ring-and-order))
268 (case (caar expr)
269 (mlist (mapcar #'(lambda (p)
270 (maxima->poly p vars ring-and-order))
271 (cdr expr)))
272 (otherwise (merror "Expression ~M is not a list of polynomials in variables ~M."
273 expr vars))))
274
275(defun maxima->poly-list-list (poly-list-of-lists vars
276 &optional
277 (ring-and-order (find-ring-and-order-by-name)))
278 "Parse a Maxima representation of a list of lists of polynomials."
279 (mapcar #'(lambda (g) (maxima->poly-list g vars ring-and-order))
280 (coerce-maxima-list poly-list-of-lists)))
281
282
283
284;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
285;;
286;; Conversion from internal form to Maxima general form
287;;
288;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
289
290(defun maxima-head ()
291 (if $poly_return_term_list
292 '(mlist)
293 '(mplus)))
294
295(defun poly->maxima (poly-type object vars)
296 (case poly-type
297 (:custom object) ;Bypass processing
298 (:polynomial
299 `(,(maxima-head) ,@(mapcar #'(lambda (term) (poly->maxima :term term vars)) (poly-termlist object))))
300 (:poly-list
301 `((mlist) ,@(mapcar #'(lambda (p) ($ratdisrep (poly->maxima :polynomial p vars))) object)))
302 (:term
303 `((mtimes) ,($ratdisrep (term-coeff object))
304 ,@(mapcar
305 #'(lambda (var power) `((mexpt) ,var ,power))
306 vars
307 (monom->list (term-monom object)))))
308 ;; Assumes that Lisp and Maxima logicals coincide
309 (:logical object)
310 (otherwise object)))
311
312;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
313;;
314;; Macro facility for writing Maxima-level wrappers for
315;; functions operating on internal representation.
316;;
317;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
318
319(defmacro with-ring-and-order (((maxima-vars &optional (maxima-new-vars nil new-vars-supplied-p))
320 &key
321 (polynomials nil)
322 (poly-lists nil)
323 (poly-list-lists nil)
324 (value-type nil)
325 (ring-and-order-var 'ring-and-order)
326 (ring-var 'ring))
327 &body
328 body
329 &aux
330 (vars (gensym))
331 (new-vars (gensym)))
332 "Evaluate a polynomial expression BODY in an environment
333constructred from Maxima switches. The supplied arguments
334POLYNOMIALS, POLY-LISTS and POLY-LIST-LISTS should be polynomials,
335polynomial lists an lists of lists of polynomials, in Maxima general
336form. These are translated to NGROBNER package internal form and
337evaluated using operations in the NGROBNER package. The BODY should be
338defined in terms of those operations. MAXIMA-VARS is set to the list
339of variable names used at the Maxima level. The evaluation is
340performed by the NGROBNER package which ignores variable names, thus
341MAXIMA-VARS is used only to translate the polynomial expression to
342NGROBNER internal form. After evaluation, the value of BODY is
343translated back to the Maxima general form. When MAXIMA-NEW-VARS is
344present, it is appended to MAXIMA-VARS upon translation from the
345internal form back to Maxima general form, thus allowing extra
346variables which may have been created by the evaluation process. The
347value type can be either :POLYNOMIAL, :POLY-LIST or :TERM, depending
348on the form of the result returned by the top NGROBNER operation.
349During evaluation, symbols supplied by RING-AND-ORDER-VAR (defaul
350value 'RING-AND-ORDER), and RING-VAR (default value 'RING) are bound
351to RING-AND-ORDER and RING instances."
352 `(let ((,vars (coerce-maxima-list ,maxima-vars))
353 ,@(when new-vars-supplied-p
354 (list `(,new-vars (coerce-maxima-list ,maxima-new-vars)))))
355 (poly->maxima
356 ,value-type
357 (let ((,ring-and-order-var ,(find-ring-and-order-by-name)))
358 ;; Define a shorthand to RING
359 (symbol-macrolet ((,ring-var (ro-ring ring-and-order)))
360 (let ,(let ((args nil))
361 (dolist (p polynomials args)
362 (setf args (cons `(,p (maxima->poly ,p ,vars ,ring-and-order-var)) args)))
363 (dolist (p poly-lists args)
364 (setf args (cons `(,p (maxima->poly-list ,p ,vars ,ring-and-order-var)) args)))
365 (dolist (p poly-list-lists args)
366 (setf args (cons `(,p (maxima->poly-list-list ,p ,vars ,ring-and-order-var)) args))))
367 . ,body)))
368 ,(if new-vars-supplied-p
369 `(append ,vars ,new-vars)
370 vars))))
371
372
373;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
374;;
375;; N-ary (unary and binary) operation definition facility
376;;
377;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
378
379(defmacro define-op (maxima-name ;Name of maxima level function
380 (fun-name env &rest args) ;Lisp level form to evaluate
381 &optional
382 (documentation nil documentation-supplied-p)
383 &aux
384 ;; The argument passed as first arg
385 (env-arg (ecase env
386 (:ring-and-order 'ring-and-order)
387 (:ring 'ring))))
388 "Define a MAXIMA-level unary operator MAXIMA-NAME corresponding to unary function FUN-NAME.
389The second argument should be :RING or :RING-AND-ORDER, and it signals
390the type of the first argument that should be passed to function
391FUN-NAME. ARGS is a list of formal parameters passed to the function,
392i.e. symbols used as arguments. The macro expands to a Maxima-level
393function definition with name MAXIMA-NAME, which wraps FUN-NAME."
394 `(defmfun ,maxima-name (,@args vars)
395 ,@(when documentation-supplied-p (list documentation))
396 (with-ring-and-order ((vars) :polynomials (,@args) :value-type :polynomial)
397 (,fun-name ,env-arg ,@args))))
398
399;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
400;;
401;; Maxima-level interface functions
402;;
403;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
404
405;; Auxillary function for removing zero polynomial
406(defun remzero (plist) (remove #'poly-zerop plist))
407
408;;Simple operators
409(define-op $poly_add (poly-add :ring-and-order p q)
410 "Adds two polynomials P and Q")
411
412(define-op $poly_subtract (poly-sub :ring-and-order p q)
413 "Subtracts a polynomial Q from P.")
414
415(define-op $poly_multiply (poly-mul :ring-and-order p q)
416 "Returns the product of polynomials P and Q.")
417
418(define-op $poly_s_polynomial (spoly :ring-and-order p q)
419 "Returns the syzygy polynomial (S-polynomial) of two polynomials P and Q.")
420
421(define-op $poly_primitive_part (poly-primitive-part :ring p)
422 "Returns the polynomial P divided by GCD of its coefficients.")
423
424(define-op $poly_normalize (poly-normalize :ring p)
425 "Returns the polynomial P divided by the leading coefficient.")
426
427
428;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
429;;
430;; More complex functions
431;;
432;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
433
434(defmfun $poly_expand (p vars)
435 "This function is equivalent to EXPAND(P) if P parses correctly to a polynomial.
436If the representation is not compatible with a polynomial in variables VARS,
437the result is an error."
438 (with-ring-and-order ((vars) :polynomials (p) :value-type :polynomial) p))
439
440
441(defmfun $poly_expt (p n vars)
442 (with-ring-and-order ((vars) :polynomials (p) :value-type :polynomial)
443 (poly-expt ring-and-order p n)))
444
445(defmfun $poly_content (p vars)
446 (with-ring-and-order ((vars) :polynomials (p))
447 (poly-content ring p)))
448
449(defmfun $poly_pseudo_divide (f fl mvars &aux (vars (coerce-maxima-list mvars)))
450 (with-ring-and-order ((mvars)
451 :polynomials (f)
452 :poly-lists (fl)
453 :value-type :custom)
454 (multiple-value-bind (quot rem c division-count)
455 (poly-pseudo-divide ring-and-order f fl)
456 `((mlist)
457 ,(poly->maxima :poly-list quot vars)
458 ,(poly->maxima :polynomial rem vars)
459 ,c
460 ,division-count))))
461
462(defmfun $poly_exact_divide (f g vars)
463 (with-ring-and-order ((vars) :polynomials (f g) :value-type :polynomial)
464 (poly-exact-divide ring-and-order f g)))
465
466(defmfun $poly_normal_form (f fl vars)
467 (with-ring-and-order ((vars) :polynomials (f)
468 :poly-lists (fl)
469 :value-type :polynomial)
470 (normal-form ring-and-order f (remzero fl) nil)))
471
472(defmfun $poly_buchberger_criterion (g vars)
473 (with-ring-and-order ((vars) :poly-lists (g) :value-type :logical)
474 (buchberger-criterion ring-and-order g)))
475
476(defmfun $poly_buchberger (fl vars)
477 (with-ring-and-order ((vars) :poly-lists (fl) :value-type :poly-list)
478 (buchberger ring-and-order (remzero fl) 0 nil)))
479
480(defmfun $poly_reduction (plist vars)
481 (with-ring-and-order ((vars) :poly-lists (plist)
482 :value-type :poly-list)
483 (reduction ring-and-order plist)))
484
485(defmfun $poly_minimization (plist vars)
486 (with-ring-and-order ((vars) :poly-lists (plist)
487 :value-type :poly-list)
488 (minimization plist)))
489
490(defmfun $poly_normalize_list (plist vars)
491 (with-ring-and-order ((vars) :poly-lists (plist)
492 :value-type :poly-list)
493 (poly-normalize-list ring plist)))
494
495(defmfun $poly_grobner (f vars)
496 (with-ring-and-order ((vars) :poly-lists (f)
497 :value-type :poly-list)
498 (grobner ring-and-order (remzero f))))
499
500(defmfun $poly_reduced_grobner (f vars)
501 (with-ring-and-order ((vars) :poly-lists (f)
502 :value-type :poly-list)
503 (reduced-grobner ring-and-order (remzero f))))
504
505(defmfun $poly_depends_p (p var mvars
506 &aux
507 (vars (coerce-maxima-list mvars))
508 (pos (position var vars)))
509 (with-ring-and-order ((mvars) :polynomials (p) :value-type :custom)
510 (if (null pos)
511 (merror "~%Variable ~M not in the list of variables ~M." var mvars)
512 (poly-depends-p p pos))))
513
514(defmfun $poly_elimination_ideal (flist k vars)
515 (with-ring-and-order ((vars) :poly-lists (flist)
516 :value-type :poly-list)
517 (elimination-ideal ring-and-order flist k nil 0)))
518
519(defmfun $poly_colon_ideal (f g vars)
520 (with-ring-and-order ((vars) :poly-lists (f g) :value-type :poly-list)
521 (colon-ideal ring-and-order f g nil)))
522
523(defmfun $poly_ideal_intersection (f g vars)
524 (with-ring-and-order ((vars) :poly-lists (f g) :value-type :poly-list)
525 (ideal-intersection ring-and-order f g nil)))
526
527(defmfun $poly_lcm (f g vars)
528 (with-ring-and-order ((vars) :polynomials (f g) :value-type :polynomial)
529 (poly-lcm ring-and-order f g)))
530
531(defmfun $poly_gcd (f g vars)
532 ($first ($divide (m* f g) ($poly_lcm f g vars))))
533
534(defmfun $poly_grobner_equal (g1 g2 vars)
535 (with-ring-and-order ((vars) :poly-lists (g1 g2))
536 (grobner-equal ring-and-order g1 g2)))
537
538(defmfun $poly_grobner_subsetp (g1 g2 vars)
539 (with-ring-and-order ((vars) :poly-lists (g1 g2))
540 (grobner-subsetp ring-and-order g1 g2)))
541
542(defmfun $poly_grobner_member (p g vars)
543 (with-ring-and-order ((vars) :polynomials (p) :poly-lists (g))
544 (grobner-member ring-and-order p g)))
545
546(defmfun $poly_ideal_saturation1 (f p vars)
547 (with-ring-and-order ((vars) :poly-lists (f) :polynomials (p)
548 :value-type :poly-list)
549 (ideal-saturation-1 ring-and-order f p 0)))
550
551(defmfun $poly_saturation_extension (f plist vars new-vars)
552 (with-ring-and-order ((vars new-vars)
553 :poly-lists (f plist)
554 :value-type :poly-list)
555 (saturation-extension ring f plist)))
556
557(defmfun $poly_polysaturation_extension (f plist vars new-vars)
558 (with-ring-and-order ((vars new-vars)
559 :poly-lists (f plist)
560 :value-type :poly-list)
561 (polysaturation-extension ring f plist)))
562
563(defmfun $poly_ideal_polysaturation1 (f plist vars)
564 (with-ring-and-order ((vars) :poly-lists (f plist)
565 :value-type :poly-list)
566 (ideal-polysaturation-1 ring-and-order f plist 0 nil)))
567
568(defmfun $poly_ideal_saturation (f g vars)
569 (with-ring-and-order ((vars) :poly-lists (f g)
570 :value-type :poly-list)
571 (ideal-saturation ring-and-order f g 0 nil)))
572
573(defmfun $poly_ideal_polysaturation (f ideal-list vars)
574 (with-ring-and-order ((vars) :poly-lists (f)
575 :poly-list-lists (ideal-list)
576 :value-type :poly-list)
577 (ideal-polysaturation ring-and-order f ideal-list 0 nil)))
578
579(defmfun $poly_lt (f vars)
580 (with-ring-and-order ((vars) :polynomials (f) :value-type :polynomial)
581 (make-poly-from-termlist (list (poly-lt f)))))
582
583(defmfun $poly_lm (f vars)
584 (with-ring-and-order ((vars) :polynomials (f) :value-type :polynomial)
585 (make-poly-from-termlist (list (make-term :monom (poly-lm f) :coeff (funcall (ring-unit ring)))))))
Note: See TracBrowser for help on using the repository browser.