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@ 1817

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

* empty log message *

File size: 21.2 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;;
62;; Maxima expression ring
63;;
64;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
65;;
66;; This is how we perform operations on coefficients
67;; using Maxima functions.
68;;
69;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
70
71(defparameter +maxima-ring+
72 (make-ring
73 ;;(defun coeff-zerop (expr) (meval1 `(($is) (($equal) ,expr 0))))
74 :parse #'(lambda (expr)
75 (when modulus (setf expr ($rat expr)))
76 expr)
77 :unit #'(lambda () (if modulus ($rat 1) 1))
78 :zerop #'(lambda (expr)
79 ;;When is exactly a maxima expression equal to 0?
80 (cond ((numberp expr)
81 (= expr 0))
82 ((atom expr) nil)
83 (t
84 (case (caar expr)
85 (mrat (eql ($ratdisrep expr) 0))
86 (otherwise (eql ($totaldisrep expr) 0))))))
87 :add #'(lambda (x y) (m+ x y))
88 :sub #'(lambda (x y) (m- x y))
89 :uminus #'(lambda (x) (m- x))
90 :mul #'(lambda (x y) (m* x y))
91 ;;(defun coeff-div (x y) (cadr ($divide x y)))
92 :div #'(lambda (x y) (m// x y))
93 :lcm #'(lambda (x y) (meval1 `((|$LCM|) ,x ,y)))
94 :ezgcd #'(lambda (x y) (apply #'values (cdr ($ezgcd ($totaldisrep x) ($totaldisrep y)))))
95 ;; :gcd #'(lambda (x y) (second ($ezgcd x y)))))
96 :gcd #'(lambda (x y) ($gcd x y))))
97
98;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
99;;
100;; Maxima expression parsing
101;;
102;;
103;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
104;;
105;; Functions and macros dealing with internal representation
106;; structure.
107;;
108;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
109
110(defun equal-test-p (expr1 expr2)
111 (alike1 expr1 expr2))
112
113(defun coerce-maxima-list (expr)
114 "Convert a Maxima list to Lisp list."
115 (cond
116 ((and (consp (car expr)) (eql (caar expr) 'mlist)) (cdr expr))
117 (t expr)))
118
119(defun free-of-vars (expr vars) (apply #'$freeof `(,@vars ,expr)))
120
121;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
122;;
123;; Order utilities
124;;
125;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
126
127(defun find-ring-by-name (ring)
128 "This function returns the ring structure bases on input symbol."
129 (cond
130 ((null ring) nil)
131 ((symbolp ring)
132 (case ring
133 ((maxima-ring :maxima-ring #:maxima-ring $expression_ring #:expression_ring)
134 +maxima-ring+)
135 ((ring-of-integers :ring-of-integers #:ring-of-integers $ring_of_integers) +ring-of-integers+)
136 (otherwise
137 (mtell "~%Warning: Ring ~M not found. Using default.~%" ring))))
138 (t
139 (mtell "~%Ring specification ~M is not recognized. Using default.~%" ring)
140 nil)))
141
142(defun find-order-by-name (order)
143 "This function returns the order function bases on its name."
144 (cond
145 ((null order) nil)
146 ((symbolp order)
147 (case order
148 ((lex :lex $lex #:lex)
149 #'lex>)
150 ((grlex :grlex $grlex #:grlex)
151 #'grlex>)
152 ((grevlex :grevlex $grevlex #:grevlex)
153 #'grevlex>)
154 ((invlex :invlex $invlex #:invlex)
155 #'invlex>)
156 (otherwise
157 (mtell "~%Warning: Order ~M not found. Using default.~%" order))))
158 (t
159 (mtell "~%Order specification ~M is not recognized. Using default.~%" order)
160 nil)))
161
162(defun find-ring-and-order-by-name (&optional
163 (ring (find-ring-by-name $poly_coefficient_ring))
164 (order (find-order-by-name $poly_monomial_order))
165 (primary-elimination-order (find-order-by-name $poly_primary_elimination_order))
166 (secondary-elimination-order (find-order-by-name $poly_secondary_elimination_order))
167 &aux
168 (ring-and-order (make-ring-and-order
169 :ring ring
170 :order order
171 :primary-elimination-order primary-elimination-order
172 :secondary-elimination-order secondary-elimination-order)))
173 "Build RING-AND-ORDER structure. The defaults are determined by various Maxima-level switches,
174which are names of ring and orders."
175 ring-and-order)
176
177(defun maxima->poly (expr vars
178 &optional
179 (ring-and-order (find-ring-and-order-by-name))
180 &aux
181 (vars (coerce-maxima-list vars))
182 (ring (ro-ring ring-and-order)))
183 "Convert a maxima polynomial expression EXPR in variables VARS to
184internal form. This works by first converting the expression to Lisp,
185and then evaluating the expression using polynomial arithmetic
186implemented by the POLYNOMIAL package."
187 (labels ((parse (arg) (maxima->poly arg vars ring-and-order))
188 (parse-list (args) (mapcar #'parse args)))
189 (cond
190 ((eql expr 0) (make-poly-zero))
191 ((member expr vars :test #'equal-test-p)
192 (let ((pos (position expr vars :test #'equal-test-p)))
193 (make-poly-variable ring (length vars) pos)))
194 ((free-of-vars expr vars)
195 ;;This means that variable-free CRE and Poisson forms will be converted
196 ;;to coefficients intact
197 (coerce-coeff ring expr vars))
198 (t
199 (case (caar expr)
200 (mplus (reduce #'(lambda (x y) (poly-add ring-and-order x y)) (parse-list (cdr expr))))
201 (mminus (poly-uminus ring (parse (cadr expr))))
202 (mtimes
203 (if (endp (cddr expr)) ;unary
204 (parse (cdr expr))
205 (reduce #'(lambda (p q) (poly-mul ring-and-order p q)) (parse-list (cdr expr)))))
206 (mexpt
207 (cond
208 ((member (cadr expr) vars :test #'equal-test-p)
209 ;;Special handling of (expt var pow)
210 (let ((pos (position (cadr expr) vars :test #'equal-test-p)))
211 (make-poly-variable ring (length vars) pos (caddr expr))))
212 ((not (and (integerp (caddr expr)) (plusp (caddr expr))))
213 ;; Negative power means division in coefficient ring
214 ;; Non-integer power means non-polynomial coefficient
215 (mtell "~%Warning: Expression ~%~M~%contains power which is not a positive integer. Parsing as coefficient.~%"
216 expr)
217 (coerce-coeff ring expr vars))
218 (t (poly-expt ring-and-order (parse (cadr expr)) (caddr expr)))))
219 (mrat (parse ($ratdisrep expr)))
220 (mpois (parse ($outofpois expr)))
221 (otherwise
222 (coerce-coeff ring expr vars)))))))
223
224(defun maxima->poly-list (expr vars
225 &optional
226 (ring-and-order (find-ring-and-order-by-name)))
227 "Convert a Maxima representation of a list of polynomials to the internal form."
228 (case (caar expr)
229 (mlist (mapcar #'(lambda (p)
230 (maxima->poly p vars ring-and-order))
231 (cdr expr)))
232 (otherwise (merror "Expression ~M is not a list of polynomials in variables ~M."
233 expr vars))))
234
235(defun maxima->poly-list-list (poly-list-of-lists vars
236 &optional
237 (ring-and-order (find-ring-and-order-by-name)))
238 "Parse a Maxima representation of a list of lists of polynomials."
239 (mapcar #'(lambda (g) (maxima->poly-list g vars ring-and-order))
240 (coerce-maxima-list poly-list-of-lists)))
241
242
243
244;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
245;;
246;; Conversion from internal form to Maxima general form
247;;
248;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
249
250(defun maxima-head ()
251 (if $poly_return_term_list
252 '(mlist)
253 '(mplus)))
254
255(defun poly->maxima (poly-type object vars)
256 (case poly-type
257 (:custom object) ;Bypass processing
258 (:polynomial
259 `(,(maxima-head) ,@(mapcar #'(lambda (term) (poly->maxima :term term vars)) (poly-termlist object))))
260 (:poly-list
261 `((mlist) ,@(mapcar #'(lambda (p) ($ratdisrep (poly->maxima :polynomial p vars))) object)))
262 (:term
263 `((mtimes) ,($ratdisrep (term-coeff object))
264 ,@(mapcar #'(lambda (var power) `((mexpt) ,var ,power))
265 vars (monom->list (term-monom object)))))
266 ;; Assumes that Lisp and Maxima logicals coincide
267 (:logical object)
268 (otherwise
269 object)))
270
271
272;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
273;;
274;; Facilities for evaluating Grobner package expressions
275;; within a prepared environment
276;;
277;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
278
279#|
280(defmacro with-monomial-order ((order) &body body)
281 "Evaluate BODY with monomial order set to ORDER."
282 `(let ((*monomial-order* (or (find-order ,order) *monomial-order*)))
283 . ,body))
284
285(defmacro with-coefficient-ring ((ring) &body body)
286 "Evaluate BODY with coefficient ring set to RING."
287 `(let ((+maxima-ring+ (or (find-ring ,ring) +maxima-ring+)))
288 . ,body))
289
290(defmacro with-ring-and-order ((ring order) &body body)
291 "Evaluate BODY with monomial order set to ORDER and coefficient ring set to RING."
292 `(let ((*monomial-order* (or (find-order ,order) *monomial-order*))
293 (+maxima-ring+ (or (find-ring ,ring) +maxima-ring+)))
294 . ,body))
295
296(defmacro with-elimination-orders ((primary secondary elimination-order)
297 &body body)
298 "Evaluate BODY with primary and secondary elimination orders set to PRIMARY and SECONDARY."
299 `(let ((*primary-elimination-order* (or (find-order ,primary) *primary-elimination-order*))
300 (*secondary-elimination-order* (or (find-order ,secondary) *secondary-elimination-order*))
301 (*elimination-order* (or (find-order ,elimination-order) *elimination-order*)))
302 . ,body))
303
304|#
305
306
307;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
308;;
309;; Macro facility for writing Maxima-level wrappers for
310;; functions operating on internal representation
311;;
312;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
313
314(defmacro with-ring-and-order (((maxima-vars &optional (maxima-new-vars nil new-vars-supplied-p))
315 &key
316 (polynomials nil)
317 (poly-lists nil)
318 (poly-list-lists nil)
319 (value-type nil)
320 (ring-and-order-var 'ring-and-order)
321 (ring-var 'ring))
322 &body
323 body
324 &aux
325 (vars (gensym))
326 (new-vars (gensym)))
327 "Evaluate a polynomial expression BODY in an environment
328constructred from Maxima switches. The supplied arguments
329POLYNOMIALS, POLY-LISTS and POLY-LIST-LISTS should be polynomials,
330polynomial lists an lists of lists of polynomials, in Maxima general
331form. These are translated to NGROBNER package internal form and
332evaluated using operations in the NGROBNER package. The BODY should be
333defined in terms of those operations. MAXIMA-VARS is set to the list
334of variable names used at the Maxima level. The evaluation is
335performed by the NGROBNER package which ignores variable names, thus
336MAXIMA-VARS is used only to translate the polynomial expression to
337NGROBNER internal form. After evaluation, the value of BODY is
338translated back to the Maxima general form. When MAXIMA-NEW-VARS is
339present, it is appended to MAXIMA-VARS upon translation from the
340internal form back to Maxima general form, thus allowing extra
341variables which may have been created by the evaluation process. The
342value type can be either :POLYNOMIAL, :POLY-LIST or :TERM, depending
343on the form of the result returned by the top NGROBNER operation.
344During evaluation, symbols supplied by RING-AND-ORDER-VAR (defaul
345value 'RING-AND-ORDER), and RING-VAR (default value 'RING) are bound
346to RING-AND-ORDER and RING instances."
347 `(let ((,vars (coerce-maxima-list ,maxima-vars))
348 ,@(when new-vars-supplied-p
349 (list `(,new-vars (coerce-maxima-list ,maxima-new-vars)))))
350 (poly->maxima
351 ,value-type
352 (let ((,ring-and-order-var ,(find-ring-and-order-by-name)))
353 ;; Define a shorthand to RING
354 (symbol-macrolet ((,ring-var (ro-ring ring-and-order)))
355 (let ,(let ((args nil))
356 (dolist (p polynomials args)
357 (setf args (cons `(,p (maxima->poly ,p ,vars ,ring-and-order-var)) args)))
358 (dolist (p poly-lists args)
359 (setf args (cons `(,p (maxima->poly-list ,p ,vars ,ring-and-order-var)) args)))
360 (dolist (p poly-list-lists args)
361 (setf args (cons `(,p (maxima->poly-list-list ,p ,vars ,ring-and-order-var)) args))))
362 . ,body)))
363 ,(if new-vars-supplied-p
364 `(append ,vars ,new-vars)
365 vars))))
366
367
368;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
369;;
370;; N-ary (unary and binary) operation definition facility
371;;
372;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
373
374(defmacro define-op (maxima-name ;Name of maxima level function
375 (fun-name env &rest args) ;Lisp level form to evaluate
376 &optional
377 (documentation nil documentation-supplied-p)
378 &aux
379 ;; The argument passed as first arg
380 (env-arg (ecase env
381 (:ring-and-order 'ring-and-order)
382 (:ring 'ring))))
383 "Define a MAXIMA-level unary operator MAXIMA-NAME corresponding to unary function FUN-NAME."
384 `(defmfun ,maxima-name (,@args vars)
385 ,@(when documentation-supplied-p (list documentation))
386 (with-ring-and-order ((vars) :polynomials (,@args) :value-type :polynomial)
387 (,fun-name ,env-arg ,@args))))
388
389;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
390;;
391;; Maxima-level interface functions
392;;
393;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
394
395;; Auxillary function for removing zero polynomial
396(defun remzero (plist) (remove #'poly-zerop plist))
397
398;;Simple operators
399(define-op $poly_add (poly-add :ring-and-order p q)
400 "Adds two polynomials P and Q")
401
402(define-op $poly_subtract (poly-sub :ring-and-order p q))
403 "Subtracts a polynomial Q from P.")
404
405(define-op $poly_multiply (poly-mul :ring-and-order p q)
406 "Returns the product of polynomials P and Q.")
407
408(define-op ($poly_s_polynomial spoly (p q))
409 "Returns the syzygy polynomial (S-polynomial) of two polynomials P and Q.")
410
411(define-op ($poly_primitive_part poly-primitive-part (p) :env :ring)
412 "Returns the polynomial P divided by GCD of its coefficients.")
413
414(define-op ($poly_normalize poly-normalize (p) :env :ring)
415 "Returns the polynomial P divided by the leading coefficient.")
416
417|#
418
419;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
420;;
421;; More complex functions
422;;
423;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
424
425(defmfun $poly_expand (p vars)
426 "This function is equivalent to EXPAND(P) if P parses correctly to a polynomial.
427If the representation is not compatible with a polynomial in variables VARS,
428the result is an error."
429 (with-ring-and-order ((vars) :polynomials (p) :value-type :polynomial) p))
430
431
432(defmfun $poly_expt (p n vars)
433 (with-ring-and-order ((vars) :polynomials (p) :value-type :polynomial)
434 (poly-expt ring-and-order p n)))
435
436(defmfun $poly_content (p vars)
437 (with-ring-and-order ((vars) :polynomials (p))
438 (poly-content ring p)))
439
440#|
441(defmfun $poly_pseudo_divide (f fl vars)
442 (with-ring-and-order ((vars)
443 :polynomials (f)
444 :poly-lists (fl)
445 :value-type :custom)
446 (multiple-value-bind (quot rem c division-count)
447 (poly-pseudo-divide ring-and-order f fl)
448 `((mlist)
449 ,(poly->maxima :poly-list quot vars)
450 ,(poly->maxima :polynomial rem vars)
451 ,c
452 ,division-count))))
453|#
454
455
456(defmfun $poly_exact_divide (f g vars)
457 (with-ring-and-order ((vars) :polynomials (f g) :value-type :polynomial)
458 (poly-exact-divide ring-and-order f g)))
459
460(defmfun $poly_normal_form (f fl vars)
461 (with-ring-and-order ((vars) :polynomials (f)
462 :poly-lists (fl)
463 :value-type :polynomial)
464 (normal-form ring-and-order f (remzero fl) nil)))
465
466(defmfun $poly_buchberger_criterion (g vars)
467 (with-ring-and-order ((vars) :poly-lists (g) :value-type :logical)
468 (buchberger-criterion ring-and-order g)))
469
470(defmfun $poly_buchberger (fl vars)
471 (with-ring-and-order ((vars) :poly-lists (fl) :value-type :poly-list)
472 (buchberger ring-and-order (remzero fl) 0 nil)))
473
474(defmfun $poly_reduction (plist vars)
475 (with-ring-and-order ((vars) :poly-lists (plist)
476 :value-type :poly-list)
477 (reduction ring-and-order plist)))
478
479(defmfun $poly_minimization (plist vars)
480 (with-ring-and-order ((vars) :poly-lists (plist)
481 :value-type :poly-list)
482 (minimization plist)))
483
484(defmfun $poly_normalize_list (plist vars)
485 (with-ring-and-order ((vars) :poly-lists (plist)
486 :value-type :poly-list)
487 (poly-normalize-list ring plist)))
488
489(defmfun $poly_grobner (f vars)
490 (with-ring-and-order ((vars) :poly-lists (f)
491 :value-type :poly-list)
492 (grobner ring-and-order (remzero f))))
493
494(defmfun $poly_reduced_grobner (f vars)
495 (with-ring-and-order ((vars) :poly-lists (f)
496 :value-type :poly-list)
497 (reduced-grobner ring-and-order (remzero f))))
498
499(defmfun $poly_depends_p (p var mvars
500 &aux
501 (vars (coerce-maxima-list mvars))
502 (pos (position var vars)))
503 (with-ring-and-order ((mvars) :polynomials (p) :value-type :custom)
504 (if (null pos)
505 (merror "~%Variable ~M not in the list of variables ~M." var mvars)
506 (poly-depends-p p pos))))
507
508(defmfun $poly_elimination_ideal (flist k vars)
509 (with-ring-and-order ((vars) :poly-lists (flist)
510 :value-type :poly-list)
511 (elimination-ideal ring-and-order flist k nil 0)))
512
513(defmfun $poly_colon_ideal (f g vars)
514 (with-ring-and-order ((vars) :poly-lists (f g) :value-type :poly-list)
515 (colon-ideal ring-and-order f g nil)))
516
517(defmfun $poly_ideal_intersection (f g vars)
518 (with-ring-and-order ((vars) :poly-lists (f g) :value-type :poly-list)
519 (ideal-intersection ring-and-order f g nil)))
520
521(defmfun $poly_lcm (f g vars)
522 (with-ring-and-order ((vars) :polynomials (f g) :value-type :polynomial)
523 (poly-lcm ring-and-order f g)))
524
525(defmfun $poly_gcd (f g vars)
526 ($first ($divide (m* f g) ($poly_lcm f g vars))))
527
528(defmfun $poly_grobner_equal (g1 g2 vars)
529 (with-ring-and-order ((vars) :poly-lists (g1 g2))
530 (grobner-equal ring-and-order g1 g2)))
531
532(defmfun $poly_grobner_subsetp (g1 g2 vars)
533 (with-ring-and-order ((vars) :poly-lists (g1 g2))
534 (grobner-subsetp ring-and-order g1 g2)))
535
536(defmfun $poly_grobner_member (p g vars)
537 (with-ring-and-order ((vars) :polynomials (p) :poly-lists (g))
538 (grobner-member ring-and-order p g)))
539
540(defmfun $poly_ideal_saturation1 (f p vars)
541 (with-ring-and-order ((vars) :poly-lists (f) :polynomials (p)
542 :value-type :poly-list)
543 (ideal-saturation-1 ring-and-order f p 0)))
544
545(defmfun $poly_saturation_extension (f plist vars new-vars)
546 (with-ring-and-order ((vars new-vars)
547 :poly-lists (f plist)
548 :value-type :poly-list)
549 (saturation-extension ring f plist)))
550
551(defmfun $poly_polysaturation_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 (polysaturation-extension ring f plist)))
556
557(defmfun $poly_ideal_polysaturation1 (f plist vars)
558 (with-ring-and-order ((vars) :poly-lists (f plist)
559 :value-type :poly-list)
560 (ideal-polysaturation-1 ring-and-order f plist 0 nil)))
561
562(defmfun $poly_ideal_saturation (f g vars)
563 (with-ring-and-order ((vars) :poly-lists (f g)
564 :value-type :poly-list)
565 (ideal-saturation ring-and-order f g 0 nil)))
566
567(defmfun $poly_ideal_polysaturation (f ideal-list vars)
568 (with-ring-and-order ((vars) :poly-lists (f)
569 :poly-list-lists (ideal-list)
570 :value-type :poly-list)
571 (ideal-polysaturation ring-and-order f ideal-list 0 nil)))
572
573(defmfun $poly_lt (f vars)
574 (with-ring-and-order ((vars) :polynomials (f) :value-type :polynomial)
575 (make-poly-from-termlist (list (poly-lt f)))))
576
577(defmfun $poly_lm (f vars)
578 (with-ring-and-order ((vars) :polynomials (f) :value-type :polynomial)
579 (make-poly-from-termlist (list (make-term (poly-lm f) (funcall (ring-unit ring)))))))
Note: See TracBrowser for help on using the repository browser.