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 (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 (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 maxima->poly (expr vars
|
---|
163 | &optional
|
---|
164 | (ring $poly_coefficient_ring)
|
---|
165 | (order $poly_monomial_order)
|
---|
166 | (primary-elimination-order $poly_primary_elimination_order)
|
---|
167 | (secondary-elimination-order $poly_secondary_elimination_order)
|
---|
168 | &aux
|
---|
169 | (vars (coerce-maxima-list vars))
|
---|
170 | (ring-and-order (make-ring-and-order
|
---|
171 | :ring (find-ring)
|
---|
172 | :order (find-order)
|
---|
173 | :primary-elimination-order primary-elimination-order
|
---|
174 | :secondary-elimination-order secondary-elimination-order))
|
---|
175 | (ring (ro-order ring-and-order)))
|
---|
176 | "Convert a maxima polynomial expression EXPR in variables VARS to internal form."
|
---|
177 | (labels ((parse (arg) (maxima->poly arg vars))
|
---|
178 | (parse-list (args) (mapcar #'parse args)))
|
---|
179 | (cond
|
---|
180 | ((eql expr 0) (make-poly-zero))
|
---|
181 | ((member expr vars :test #'equal-test-p)
|
---|
182 | (let ((pos (position expr vars :test #'equal-test-p)))
|
---|
183 | (make-poly-variable ring (length vars) pos)))
|
---|
184 | ((free-of-vars expr vars)
|
---|
185 | ;;This means that variable-free CRE and Poisson forms will be converted
|
---|
186 | ;;to coefficients intact
|
---|
187 | (coerce-coeff ring expr vars))
|
---|
188 | (t
|
---|
189 | (case (caar expr)
|
---|
190 | (mplus (reduce #'(lambda (x y) (poly-add ring-and-order x y)) (parse-list (cdr expr))))
|
---|
191 | (mminus (poly-uminus ring (parse (cadr expr))))
|
---|
192 | (mtimes
|
---|
193 | (if (endp (cddr expr)) ;unary
|
---|
194 | (parse (cdr expr))
|
---|
195 | (reduce #'(lambda (p q) (poly-mul ring-and-order p q)) (parse-list (cdr expr)))))
|
---|
196 | (mexpt
|
---|
197 | (cond
|
---|
198 | ((member (cadr expr) vars :test #'equal-test-p)
|
---|
199 | ;;Special handling of (expt var pow)
|
---|
200 | (let ((pos (position (cadr expr) vars :test #'equal-test-p)))
|
---|
201 | (make-poly-variable ring (length vars) pos (caddr expr))))
|
---|
202 | ((not (and (integerp (caddr expr)) (plusp (caddr expr))))
|
---|
203 | ;; Negative power means division in coefficient ring
|
---|
204 | ;; Non-integer power means non-polynomial coefficient
|
---|
205 | (mtell "~%Warning: Expression ~%~M~%contains power which is not a positive integer. Parsing as coefficient.~%"
|
---|
206 | expr)
|
---|
207 | (coerce-coeff ring expr vars))
|
---|
208 | (t (poly-expt ring (parse (cadr expr)) (caddr expr)))))
|
---|
209 | (mrat (parse ($ratdisrep expr)))
|
---|
210 | (mpois (parse ($outofpois expr)))
|
---|
211 | (otherwise
|
---|
212 | (coerce-coeff ring expr vars)))))))
|
---|
213 |
|
---|
214 | #|
|
---|
215 |
|
---|
216 | (defun parse-poly-list (expr vars)
|
---|
217 | "Parse a Maxima representation of a list of polynomials."
|
---|
218 | (case (caar expr)
|
---|
219 | (mlist (mapcar #'(lambda (p) (parse-poly p vars)) (cdr expr)))
|
---|
220 | (t (merror "Expression ~M is not a list of polynomials in variables ~M."
|
---|
221 | expr vars))))
|
---|
222 |
|
---|
223 | (defun parse-poly-list-list (poly-list-list vars)
|
---|
224 | "Parse a Maxima representation of a list of lists of polynomials."
|
---|
225 | (mapcar #'(lambda (g) (parse-poly-list g vars)) (coerce-maxima-list poly-list-list)))
|
---|
226 |
|
---|
227 |
|
---|
228 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
---|
229 | ;;
|
---|
230 | ;; Conversion from internal form to Maxima general form
|
---|
231 | ;;
|
---|
232 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
---|
233 |
|
---|
234 | (defun maxima-head ()
|
---|
235 | (if $poly_return_term_list
|
---|
236 | '(mlist)
|
---|
237 | '(mplus)))
|
---|
238 |
|
---|
239 | (defun coerce-to-maxima (poly-type object vars)
|
---|
240 | (case poly-type
|
---|
241 | (:polynomial
|
---|
242 | `(,(maxima-head) ,@(mapcar #'(lambda (term) (coerce-to-maxima :term term vars)) (poly-termlist object))))
|
---|
243 | (:poly-list
|
---|
244 | `((mlist) ,@(mapcar #'(lambda (p) (funcall *ratdisrep-fun* (coerce-to-maxima :polynomial p vars))) object)))
|
---|
245 | (:term
|
---|
246 | `((mtimes) ,(funcall *ratdisrep-fun* (term-coeff object))
|
---|
247 | ,@(mapcar #'(lambda (var power) `((mexpt) ,var ,power))
|
---|
248 | vars (coerce (term-monom object) 'list))))
|
---|
249 | ;; Assumes that Lisp and Maxima logicals coincide
|
---|
250 | (:logical object)
|
---|
251 | (otherwise
|
---|
252 | object)))
|
---|
253 |
|
---|
254 |
|
---|
255 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
---|
256 | ;;
|
---|
257 | ;; Unary and binary operation definition facility
|
---|
258 | ;;
|
---|
259 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
---|
260 |
|
---|
261 | (defmacro define-unop (maxima-name fun-name
|
---|
262 | &optional (documentation nil documentation-supplied-p))
|
---|
263 | "Define a MAXIMA-level unary operator MAXIMA-NAME corresponding to unary function FUN-NAME."
|
---|
264 | `(defun ,maxima-name (p vars
|
---|
265 | &aux
|
---|
266 | (vars (coerce-maxima-list vars))
|
---|
267 | (p (parse-poly p vars)))
|
---|
268 | ,@(when documentation-supplied-p (list documentation))
|
---|
269 | (coerce-to-maxima :polynomial (,fun-name *maxima-ring* p) vars)))
|
---|
270 |
|
---|
271 | (defmacro define-binop (maxima-name fun-name
|
---|
272 | &optional (documentation nil documentation-supplied-p))
|
---|
273 | "Define a MAXIMA-level binary operator MAXIMA-NAME corresponding to binary function FUN-NAME."
|
---|
274 | `(defmfun ,maxima-name (p q vars
|
---|
275 | &aux
|
---|
276 | (vars (coerce-maxima-list vars))
|
---|
277 | (p (parse-poly p vars))
|
---|
278 | (q (parse-poly q vars)))
|
---|
279 | ,@(when documentation-supplied-p (list documentation))
|
---|
280 | (coerce-to-maxima :polynomial (,fun-name *maxima-ring* p q) vars)))
|
---|
281 |
|
---|
282 |
|
---|
283 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
---|
284 | ;;
|
---|
285 | ;; Facilities for evaluating Grobner package expressions
|
---|
286 | ;; within a prepared environment
|
---|
287 | ;;
|
---|
288 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
---|
289 |
|
---|
290 | (defmacro with-monomial-order ((order) &body body)
|
---|
291 | "Evaluate BODY with monomial order set to ORDER."
|
---|
292 | `(let ((*monomial-order* (or (find-order ,order) *monomial-order*)))
|
---|
293 | . ,body))
|
---|
294 |
|
---|
295 | (defmacro with-coefficient-ring ((ring) &body body)
|
---|
296 | "Evaluate BODY with coefficient ring set to RING."
|
---|
297 | `(let ((*maxima-ring* (or (find-ring ,ring) *maxima-ring*)))
|
---|
298 | . ,body))
|
---|
299 |
|
---|
300 | (defmacro with-ring-and-order ((ring order) &body body)
|
---|
301 | "Evaluate BODY with monomial order set to ORDER and coefficient ring set to RING."
|
---|
302 | `(let ((*monomial-order* (or (find-order ,order) *monomial-order*))
|
---|
303 | (*maxima-ring* (or (find-ring ,ring) *maxima-ring*)))
|
---|
304 | . ,body))
|
---|
305 |
|
---|
306 | (defmacro with-elimination-orders ((primary secondary elimination-order)
|
---|
307 | &body body)
|
---|
308 | "Evaluate BODY with primary and secondary elimination orders set to PRIMARY and SECONDARY."
|
---|
309 | `(let ((*primary-elimination-order* (or (find-order ,primary) *primary-elimination-order*))
|
---|
310 | (*secondary-elimination-order* (or (find-order ,secondary) *secondary-elimination-order*))
|
---|
311 | (*elimination-order* (or (find-order ,elimination-order) *elimination-order*)))
|
---|
312 | . ,body))
|
---|
313 |
|
---|
314 |
|
---|
315 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
---|
316 | ;;
|
---|
317 | ;; Maxima-level interface functions
|
---|
318 | ;;
|
---|
319 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
---|
320 |
|
---|
321 | ;; Auxillary function for removing zero polynomial
|
---|
322 | (defun remzero (plist) (remove #'poly-zerop plist))
|
---|
323 |
|
---|
324 | ;;Simple operators
|
---|
325 |
|
---|
326 | (define-binop $poly_add poly-add
|
---|
327 | "Adds two polynomials P and Q")
|
---|
328 |
|
---|
329 | (define-binop $poly_subtract poly-sub
|
---|
330 | "Subtracts a polynomial Q from P.")
|
---|
331 |
|
---|
332 | (define-binop $poly_multiply poly-mul
|
---|
333 | "Returns the product of polynomials P and Q.")
|
---|
334 |
|
---|
335 | (define-binop $poly_s_polynomial spoly
|
---|
336 | "Returns the syzygy polynomial (S-polynomial) of two polynomials P and Q.")
|
---|
337 |
|
---|
338 | (define-unop $poly_primitive_part poly-primitive-part
|
---|
339 | "Returns the polynomial P divided by GCD of its coefficients.")
|
---|
340 |
|
---|
341 | (define-unop $poly_normalize poly-normalize
|
---|
342 | "Returns the polynomial P divided by the leading coefficient.")
|
---|
343 |
|
---|
344 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
---|
345 | ;;
|
---|
346 | ;; Macro facility for writing Maxima-level wrappers for
|
---|
347 | ;; functions operating on internal representation
|
---|
348 | ;;
|
---|
349 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
---|
350 |
|
---|
351 | (defmacro with-parsed-polynomials (((maxima-vars &optional (maxima-new-vars nil new-vars-supplied-p))
|
---|
352 | &key (polynomials nil)
|
---|
353 | (poly-lists nil)
|
---|
354 | (poly-list-lists nil)
|
---|
355 | (value-type nil))
|
---|
356 | &body body
|
---|
357 | &aux (vars (gensym))
|
---|
358 | (new-vars (gensym)))
|
---|
359 | `(let ((,vars (coerce-maxima-list ,maxima-vars))
|
---|
360 | ,@(when new-vars-supplied-p
|
---|
361 | (list `(,new-vars (coerce-maxima-list ,maxima-new-vars)))))
|
---|
362 | (coerce-to-maxima
|
---|
363 | ,value-type
|
---|
364 | (with-coefficient-ring ($poly_coefficient_ring)
|
---|
365 | (with-monomial-order ($poly_monomial_order)
|
---|
366 | (with-elimination-orders ($poly_primary_elimination_order
|
---|
367 | $poly_secondary_elimination_order
|
---|
368 | $poly_elimination_order)
|
---|
369 | (let ,(let ((args nil))
|
---|
370 | (dolist (p polynomials args)
|
---|
371 | (setf args (cons `(,p (parse-poly ,p ,vars)) args)))
|
---|
372 | (dolist (p poly-lists args)
|
---|
373 | (setf args (cons `(,p (parse-poly-list ,p ,vars)) args)))
|
---|
374 | (dolist (p poly-list-lists args)
|
---|
375 | (setf args (cons `(,p (parse-poly-list-list ,p ,vars)) args))))
|
---|
376 | . ,body))))
|
---|
377 | ,(if new-vars-supplied-p
|
---|
378 | `(append ,vars ,new-vars)
|
---|
379 | vars))))
|
---|
380 |
|
---|
381 |
|
---|
382 | ;;Functions
|
---|
383 |
|
---|
384 | (defmfun $poly_expand (p vars)
|
---|
385 | "This function is equivalent to EXPAND(P) if P parses correctly to a polynomial.
|
---|
386 | If the representation is not compatible with a polynomial in variables VARS,
|
---|
387 | the result is an error."
|
---|
388 | (with-parsed-polynomials ((vars) :polynomials (p)
|
---|
389 | :value-type :polynomial)
|
---|
390 | p))
|
---|
391 |
|
---|
392 | (defmfun $poly_expt (p n vars)
|
---|
393 | (with-parsed-polynomials ((vars) :polynomials (p) :value-type :polynomial)
|
---|
394 | (poly-expt *maxima-ring* p n)))
|
---|
395 |
|
---|
396 | (defmfun $poly_content (p vars)
|
---|
397 | (with-parsed-polynomials ((vars) :polynomials (p))
|
---|
398 | (poly-content *maxima-ring* p)))
|
---|
399 |
|
---|
400 | (defmfun $poly_pseudo_divide (f fl vars
|
---|
401 | &aux (vars (coerce-maxima-list vars))
|
---|
402 | (f (parse-poly f vars))
|
---|
403 | (fl (parse-poly-list fl vars)))
|
---|
404 | (multiple-value-bind (quot rem c division-count)
|
---|
405 | (poly-pseudo-divide *maxima-ring* f fl)
|
---|
406 | `((mlist)
|
---|
407 | ,(coerce-to-maxima :poly-list quot vars)
|
---|
408 | ,(coerce-to-maxima :polynomial rem vars)
|
---|
409 | ,c
|
---|
410 | ,division-count)))
|
---|
411 |
|
---|
412 | (defmfun $poly_exact_divide (f g vars)
|
---|
413 | (with-parsed-polynomials ((vars) :polynomials (f g) :value-type :polynomial)
|
---|
414 | (poly-exact-divide *maxima-ring* f g)))
|
---|
415 |
|
---|
416 | (defmfun $poly_normal_form (f fl vars)
|
---|
417 | (with-parsed-polynomials ((vars) :polynomials (f)
|
---|
418 | :poly-lists (fl)
|
---|
419 | :value-type :polynomial)
|
---|
420 | (normal-form *maxima-ring* f (remzero fl) nil)))
|
---|
421 |
|
---|
422 | (defmfun $poly_buchberger_criterion (g vars)
|
---|
423 | (with-parsed-polynomials ((vars) :poly-lists (g) :value-type :logical)
|
---|
424 | (buchberger-criterion *maxima-ring* g)))
|
---|
425 |
|
---|
426 | (defmfun $poly_buchberger (fl vars)
|
---|
427 | (with-parsed-polynomials ((vars) :poly-lists (fl) :value-type :poly-list)
|
---|
428 | (buchberger *maxima-ring* (remzero fl) 0 nil)))
|
---|
429 |
|
---|
430 | (defmfun $poly_reduction (plist vars)
|
---|
431 | (with-parsed-polynomials ((vars) :poly-lists (plist)
|
---|
432 | :value-type :poly-list)
|
---|
433 | (reduction *maxima-ring* plist)))
|
---|
434 |
|
---|
435 | (defmfun $poly_minimization (plist vars)
|
---|
436 | (with-parsed-polynomials ((vars) :poly-lists (plist)
|
---|
437 | :value-type :poly-list)
|
---|
438 | (minimization plist)))
|
---|
439 |
|
---|
440 | (defmfun $poly_normalize_list (plist vars)
|
---|
441 | (with-parsed-polynomials ((vars) :poly-lists (plist)
|
---|
442 | :value-type :poly-list)
|
---|
443 | (poly-normalize-list *maxima-ring* plist)))
|
---|
444 |
|
---|
445 | (defmfun $poly_grobner (f vars)
|
---|
446 | (with-parsed-polynomials ((vars) :poly-lists (f)
|
---|
447 | :value-type :poly-list)
|
---|
448 | (grobner *maxima-ring* (remzero f))))
|
---|
449 |
|
---|
450 | (defmfun $poly_reduced_grobner (f vars)
|
---|
451 | (with-parsed-polynomials ((vars) :poly-lists (f)
|
---|
452 | :value-type :poly-list)
|
---|
453 | (reduced-grobner *maxima-ring* (remzero f))))
|
---|
454 |
|
---|
455 | (defmfun $poly_depends_p (p var mvars
|
---|
456 | &aux (vars (coerce-maxima-list mvars))
|
---|
457 | (pos (position var vars)))
|
---|
458 | (if (null pos)
|
---|
459 | (merror "~%Variable ~M not in the list of variables ~M." var mvars)
|
---|
460 | (poly-depends-p (parse-poly p vars) pos)))
|
---|
461 |
|
---|
462 | (defmfun $poly_elimination_ideal (flist k vars)
|
---|
463 | (with-parsed-polynomials ((vars) :poly-lists (flist)
|
---|
464 | :value-type :poly-list)
|
---|
465 | (elimination-ideal *maxima-ring* flist k nil 0)))
|
---|
466 |
|
---|
467 | (defmfun $poly_colon_ideal (f g vars)
|
---|
468 | (with-parsed-polynomials ((vars) :poly-lists (f g) :value-type :poly-list)
|
---|
469 | (colon-ideal *maxima-ring* f g nil)))
|
---|
470 |
|
---|
471 | (defmfun $poly_ideal_intersection (f g vars)
|
---|
472 | (with-parsed-polynomials ((vars) :poly-lists (f g) :value-type :poly-list)
|
---|
473 | (ideal-intersection *maxima-ring* f g nil)))
|
---|
474 |
|
---|
475 | (defmfun $poly_lcm (f g vars)
|
---|
476 | (with-parsed-polynomials ((vars) :polynomials (f g) :value-type :polynomial)
|
---|
477 | (poly-lcm *maxima-ring* f g)))
|
---|
478 |
|
---|
479 | (defmfun $poly_gcd (f g vars)
|
---|
480 | ($first ($divide (m* f g) ($poly_lcm f g vars))))
|
---|
481 |
|
---|
482 | (defmfun $poly_grobner_equal (g1 g2 vars)
|
---|
483 | (with-parsed-polynomials ((vars) :poly-lists (g1 g2))
|
---|
484 | (grobner-equal *maxima-ring* g1 g2)))
|
---|
485 |
|
---|
486 | (defmfun $poly_grobner_subsetp (g1 g2 vars)
|
---|
487 | (with-parsed-polynomials ((vars) :poly-lists (g1 g2))
|
---|
488 | (grobner-subsetp *maxima-ring* g1 g2)))
|
---|
489 |
|
---|
490 | (defmfun $poly_grobner_member (p g vars)
|
---|
491 | (with-parsed-polynomials ((vars) :polynomials (p) :poly-lists (g))
|
---|
492 | (grobner-member *maxima-ring* p g)))
|
---|
493 |
|
---|
494 | (defmfun $poly_ideal_saturation1 (f p vars)
|
---|
495 | (with-parsed-polynomials ((vars) :poly-lists (f) :polynomials (p)
|
---|
496 | :value-type :poly-list)
|
---|
497 | (ideal-saturation-1 *maxima-ring* f p 0)))
|
---|
498 |
|
---|
499 | (defmfun $poly_saturation_extension (f plist vars new-vars)
|
---|
500 | (with-parsed-polynomials ((vars new-vars)
|
---|
501 | :poly-lists (f plist)
|
---|
502 | :value-type :poly-list)
|
---|
503 | (saturation-extension *maxima-ring* f plist)))
|
---|
504 |
|
---|
505 | (defmfun $poly_polysaturation_extension (f plist vars new-vars)
|
---|
506 | (with-parsed-polynomials ((vars new-vars)
|
---|
507 | :poly-lists (f plist)
|
---|
508 | :value-type :poly-list)
|
---|
509 | (polysaturation-extension *maxima-ring* f plist)))
|
---|
510 |
|
---|
511 | (defmfun $poly_ideal_polysaturation1 (f plist vars)
|
---|
512 | (with-parsed-polynomials ((vars) :poly-lists (f plist)
|
---|
513 | :value-type :poly-list)
|
---|
514 | (ideal-polysaturation-1 *maxima-ring* f plist 0 nil)))
|
---|
515 |
|
---|
516 | (defmfun $poly_ideal_saturation (f g vars)
|
---|
517 | (with-parsed-polynomials ((vars) :poly-lists (f g)
|
---|
518 | :value-type :poly-list)
|
---|
519 | (ideal-saturation *maxima-ring* f g 0 nil)))
|
---|
520 |
|
---|
521 | (defmfun $poly_ideal_polysaturation (f ideal-list vars)
|
---|
522 | (with-parsed-polynomials ((vars) :poly-lists (f)
|
---|
523 | :poly-list-lists (ideal-list)
|
---|
524 | :value-type :poly-list)
|
---|
525 | (ideal-polysaturation *maxima-ring* f ideal-list 0 nil)))
|
---|
526 |
|
---|
527 | (defmfun $poly_lt (f vars)
|
---|
528 | (with-parsed-polynomials ((vars) :polynomials (f) :value-type :polynomial)
|
---|
529 | (make-poly-from-termlist (list (poly-lt f)))))
|
---|
530 |
|
---|
531 | (defmfun $poly_lm (f vars)
|
---|
532 | (with-parsed-polynomials ((vars) :polynomials (f) :value-type :polynomial)
|
---|
533 | (make-poly-from-termlist (list (make-term (poly-lm f) (funcall (ring-unit *maxima-ring*)))))))
|
---|
534 |
|
---|
535 | |#
|
---|