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

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

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