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

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

* empty log message *
File size: 19.9 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;; Conversion from internal to infix form
214;;
215;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
216
217(defun coerce-to-infix (poly-type object vars)
218 (case poly-type
219 (:termlist
220 `(+ ,@(mapcar #'(lambda (term) (coerce-to-infix :term term vars)) object)))
221 (:polynomial
222 (coerce-to-infix :termlist (poly-termlist object) vars))
223 (:poly-list
224 `([ ,@(mapcar #'(lambda (p) (coerce-to-infix :polynomial p vars)) object)))
225 (:term
226 `(* ,(term-coeff object)
227 ,@(mapcar #'(lambda (var power) `(expt ,var ,power))
228 vars (monom-exponents (term-monom object)))))
229 (otherwise
230 object)))
231
232
233;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
234;;
235;; Order utilities
236;;
237;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
238(defun find-order (order)
239 "This function returns the order function bases on its name."
240 (cond
241 ((null order) nil)
242 ((symbolp order)
243 (case order
244 ((lex :lex $lex) #'lex>)
245 ((grlex :grlex $grlex) #'grlex>)
246 ((grevlex :grevlex $grevlex) #'grevlex>)
247 ((invlex :invlex $invlex) #'invlex>)
248 ((elimination-order-1 :elimination-order-1 elimination_order_1) #'elimination-order-1)
249 (otherwise
250 (mtell "~%Warning: Order ~M not found. Using default.~%" order))))
251 (t
252 (mtell "~%Order specification ~M is not recognized. Using default.~%" order)
253 nil)))
254
255(defun find-ring (ring)
256 "This function returns the ring structure bases on input symbol."
257 (cond
258 ((null ring) nil)
259 ((symbolp ring)
260 (case ring
261 ((expression-ring :expression-ring $expression_ring) *expression-ring*)
262 ((ring-of-integers :ring-of-integers $ring_of_integers) *ring-of-integers*)
263 (otherwise
264 (mtell "~%Warning: Ring ~M not found. Using default.~%" ring))))
265 (t
266 (mtell "~%Ring specification ~M is not recognized. Using default.~%" ring)
267 nil)))
268
269(defmacro with-monomial-order ((order) &body body)
270 "Evaluate BODY with monomial order set to ORDER."
271 `(let ((*monomial-order* (or (find-order ,order) *monomial-order*)))
272 . ,body))
273
274(defmacro with-coefficient-ring ((ring) &body body)
275 "Evaluate BODY with coefficient ring set to RING."
276 `(let ((*maxima-ring* (or (find-ring ,ring) *maxima-ring*)))
277 . ,body))
278
279(defmacro with-elimination-orders ((primary secondary elimination-order)
280 &body body)
281 "Evaluate BODY with primary and secondary elimination orders set to PRIMARY and SECONDARY."
282 `(let ((*primary-elimination-order* (or (find-order ,primary) *primary-elimination-order*))
283 (*secondary-elimination-order* (or (find-order ,secondary) *secondary-elimination-order*))
284 (*elimination-order* (or (find-order ,elimination-order) *elimination-order*)))
285 . ,body))
286
287
288
289;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
290;;
291;; Conversion from internal form to Maxima general form
292;;
293;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
294
295(defun maxima-head ()
296 (if $poly_return_term_list
297 '(mlist)
298 '(mplus)))
299
300(defun coerce-to-maxima (poly-type object vars)
301 (case poly-type
302 (:polynomial
303 `(,(maxima-head) ,@(mapcar #'(lambda (term) (coerce-to-maxima :term term vars)) (poly-termlist object))))
304 (:poly-list
305 `((mlist) ,@(mapcar #'(lambda (p) ($ratdisrep (coerce-to-maxima :polynomial p vars))) object)))
306 (:term
307 `((mtimes) ,($ratdisrep (term-coeff object))
308 ,@(mapcar #'(lambda (var power) `((mexpt) ,var ,power))
309 vars (monom-exponents (term-monom object)))))
310 ;; Assumes that Lisp and Maxima logicals coincide
311 (:logical object)
312 (otherwise
313 object)))
314
315
316
317;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
318;;
319;; Macro facility for writing Maxima-level wrappers for
320;; functions operating on internal representation
321;;
322;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
323
324(defmacro with-parsed-polynomials (((maxima-vars &optional (maxima-new-vars nil new-vars-supplied-p))
325 &key (polynomials nil)
326 (poly-lists nil)
327 (poly-list-lists nil)
328 (value-type nil))
329 &body body
330 &aux (vars (gensym))
331 (new-vars (gensym)))
332 `(let ((,vars (coerce-maxima-list ,maxima-vars))
333 ,@(when new-vars-supplied-p
334 (list `(,new-vars (coerce-maxima-list ,maxima-new-vars)))))
335 (coerce-to-maxima
336 ,value-type
337 (with-coefficient-ring ($poly_coefficient_ring)
338 (with-monomial-order ($poly_monomial_order)
339 (with-elimination-orders ($poly_primary_elimination_order
340 $poly_secondary_elimination_order
341 $poly_elimination_order)
342 (let ,(let ((args nil))
343 (dolist (p polynomials args)
344 (setf args (cons `(,p (parse-poly ,p ,vars)) args)))
345 (dolist (p poly-lists args)
346 (setf args (cons `(,p (parse-poly-list ,p ,vars)) args)))
347 (dolist (p poly-list-lists args)
348 (setf args (cons `(,p (parse-poly-list-list ,p ,vars)) args))))
349 . ,body))))
350 ,(if new-vars-supplied-p
351 `(append ,vars ,new-vars)
352 vars))))
353
354(defmacro define-unop (maxima-name fun-name
355 &optional (documentation nil documentation-supplied-p))
356 "Define a MAXIMA-level unary operator MAXIMA-NAME corresponding to unary function FUN-NAME."
357 `(defun ,maxima-name (p vars
358 &aux
359 (vars (coerce-maxima-list vars))
360 (p (parse-poly p vars)))
361 ,@(when documentation-supplied-p (list documentation))
362 (coerce-to-maxima :polynomial (,fun-name *maxima-ring* p) vars)))
363
364(defmacro define-binop (maxima-name fun-name
365 &optional (documentation nil documentation-supplied-p))
366 "Define a MAXIMA-level binary operator MAXIMA-NAME corresponding to binary function FUN-NAME."
367 `(defmfun ,maxima-name (p q vars
368 &aux
369 (vars (coerce-maxima-list vars))
370 (p (parse-poly p vars))
371 (q (parse-poly q vars)))
372 ,@(when documentation-supplied-p (list documentation))
373 (coerce-to-maxima :polynomial (,fun-name *maxima-ring* p q) vars)))
374
375
376
377;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
378;;
379;; Maxima-level interface functions
380;;
381;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
382
383;; Auxillary function for removing zero polynomial
384(defun remzero (plist) (remove #'poly-zerop plist))
385
386;;Simple operators
387
388(define-binop $poly_add poly-add
389 "Adds two polynomials P and Q")
390
391(define-binop $poly_subtract poly-sub
392 "Subtracts a polynomial Q from P.")
393
394(define-binop $poly_multiply poly-mul
395 "Returns the product of polynomials P and Q.")
396
397(define-binop $poly_s_polynomial spoly
398 "Returns the syzygy polynomial (S-polynomial) of two polynomials P and Q.")
399
400(define-unop $poly_primitive_part poly-primitive-part
401 "Returns the polynomial P divided by GCD of its coefficients.")
402
403(define-unop $poly_normalize poly-normalize
404 "Returns the polynomial P divided by the leading coefficient.")
405
406;;Functions
407
408(defmfun $poly_expand (p vars)
409 "This function is equivalent to EXPAND(P) if P parses correctly to a polynomial.
410If the representation is not compatible with a polynomial in variables VARS,
411the result is an error."
412 (with-parsed-polynomials ((vars) :polynomials (p)
413 :value-type :polynomial)
414 p))
415
416(defmfun $poly_expt (p n vars)
417 (with-parsed-polynomials ((vars) :polynomials (p) :value-type :polynomial)
418 (poly-expt *maxima-ring* p n)))
419
420(defmfun $poly_content (p vars)
421 (with-parsed-polynomials ((vars) :polynomials (p))
422 (poly-content *maxima-ring* p)))
423
424(defmfun $poly_pseudo_divide (f fl vars
425 &aux (vars (coerce-maxima-list vars))
426 (f (parse-poly f vars))
427 (fl (parse-poly-list fl vars)))
428 (multiple-value-bind (quot rem c division-count)
429 (poly-pseudo-divide *maxima-ring* f fl)
430 `((mlist)
431 ,(coerce-to-maxima :poly-list quot vars)
432 ,(coerce-to-maxima :polynomial rem vars)
433 ,c
434 ,division-count)))
435
436(defmfun $poly_exact_divide (f g vars)
437 (with-parsed-polynomials ((vars) :polynomials (f g) :value-type :polynomial)
438 (poly-exact-divide *maxima-ring* f g)))
439
440(defmfun $poly_normal_form (f fl vars)
441 (with-parsed-polynomials ((vars) :polynomials (f)
442 :poly-lists (fl)
443 :value-type :polynomial)
444 (normal-form *maxima-ring* f (remzero fl) nil)))
445
446(defmfun $poly_buchberger_criterion (g vars)
447 (with-parsed-polynomials ((vars) :poly-lists (g) :value-type :logical)
448 (buchberger-criterion *maxima-ring* g)))
449
450(defmfun $poly_buchberger (fl vars)
451 (with-parsed-polynomials ((vars) :poly-lists (fl) :value-type :poly-list)
452 (buchberger *maxima-ring* (remzero fl) 0 nil)))
453
454(defmfun $poly_reduction (plist vars)
455 (with-parsed-polynomials ((vars) :poly-lists (plist)
456 :value-type :poly-list)
457 (reduction *maxima-ring* plist)))
458
459(defmfun $poly_minimization (plist vars)
460 (with-parsed-polynomials ((vars) :poly-lists (plist)
461 :value-type :poly-list)
462 (minimization plist)))
463
464(defmfun $poly_normalize_list (plist vars)
465 (with-parsed-polynomials ((vars) :poly-lists (plist)
466 :value-type :poly-list)
467 (poly-normalize-list *maxima-ring* plist)))
468
469(defmfun $poly_grobner (f vars)
470 (with-parsed-polynomials ((vars) :poly-lists (f)
471 :value-type :poly-list)
472 (grobner *maxima-ring* (remzero f))))
473
474(defmfun $poly_reduced_grobner (f vars)
475 (with-parsed-polynomials ((vars) :poly-lists (f)
476 :value-type :poly-list)
477 (reduced-grobner *maxima-ring* (remzero f))))
478
479(defmfun $poly_depends_p (p var mvars
480 &aux (vars (coerce-maxima-list mvars))
481 (pos (position var vars)))
482 (if (null pos)
483 (merror "~%Variable ~M not in the list of variables ~M." var mvars)
484 (poly-depends-p (parse-poly p vars) pos)))
485
486(defmfun $poly_elimination_ideal (flist k vars)
487 (with-parsed-polynomials ((vars) :poly-lists (flist)
488 :value-type :poly-list)
489 (elimination-ideal *maxima-ring* flist k nil 0)))
490
491(defmfun $poly_colon_ideal (f g vars)
492 (with-parsed-polynomials ((vars) :poly-lists (f g) :value-type :poly-list)
493 (colon-ideal *maxima-ring* f g nil)))
494
495(defmfun $poly_ideal_intersection (f g vars)
496 (with-parsed-polynomials ((vars) :poly-lists (f g) :value-type :poly-list)
497 (ideal-intersection *maxima-ring* f g nil)))
498
499(defmfun $poly_lcm (f g vars)
500 (with-parsed-polynomials ((vars) :polynomials (f g) :value-type :polynomial)
501 (poly-lcm *maxima-ring* f g)))
502
503(defmfun $poly_gcd (f g vars)
504 ($first ($divide (m* f g) ($poly_lcm f g vars))))
505
506(defmfun $poly_grobner_equal (g1 g2 vars)
507 (with-parsed-polynomials ((vars) :poly-lists (g1 g2))
508 (grobner-equal *maxima-ring* g1 g2)))
509
510(defmfun $poly_grobner_subsetp (g1 g2 vars)
511 (with-parsed-polynomials ((vars) :poly-lists (g1 g2))
512 (grobner-subsetp *maxima-ring* g1 g2)))
513
514(defmfun $poly_grobner_member (p g vars)
515 (with-parsed-polynomials ((vars) :polynomials (p) :poly-lists (g))
516 (grobner-member *maxima-ring* p g)))
517
518(defmfun $poly_ideal_saturation1 (f p vars)
519 (with-parsed-polynomials ((vars) :poly-lists (f) :polynomials (p)
520 :value-type :poly-list)
521 (ideal-saturation-1 *maxima-ring* f p 0)))
522
523(defmfun $poly_saturation_extension (f plist vars new-vars)
524 (with-parsed-polynomials ((vars new-vars)
525 :poly-lists (f plist)
526 :value-type :poly-list)
527 (saturation-extension *maxima-ring* f plist)))
528
529(defmfun $poly_polysaturation_extension (f plist vars new-vars)
530 (with-parsed-polynomials ((vars new-vars)
531 :poly-lists (f plist)
532 :value-type :poly-list)
533 (polysaturation-extension *maxima-ring* f plist)))
534
535(defmfun $poly_ideal_polysaturation1 (f plist vars)
536 (with-parsed-polynomials ((vars) :poly-lists (f plist)
537 :value-type :poly-list)
538 (ideal-polysaturation-1 *maxima-ring* f plist 0 nil)))
539
540(defmfun $poly_ideal_saturation (f g vars)
541 (with-parsed-polynomials ((vars) :poly-lists (f g)
542 :value-type :poly-list)
543 (ideal-saturation *maxima-ring* f g 0 nil)))
544
545(defmfun $poly_ideal_polysaturation (f ideal-list vars)
546 (with-parsed-polynomials ((vars) :poly-lists (f)
547 :poly-list-lists (ideal-list)
548 :value-type :poly-list)
549 (ideal-polysaturation *maxima-ring* f ideal-list 0 nil)))
550
551(defmfun $poly_lt (f vars)
552 (with-parsed-polynomials ((vars) :polynomials (f) :value-type :polynomial)
553 (make-poly-from-termlist (list (poly-lt f)))))
554
555(defmfun $poly_lm (f vars)
556 (with-parsed-polynomials ((vars) :polynomials (f) :value-type :polynomial)
557 (make-poly-from-termlist (list (make-term (poly-lm f) (funcall (ring-unit *maxima-ring*)))))))
558
Note: See TracBrowser for help on using the repository browser.