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/grobner.lisp@ 97

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

* empty log message *

File size: 22.0 KB
Line 
1;;; -*- Mode: Lisp; Package: Maxima; Syntax: Common-Lisp; Base: 10 -*-
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;; Global switches
25;;
26;; Can be used in Maxima just fine, as they observe the
27;; Maxima naming convention, i.e. all names visible at the
28;; Maxima toplevel begin with a '$'.
29;;
30;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
31
32(defvar $poly_monomial_order '$lex
33 "This switch controls which monomial order is used in polynomial
34and Grobner basis calculations. If not set, LEX will be used")
35
36(defvar $poly_coefficient_ring '$expression_ring
37 "This switch indicates the coefficient ring of the polynomials
38that will be used in grobner calculations. If not set, Maxima's
39general expression ring will be used. This variable may be set
40to RING_OF_INTEGERS if desired.")
41
42(defvar $poly_primary_elimination_order nil
43 "Name of the default order for eliminated variables in elimination-based functions.
44If not set, LEX will be used.")
45
46(defvar $poly_secondary_elimination_order nil
47 "Name of the default order for kept variables in elimination-based functions.
48If not set, LEX will be used.")
49
50(defvar $poly_elimination_order nil
51 "Name of the default elimination order used in elimination calculations.
52If set, it overrides the settings in variables POLY_PRIMARY_ELIMINATION_ORDER
53and SECONDARY_ELIMINATION_ORDER. The user must ensure that this is a true
54elimination order valid for the number of eliminated variables.")
55
56(defvar $poly_return_term_list nil
57 "If set to T, all functions in this package will return each polynomial as a
58list of terms in the current monomial order rather than a Maxima general expression.")
59
60(defvar $poly_grobner_debug nil
61 "If set to TRUE, produce debugging and tracing output.")
62
63(defvar $poly_grobner_algorithm '$buchberger
64 "The name of the algorithm used to find grobner bases.")
65
66(defvar $poly_top_reduction_only nil
67 "If not FALSE, use top reduction only whenever possible.
68Top reduction means that division algorithm stops after the first reduction.")
69
70
71
72;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
73;;
74;; Coefficient ring operations
75;;
76;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
77;;
78;; These are ALL operations that are performed on the coefficients by
79;; the package, and thus the coefficient ring can be changed by merely
80;; redefining these operations.
81;;
82;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
83
84(defstruct (ring)
85 (parse #'identity :type function)
86 (unit #'identity :type function)
87 (zerop #'identity :type function)
88 (add #'identity :type function)
89 (sub #'identity :type function)
90 (uminus #'identity :type function)
91 (mul #'identity :type function)
92 (div #'identity :type function)
93 (lcm #'identity :type function)
94 (ezgcd #'identity :type function)
95 (gcd #'identity :type function))
96
97(defparameter *ring-of-integers*
98 (make-ring
99 :parse #'identity
100 :unit #'(lambda () 1)
101 :zerop #'zerop
102 :add #'+
103 :sub #'-
104 :uminus #'-
105 :mul #'*
106 :div #'/
107 :lcm #'lcm
108 :ezgcd #'(lambda (x y &aux (c (gcd x y))) (values c (/ x c) (/ y c)))
109 :gcd #'gcd)
110 "The ring of integers.")
111
112
113
114;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
115;;
116;; This is how we perform operations on coefficients
117;; using Maxima functions.
118;;
119;; Functions and macros dealing with internal representation structure
120;;
121;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
122
123
124;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
125;;
126;; Debugging/tracing
127;;
128;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
129(defmacro debug-cgb (&rest args)
130 `(when $poly_grobner_debug (format *terminal-io* ,@args)))
131
132
133
134;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
135;;
136;; These are provided mostly for debugging purposes To enable
137;; verification of grobner bases with BUCHBERGER-CRITERION, do
138;; (pushnew :grobner-check *features*) and compile/load this file.
139;; With this feature, the calculations will slow down CONSIDERABLY.
140;;
141;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
142
143(defun grobner-test (ring g f)
144 "Test whether G is a Grobner basis and F is contained in G. Return T
145upon success and NIL otherwise."
146 (debug-cgb "~&GROBNER CHECK: ")
147 (let (($poly_grobner_debug nil)
148 (stat1 (buchberger-criterion ring g))
149 (stat2
150 (every #'poly-zerop
151 (makelist (normal-form ring (copy-tree (elt f i)) g nil)
152 (i 0 (1- (length f)))))))
153 (unless stat1 (error "~&Buchberger criterion failed."))
154 (unless stat2
155 (error "~&Original polys not in ideal spanned by Grobner.")))
156 (debug-cgb "~&GROBNER CHECK END")
157 t)
158
159
160;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
161;;
162;; Selection of algorithm and pair heuristic
163;;
164;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
165
166(defun find-grobner-function (algorithm)
167 "Return a function which calculates Grobner basis, based on its
168names. Names currently used are either Lisp symbols, Maxima symbols or
169keywords."
170 (ecase algorithm
171 ((buchberger :buchberger $buchberger) #'buchberger)
172 ((parallel-buchberger :parallel-buchberger $parallel_buchberger) #'parallel-buchberger)
173 ((gebauer-moeller :gebauer_moeller $gebauer_moeller) #'gebauer-moeller)))
174
175(defun grobner (ring f &optional (start 0) (top-reduction-only nil))
176 ;;(setf F (sort F #'< :key #'sugar))
177 (funcall
178 (find-grobner-function $poly_grobner_algorithm)
179 ring f start top-reduction-only))
180
181(defun reduced-grobner (ring f &optional (start 0) (top-reduction-only $poly_top_reduction_only))
182 (reduction ring (grobner ring f start top-reduction-only)))
183
184(defun set-pair-heuristic (method)
185 "Sets up variables *PAIR-KEY-FUNCTION* and *PAIR-ORDER* used
186to determine the priority of critical pairs in the priority queue."
187 (ecase method
188 ((sugar :sugar $sugar)
189 (setf *pair-key-function* #'sugar-pair-key
190 *pair-order* #'sugar-order))
191; ((minimal-mock-spoly :minimal-mock-spoly $minimal_mock_spoly)
192; (setf *pair-key-function* #'mock-spoly
193; *pair-order* #'mock-spoly-order))
194 ((minimal-lcm :minimal-lcm $minimal_lcm)
195 (setf *pair-key-function* #'(lambda (p q)
196 (monom-lcm (poly-lm p) (poly-lm q)))
197 *pair-order* #'reverse-monomial-order))
198 ((minimal-total-degree :minimal-total-degree $minimal_total_degree)
199 (setf *pair-key-function* #'(lambda (p q)
200 (monom-total-degree
201 (monom-lcm (poly-lm p) (poly-lm q))))
202 *pair-order* #'<))
203 ((minimal-length :minimal-length $minimal_length)
204 (setf *pair-key-function* #'(lambda (p q)
205 (+ (poly-length p) (poly-length q)))
206 *pair-order* #'<))))
207
208
209
210
211;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
212;;
213;; Set up the coefficients to be polynomials
214;;
215;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
216
217;; (defun poly-ring (ring vars)
218;; (make-ring
219;; :parse #'(lambda (expr) (poly-eval ring expr vars))
220;; :unit #'(lambda () (poly-unit ring (length vars)))
221;; :zerop #'poly-zerop
222;; :add #'(lambda (x y) (poly-add ring x y))
223;; :sub #'(lambda (x y) (poly-sub ring x y))
224;; :uminus #'(lambda (x) (poly-uminus ring x))
225;; :mul #'(lambda (x y) (poly-mul ring x y))
226;; :div #'(lambda (x y) (poly-exact-divide ring x y))
227;; :lcm #'(lambda (x y) (poly-lcm ring x y))
228;; :ezgcd #'(lambda (x y &aux (gcd (poly-gcd ring x y)))
229;; (values gcd
230;; (poly-exact-divide ring x gcd)
231;; (poly-exact-divide ring y gcd)))
232;; :gcd #'(lambda (x y) (poly-gcd x y))))
233
234
235
236;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
237;;
238;; Conversion from internal to infix form
239;;
240;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
241
242(defun coerce-to-infix (poly-type object vars)
243 (case poly-type
244 (:termlist
245 `(+ ,@(mapcar #'(lambda (term) (coerce-to-infix :term term vars)) object)))
246 (:polynomial
247 (coerce-to-infix :termlist (poly-termlist object) vars))
248 (:poly-list
249 `([ ,@(mapcar #'(lambda (p) (coerce-to-infix :polynomial p vars)) object)))
250 (:term
251 `(* ,(term-coeff object)
252 ,@(mapcar #'(lambda (var power) `(expt ,var ,power))
253 vars (monom-exponents (term-monom object)))))
254 (otherwise
255 object)))
256
257
258
259;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
260;;
261;; Maxima expression ring
262;;
263;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
264
265(defparameter *expression-ring*
266 (make-ring
267 ;;(defun coeff-zerop (expr) (meval1 `(($is) (($equal) ,expr 0))))
268 :parse #'(lambda (expr)
269 (when modulus (setf expr ($rat expr)))
270 expr)
271 :unit #'(lambda () (if modulus ($rat 1) 1))
272 :zerop #'(lambda (expr)
273 ;;When is exactly a maxima expression equal to 0?
274 (cond ((numberp expr)
275 (= expr 0))
276 ((atom expr) nil)
277 (t
278 (case (caar expr)
279 (mrat (eql ($ratdisrep expr) 0))
280 (otherwise (eql ($totaldisrep expr) 0))))))
281 :add #'(lambda (x y) (m+ x y))
282 :sub #'(lambda (x y) (m- x y))
283 :uminus #'(lambda (x) (m- x))
284 :mul #'(lambda (x y) (m* x y))
285 ;;(defun coeff-div (x y) (cadr ($divide x y)))
286 :div #'(lambda (x y) (m// x y))
287 :lcm #'(lambda (x y) (meval1 `((|$LCM|) ,x ,y)))
288 :ezgcd #'(lambda (x y) (apply #'values (cdr ($ezgcd ($totaldisrep x) ($totaldisrep y)))))
289 ;; :gcd #'(lambda (x y) (second ($ezgcd x y)))))
290 :gcd #'(lambda (x y) ($gcd x y))))
291
292(defvar *maxima-ring* *expression-ring*
293 "The ring of coefficients, over which all polynomials
294are assumed to be defined.")
295
296
297;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
298;;
299;; Order utilities
300;;
301;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
302(defun find-order (order)
303 "This function returns the order function bases on its name."
304 (cond
305 ((null order) nil)
306 ((symbolp order)
307 (case order
308 ((lex :lex $lex) #'lex>)
309 ((grlex :grlex $grlex) #'grlex>)
310 ((grevlex :grevlex $grevlex) #'grevlex>)
311 ((invlex :invlex $invlex) #'invlex>)
312 ((elimination-order-1 :elimination-order-1 elimination_order_1) #'elimination-order-1)
313 (otherwise
314 (mtell "~%Warning: Order ~M not found. Using default.~%" order))))
315 (t
316 (mtell "~%Order specification ~M is not recognized. Using default.~%" order)
317 nil)))
318
319(defun find-ring (ring)
320 "This function returns the ring structure bases on input symbol."
321 (cond
322 ((null ring) nil)
323 ((symbolp ring)
324 (case ring
325 ((expression-ring :expression-ring $expression_ring) *expression-ring*)
326 ((ring-of-integers :ring-of-integers $ring_of_integers) *ring-of-integers*)
327 (otherwise
328 (mtell "~%Warning: Ring ~M not found. Using default.~%" ring))))
329 (t
330 (mtell "~%Ring specification ~M is not recognized. Using default.~%" ring)
331 nil)))
332
333(defmacro with-monomial-order ((order) &body body)
334 "Evaluate BODY with monomial order set to ORDER."
335 `(let ((*monomial-order* (or (find-order ,order) *monomial-order*)))
336 . ,body))
337
338(defmacro with-coefficient-ring ((ring) &body body)
339 "Evaluate BODY with coefficient ring set to RING."
340 `(let ((*maxima-ring* (or (find-ring ,ring) *maxima-ring*)))
341 . ,body))
342
343(defmacro with-elimination-orders ((primary secondary elimination-order)
344 &body body)
345 "Evaluate BODY with primary and secondary elimination orders set to PRIMARY and SECONDARY."
346 `(let ((*primary-elimination-order* (or (find-order ,primary) *primary-elimination-order*))
347 (*secondary-elimination-order* (or (find-order ,secondary) *secondary-elimination-order*))
348 (*elimination-order* (or (find-order ,elimination-order) *elimination-order*)))
349 . ,body))
350
351
352
353;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
354;;
355;; Conversion from internal form to Maxima general form
356;;
357;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
358
359(defun maxima-head ()
360 (if $poly_return_term_list
361 '(mlist)
362 '(mplus)))
363
364(defun coerce-to-maxima (poly-type object vars)
365 (case poly-type
366 (:polynomial
367 `(,(maxima-head) ,@(mapcar #'(lambda (term) (coerce-to-maxima :term term vars)) (poly-termlist object))))
368 (:poly-list
369 `((mlist) ,@(mapcar #'(lambda (p) ($ratdisrep (coerce-to-maxima :polynomial p vars))) object)))
370 (:term
371 `((mtimes) ,($ratdisrep (term-coeff object))
372 ,@(mapcar #'(lambda (var power) `((mexpt) ,var ,power))
373 vars (monom-exponents (term-monom object)))))
374 ;; Assumes that Lisp and Maxima logicals coincide
375 (:logical object)
376 (otherwise
377 object)))
378
379
380
381;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
382;;
383;; Macro facility for writing Maxima-level wrappers for
384;; functions operating on internal representation
385;;
386;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
387
388(defmacro with-parsed-polynomials (((maxima-vars &optional (maxima-new-vars nil new-vars-supplied-p))
389 &key (polynomials nil)
390 (poly-lists nil)
391 (poly-list-lists nil)
392 (value-type nil))
393 &body body
394 &aux (vars (gensym))
395 (new-vars (gensym)))
396 `(let ((,vars (coerce-maxima-list ,maxima-vars))
397 ,@(when new-vars-supplied-p
398 (list `(,new-vars (coerce-maxima-list ,maxima-new-vars)))))
399 (coerce-to-maxima
400 ,value-type
401 (with-coefficient-ring ($poly_coefficient_ring)
402 (with-monomial-order ($poly_monomial_order)
403 (with-elimination-orders ($poly_primary_elimination_order
404 $poly_secondary_elimination_order
405 $poly_elimination_order)
406 (let ,(let ((args nil))
407 (dolist (p polynomials args)
408 (setf args (cons `(,p (parse-poly ,p ,vars)) args)))
409 (dolist (p poly-lists args)
410 (setf args (cons `(,p (parse-poly-list ,p ,vars)) args)))
411 (dolist (p poly-list-lists args)
412 (setf args (cons `(,p (parse-poly-list-list ,p ,vars)) args))))
413 . ,body))))
414 ,(if new-vars-supplied-p
415 `(append ,vars ,new-vars)
416 vars))))
417
418(defmacro define-unop (maxima-name fun-name
419 &optional (documentation nil documentation-supplied-p))
420 "Define a MAXIMA-level unary operator MAXIMA-NAME corresponding to unary function FUN-NAME."
421 `(defun ,maxima-name (p vars
422 &aux
423 (vars (coerce-maxima-list vars))
424 (p (parse-poly p vars)))
425 ,@(when documentation-supplied-p (list documentation))
426 (coerce-to-maxima :polynomial (,fun-name *maxima-ring* p) vars)))
427
428(defmacro define-binop (maxima-name fun-name
429 &optional (documentation nil documentation-supplied-p))
430 "Define a MAXIMA-level binary operator MAXIMA-NAME corresponding to binary function FUN-NAME."
431 `(defmfun ,maxima-name (p q vars
432 &aux
433 (vars (coerce-maxima-list vars))
434 (p (parse-poly p vars))
435 (q (parse-poly q vars)))
436 ,@(when documentation-supplied-p (list documentation))
437 (coerce-to-maxima :polynomial (,fun-name *maxima-ring* p q) vars)))
438
439
440
441;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
442;;
443;; Maxima-level interface functions
444;;
445;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
446
447;; Auxillary function for removing zero polynomial
448(defun remzero (plist) (remove #'poly-zerop plist))
449
450;;Simple operators
451
452(define-binop $poly_add poly-add
453 "Adds two polynomials P and Q")
454
455(define-binop $poly_subtract poly-sub
456 "Subtracts a polynomial Q from P.")
457
458(define-binop $poly_multiply poly-mul
459 "Returns the product of polynomials P and Q.")
460
461(define-binop $poly_s_polynomial spoly
462 "Returns the syzygy polynomial (S-polynomial) of two polynomials P and Q.")
463
464(define-unop $poly_primitive_part poly-primitive-part
465 "Returns the polynomial P divided by GCD of its coefficients.")
466
467(define-unop $poly_normalize poly-normalize
468 "Returns the polynomial P divided by the leading coefficient.")
469
470;;Functions
471
472(defmfun $poly_expand (p vars)
473 "This function is equivalent to EXPAND(P) if P parses correctly to a polynomial.
474If the representation is not compatible with a polynomial in variables VARS,
475the result is an error."
476 (with-parsed-polynomials ((vars) :polynomials (p)
477 :value-type :polynomial)
478 p))
479
480(defmfun $poly_expt (p n vars)
481 (with-parsed-polynomials ((vars) :polynomials (p) :value-type :polynomial)
482 (poly-expt *maxima-ring* p n)))
483
484(defmfun $poly_content (p vars)
485 (with-parsed-polynomials ((vars) :polynomials (p))
486 (poly-content *maxima-ring* p)))
487
488(defmfun $poly_pseudo_divide (f fl vars
489 &aux (vars (coerce-maxima-list vars))
490 (f (parse-poly f vars))
491 (fl (parse-poly-list fl vars)))
492 (multiple-value-bind (quot rem c division-count)
493 (poly-pseudo-divide *maxima-ring* f fl)
494 `((mlist)
495 ,(coerce-to-maxima :poly-list quot vars)
496 ,(coerce-to-maxima :polynomial rem vars)
497 ,c
498 ,division-count)))
499
500(defmfun $poly_exact_divide (f g vars)
501 (with-parsed-polynomials ((vars) :polynomials (f g) :value-type :polynomial)
502 (poly-exact-divide *maxima-ring* f g)))
503
504(defmfun $poly_normal_form (f fl vars)
505 (with-parsed-polynomials ((vars) :polynomials (f)
506 :poly-lists (fl)
507 :value-type :polynomial)
508 (normal-form *maxima-ring* f (remzero fl) nil)))
509
510(defmfun $poly_buchberger_criterion (g vars)
511 (with-parsed-polynomials ((vars) :poly-lists (g) :value-type :logical)
512 (buchberger-criterion *maxima-ring* g)))
513
514(defmfun $poly_buchberger (fl vars)
515 (with-parsed-polynomials ((vars) :poly-lists (fl) :value-type :poly-list)
516 (buchberger *maxima-ring* (remzero fl) 0 nil)))
517
518(defmfun $poly_reduction (plist vars)
519 (with-parsed-polynomials ((vars) :poly-lists (plist)
520 :value-type :poly-list)
521 (reduction *maxima-ring* plist)))
522
523(defmfun $poly_minimization (plist vars)
524 (with-parsed-polynomials ((vars) :poly-lists (plist)
525 :value-type :poly-list)
526 (minimization plist)))
527
528(defmfun $poly_normalize_list (plist vars)
529 (with-parsed-polynomials ((vars) :poly-lists (plist)
530 :value-type :poly-list)
531 (poly-normalize-list *maxima-ring* plist)))
532
533(defmfun $poly_grobner (f vars)
534 (with-parsed-polynomials ((vars) :poly-lists (f)
535 :value-type :poly-list)
536 (grobner *maxima-ring* (remzero f))))
537
538(defmfun $poly_reduced_grobner (f vars)
539 (with-parsed-polynomials ((vars) :poly-lists (f)
540 :value-type :poly-list)
541 (reduced-grobner *maxima-ring* (remzero f))))
542
543(defmfun $poly_depends_p (p var mvars
544 &aux (vars (coerce-maxima-list mvars))
545 (pos (position var vars)))
546 (if (null pos)
547 (merror "~%Variable ~M not in the list of variables ~M." var mvars)
548 (poly-depends-p (parse-poly p vars) pos)))
549
550(defmfun $poly_elimination_ideal (flist k vars)
551 (with-parsed-polynomials ((vars) :poly-lists (flist)
552 :value-type :poly-list)
553 (elimination-ideal *maxima-ring* flist k nil 0)))
554
555(defmfun $poly_colon_ideal (f g vars)
556 (with-parsed-polynomials ((vars) :poly-lists (f g) :value-type :poly-list)
557 (colon-ideal *maxima-ring* f g nil)))
558
559(defmfun $poly_ideal_intersection (f g vars)
560 (with-parsed-polynomials ((vars) :poly-lists (f g) :value-type :poly-list)
561 (ideal-intersection *maxima-ring* f g nil)))
562
563(defmfun $poly_lcm (f g vars)
564 (with-parsed-polynomials ((vars) :polynomials (f g) :value-type :polynomial)
565 (poly-lcm *maxima-ring* f g)))
566
567(defmfun $poly_gcd (f g vars)
568 ($first ($divide (m* f g) ($poly_lcm f g vars))))
569
570(defmfun $poly_grobner_equal (g1 g2 vars)
571 (with-parsed-polynomials ((vars) :poly-lists (g1 g2))
572 (grobner-equal *maxima-ring* g1 g2)))
573
574(defmfun $poly_grobner_subsetp (g1 g2 vars)
575 (with-parsed-polynomials ((vars) :poly-lists (g1 g2))
576 (grobner-subsetp *maxima-ring* g1 g2)))
577
578(defmfun $poly_grobner_member (p g vars)
579 (with-parsed-polynomials ((vars) :polynomials (p) :poly-lists (g))
580 (grobner-member *maxima-ring* p g)))
581
582(defmfun $poly_ideal_saturation1 (f p vars)
583 (with-parsed-polynomials ((vars) :poly-lists (f) :polynomials (p)
584 :value-type :poly-list)
585 (ideal-saturation-1 *maxima-ring* f p 0)))
586
587(defmfun $poly_saturation_extension (f plist vars new-vars)
588 (with-parsed-polynomials ((vars new-vars)
589 :poly-lists (f plist)
590 :value-type :poly-list)
591 (saturation-extension *maxima-ring* f plist)))
592
593(defmfun $poly_polysaturation_extension (f plist vars new-vars)
594 (with-parsed-polynomials ((vars new-vars)
595 :poly-lists (f plist)
596 :value-type :poly-list)
597 (polysaturation-extension *maxima-ring* f plist)))
598
599(defmfun $poly_ideal_polysaturation1 (f plist vars)
600 (with-parsed-polynomials ((vars) :poly-lists (f plist)
601 :value-type :poly-list)
602 (ideal-polysaturation-1 *maxima-ring* f plist 0 nil)))
603
604(defmfun $poly_ideal_saturation (f g vars)
605 (with-parsed-polynomials ((vars) :poly-lists (f g)
606 :value-type :poly-list)
607 (ideal-saturation *maxima-ring* f g 0 nil)))
608
609(defmfun $poly_ideal_polysaturation (f ideal-list vars)
610 (with-parsed-polynomials ((vars) :poly-lists (f)
611 :poly-list-lists (ideal-list)
612 :value-type :poly-list)
613 (ideal-polysaturation *maxima-ring* f ideal-list 0 nil)))
614
615(defmfun $poly_lt (f vars)
616 (with-parsed-polynomials ((vars) :polynomials (f) :value-type :polynomial)
617 (make-poly-from-termlist (list (poly-lt f)))))
618
619(defmfun $poly_lm (f vars)
620 (with-parsed-polynomials ((vars) :polynomials (f) :value-type :polynomial)
621 (make-poly-from-termlist (list (make-term (poly-lm f) (funcall (ring-unit *maxima-ring*)))))))
622
Note: See TracBrowser for help on using the repository browser.