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/polynomial.lisp@ 3064

Last change on this file since 3064 was 3064, checked in by Marek Rychlik, 10 years ago

* empty log message *

File size: 19.2 KB
RevLine 
[1201]1;;; -*- Mode: Lisp -*-
[77]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
[431]22(defpackage "POLYNOMIAL"
[3055]23 (:use :cl :utils :ring :monom :order :term #| :infix |# )
[2596]24 (:export "POLY"
25 "POLY-TERMLIST"
[3016]26 "POLY-TERM-ORDER"
27 "CHANGE-TERM-ORDER")
[2522]28 (:documentation "Implements polynomials"))
[143]29
[431]30(in-package :polynomial)
31
[1927]32(proclaim '(optimize (speed 3) (space 0) (safety 0) (debug 0)))
[52]33
[2442]34(defclass poly ()
[2697]35 ((termlist :initarg :termlist :accessor poly-termlist
36 :documentation "List of terms.")
37 (order :initarg :order :accessor poly-term-order
38 :documentation "Monomial/term order."))
[2695]39 (:default-initargs :termlist nil :order #'lex>)
40 (:documentation "A polynomial with a list of terms TERMLIST, ordered
[2696]41according to term order ORDER, which defaults to LEX>."))
[2442]42
[2471]43(defmethod print-object ((self poly) stream)
[2600]44 (format stream "#<POLY TERMLIST=~A ORDER=~A>"
[2595]45 (poly-termlist self)
46 (poly-term-order self)))
[2469]47
[3015]48(defgeneric change-term-order (self other)
[3012]49 (:documentation "Change term order of SELF to the term order of OTHER.")
[3010]50 (:method ((self poly) (other poly))
51 (unless (eq (poly-term-order self) (poly-term-order other))
52 (setf (poly-termlist self) (sort (poly-termlist self) (poly-term-order other))
53 (poly-term-order self) (poly-term-order other)))
[3012]54 self))
[3010]55
[2650]56(defmethod r-equalp ((self poly) (other poly))
[2680]57 "POLY instances are R-EQUALP if they have the same
58order and if all terms are R-EQUALP."
[2651]59 (and (every #'r-equalp (poly-termlist self) (poly-termlist other))
60 (eq (poly-term-order self) (poly-term-order other))))
[2650]61
[2513]62(defmethod insert-item ((self poly) (item term))
63 (push item (poly-termlist self))
[2514]64 self)
[2464]65
[2513]66(defmethod append-item ((self poly) (item term))
67 (setf (cdr (last (poly-termlist self))) (list item))
68 self)
[2466]69
[52]70;; Leading term
[2442]71(defgeneric leading-term (object)
72 (:method ((self poly))
[2525]73 (car (poly-termlist self)))
74 (:documentation "The leading term of a polynomial, or NIL for zero polynomial."))
[52]75
76;; Second term
[2442]77(defgeneric second-leading-term (object)
78 (:method ((self poly))
[2525]79 (cadar (poly-termlist self)))
80 (:documentation "The second leading term of a polynomial, or NIL for a polynomial with at most one term."))
[52]81
82;; Leading coefficient
[2442]83(defgeneric leading-coefficient (object)
84 (:method ((self poly))
[2526]85 (r-coeff (leading-term self)))
[2545]86 (:documentation "The leading coefficient of a polynomial. It signals error for a zero polynomial."))
[52]87
88;; Second coefficient
[2442]89(defgeneric second-leading-coefficient (object)
90 (:method ((self poly))
[2526]91 (r-coeff (second-leading-term self)))
[2906]92 (:documentation "The second leading coefficient of a polynomial. It
93 signals error for a polynomial with at most one term."))
[52]94
95;; Testing for a zero polynomial
[2445]96(defmethod r-zerop ((self poly))
97 (null (poly-termlist self)))
[52]98
99;; The number of terms
[2445]100(defmethod r-length ((self poly))
101 (length (poly-termlist self)))
[52]102
[2483]103(defmethod multiply-by ((self poly) (other monom))
[2501]104 (mapc #'(lambda (term) (multiply-by term other))
105 (poly-termlist self))
[2483]106 self)
[2469]107
[2501]108(defmethod multiply-by ((self poly) (other scalar))
[2502]109 (mapc #'(lambda (term) (multiply-by term other))
[2501]110 (poly-termlist self))
[2487]111 self)
112
[2607]113
[2761]114(defmacro fast-add/subtract (p q order-fn add/subtract-fn uminus-fn)
[2755]115 "Return an expression which will efficiently adds/subtracts two
116polynomials, P and Q. The addition/subtraction of coefficients is
117performed by calling ADD/SUBTRACT-METHOD-NAME. If UMINUS-METHOD-NAME
118is supplied, it is used to negate the coefficients of Q which do not
[2756]119have a corresponding coefficient in P. The code implements an
120efficient algorithm to add two polynomials represented as sorted lists
121of terms. The code destroys both arguments, reusing the terms to build
122the result."
[2742]123 `(macrolet ((lc (x) `(r-coeff (car ,x))))
124 (do ((p ,p)
125 (q ,q)
126 r)
127 ((or (endp p) (endp q))
128 ;; NOTE: R contains the result in reverse order. Can it
129 ;; be more efficient to produce the terms in correct order?
[2774]130 (unless (endp q)
[2776]131 ;; Upon subtraction, we must change the sign of
132 ;; all coefficients in q
[2774]133 ,@(when uminus-fn
[2775]134 `((mapc #'(lambda (x) (setf x (funcall ,uminus-fn x))) q)))
[2774]135 (setf r (nreconc r q)))
[2742]136 r)
137 (multiple-value-bind
138 (greater-p equal-p)
[2766]139 (funcall ,order-fn (car p) (car q))
[2742]140 (cond
141 (greater-p
142 (rotatef (cdr p) r p)
143 )
144 (equal-p
[2766]145 (let ((s (funcall ,add/subtract-fn (lc p) (lc q))))
[2742]146 (cond
147 ((r-zerop s)
148 (setf p (cdr p))
149 )
150 (t
151 (setf (lc p) s)
152 (rotatef (cdr p) r p))))
153 (setf q (cdr q))
154 )
155 (t
[2743]156 ;;Negate the term of Q if UMINUS provided, signallig
157 ;;that we are doing subtraction
[2908]158 ,(when uminus-fn
159 `(setf (lc q) (funcall ,uminus-fn (lc q))))
[2743]160 (rotatef (cdr q) r q)))))))
[2585]161
[2655]162
[2763]163(defmacro def-add/subtract-method (add/subtract-method-name
[2752]164 uminus-method-name
165 &optional
[2913]166 (doc-string nil doc-string-supplied-p))
[2615]167 "This macro avoids code duplication for two similar operations: ADD-TO and SUBTRACT-FROM."
[2749]168 `(defmethod ,add/subtract-method-name ((self poly) (other poly))
[2615]169 ,@(when doc-string-supplied-p `(,doc-string))
[2769]170 ;; Ensure orders are compatible
[3015]171 (change-term-order other self)
[2772]172 (setf (poly-termlist self) (fast-add/subtract
173 (poly-termlist self) (poly-termlist other)
174 (poly-term-order self)
175 #',add/subtract-method-name
176 ,(when uminus-method-name `(function ,uminus-method-name))))
[2609]177 self))
[2487]178
[2916]179(eval-when (:compile-toplevel :load-toplevel :execute)
[2777]180
181 (def-add/subtract-method add-to nil
182 "Adds to polynomial SELF another polynomial OTHER.
[2610]183This operation destructively modifies both polynomials.
184The result is stored in SELF. This implementation does
[2752]185no consing, entirely reusing the sells of SELF and OTHER.")
[2609]186
[2777]187 (def-add/subtract-method subtract-from unary-minus
[2753]188 "Subtracts from polynomial SELF another polynomial OTHER.
[2610]189This operation destructively modifies both polynomials.
190The result is stored in SELF. This implementation does
[2752]191no consing, entirely reusing the sells of SELF and OTHER.")
[2610]192
[2916]193 )
[2777]194
[2916]195
196
[2691]197(defmethod unary-minus ((self poly))
[2694]198 "Destructively modifies the coefficients of the polynomial SELF,
199by changing their sign."
[2692]200 (mapc #'unary-minus (poly-termlist self))
[2683]201 self)
[52]202
[2795]203(defun add-termlists (p q order-fn)
[2794]204 "Destructively adds two termlists P and Q ordered according to ORDER-FN."
[2917]205 (fast-add/subtract p q order-fn #'add-to nil))
[2794]206
[2800]207(defmacro multiply-term-by-termlist-dropping-zeros (term termlist
[2927]208 &optional (reverse-arg-order-P nil))
[2799]209 "Multiplies term TERM by a list of term, TERMLIST.
[2792]210Takes into accound divisors of zero in the ring, by
[2927]211deleting zero terms. Optionally, if REVERSE-ARG-ORDER-P
[2928]212is T, change the order of arguments; this may be important
[2927]213if we extend the package to non-commutative rings."
[2800]214 `(mapcan #'(lambda (other-term)
[2907]215 (let ((prod (r*
[2923]216 ,@(cond
[2930]217 (reverse-arg-order-p
[2925]218 `(other-term ,term))
219 (t
220 `(,term other-term))))))
[2800]221 (cond
222 ((r-zerop prod) nil)
223 (t (list prod)))))
224 ,termlist))
[2790]225
[2796]226(defun multiply-termlists (p q order-fn)
[2787]227 (cond
[2917]228 ((or (endp p) (endp q))
229 ;;p or q is 0 (represented by NIL)
230 nil)
[2789]231 ;; If p= p0+p1 and q=q0+q1 then p*q=p0*q0+p0*q1+p1*q
[2787]232 ((endp (cdr p))
[2918]233 (multiply-term-by-termlist-dropping-zeros (car p) q))
234 ((endp (cdr q))
[2919]235 (multiply-term-by-termlist-dropping-zeros (car q) p t))
236 (t
[2948]237 (cons (r* (car p) (car q))
[2949]238 (add-termlists
239 (multiply-term-by-termlist-dropping-zeros (car p) (cdr q))
240 (multiply-termlists (cdr p) q order-fn)
241 order-fn)))))
[2793]242
[2803]243(defmethod multiply-by ((self poly) (other poly))
[3014]244 (change-term-order other self)
[2803]245 (setf (poly-termlist self) (multiply-termlists (poly-termlist self)
246 (poly-termlist other)
247 (poly-term-order self)))
248 self)
249
[2939]250(defmethod r* ((poly1 poly) (poly2 poly))
251 "Non-destructively multiply POLY1 by POLY2."
252 (multiply-by (copy-instance POLY1) (copy-instance POLY2)))
[2916]253
[3044]254(defmethod left-tensor-product-by ((self poly) (other term))
255 (setf (poly-termlist self)
256 (mapcan #'(lambda (term)
[3047]257 (let ((prod (left-tensor-product-by term other)))
[3044]258 (cond
259 ((r-zerop prod) nil)
260 (t (list prod)))))
[3048]261 (poly-termlist self)))
[3044]262 self)
263
264(defmethod right-tensor-product-by ((self poly) (other term))
[3045]265 (setf (poly-termlist self)
266 (mapcan #'(lambda (term)
[3046]267 (let ((prod (right-tensor-product-by term other)))
[3045]268 (cond
269 ((r-zerop prod) nil)
270 (t (list prod)))))
[3048]271 (poly-termlist self)))
[3045]272 self)
[3044]273
[3062]274(defmethod left-tensor-product-by ((self poly) (other monom))
275 (setf (poly-termlist self)
276 (mapcan #'(lambda (term)
277 (let ((prod (left-tensor-product-by term other)))
278 (cond
279 ((r-zerop prod) nil)
280 (t (list prod)))))
281 (poly-termlist self)))
282 self)
[3044]283
[3062]284(defmethod right-tensor-product-by ((self poly) (other monom))
285 (setf (poly-termlist self)
286 (mapcan #'(lambda (term)
287 (let ((prod (right-tensor-product-by term other)))
288 (cond
289 ((r-zerop prod) nil)
290 (t (list prod)))))
291 (poly-termlist self)))
292 self)
293
294
[3063]295(defun poly-standard-extension (plist &aux (k (length plist)) (i 0))
[2716]296 "Calculate [U1*P1,U2*P2,...,UK*PK], where PLIST=[P1,P2,...,PK]
[3060]297is a list of polynomials. Destructively modifies PLIST elements."
[3061]298 (mapc #'(lambda (poly)
[3063]299 (left-tensor-product-by poly
300 (prog1 (make-monom-variable k i) (incf i))))
[3061]301 plist))
[52]302
[3064]303(defun saturation-extension (plist
[1473]304 &aux
[3064]305 (plist (poly-saturation-extension plist))
306 (dim (poly-dimension (car plist))))
[52]307 "Calculate [F, U1*P1-1,U2*P2-1,...,UK*PK-1], where PLIST=[P1,P2,...,PK]."
[3064]308 (flet ((subtract-1 (p)
309 (insert-item (make-instance 'term :coeff -1 :dimension dim))))
310 (mapc #'subtract-1 plist))
311 (nconc F plist))
[52]312
313
[1475]314(defun polysaturation-extension (ring f plist
315 &aux
316 (k (length plist))
[1476]317 (d (+ k (monom-dimension (poly-lm (car plist)))))
[1494]318 ;; Add k variables to f
[1493]319 (f (poly-list-add-variables f k))
[1495]320 ;; Set PLIST to [U1*P1,U2*P2,...,UK*PK]
[1493]321 (plist (apply #'poly-append (poly-standard-extension plist))))
[1497]322 "Calculate [F, U1*P1+U2*P2+...+UK*PK-1], where PLIST=[P1,P2,...,PK]. It destructively modifies F."
[1493]323 ;; Add -1 as the last term
[1908]324 (declare (type ring ring))
[1493]325 (setf (cdr (last (poly-termlist plist)))
[1845]326 (list (make-term :monom (make-monom :dimension d)
327 :coeff (funcall (ring-uminus ring) (funcall (ring-unit ring))))))
[1493]328 (append f (list plist)))
[52]329
[1477]330(defun saturation-extension-1 (ring f p)
[1497]331 "Calculate [F, U*P-1]. It destructively modifies F."
[1908]332 (declare (type ring ring))
[1477]333 (polysaturation-extension ring f (list p)))
[53]334
335;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
336;;
337;; Evaluation of polynomial (prefix) expressions
338;;
339;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
340
341(defun coerce-coeff (ring expr vars)
342 "Coerce an element of the coefficient ring to a constant polynomial."
343 ;; Modular arithmetic handler by rat
[1908]344 (declare (type ring ring))
[1846]345 (make-poly-from-termlist (list (make-term :monom (make-monom :dimension (length vars))
346 :coeff (funcall (ring-parse ring) expr)))
[53]347 0))
348
[1046]349(defun poly-eval (expr vars
350 &optional
[1668]351 (ring +ring-of-integers+)
[1048]352 (order #'lex>)
[1170]353 (list-marker :[)
[1047]354 &aux
355 (ring-and-order (make-ring-and-order :ring ring :order order)))
[1168]356 "Evaluate Lisp form EXPR to a polynomial or a list of polynomials in
[1208]357variables VARS. Return the resulting polynomial or list of
358polynomials. Standard arithmetical operators in form EXPR are
359replaced with their analogues in the ring of polynomials, and the
360resulting expression is evaluated, resulting in a polynomial or a list
[1209]361of polynomials in internal form. A similar operation in another computer
362algebra system could be called 'expand' or so."
[1909]363 (declare (type ring ring))
[1050]364 (labels ((p-eval (arg) (poly-eval arg vars ring order))
[1140]365 (p-eval-scalar (arg) (poly-eval-scalar arg))
[53]366 (p-eval-list (args) (mapcar #'p-eval args))
[989]367 (p-add (x y) (poly-add ring-and-order x y)))
[53]368 (cond
[1128]369 ((null expr) (error "Empty expression"))
[53]370 ((eql expr 0) (make-poly-zero))
371 ((member expr vars :test #'equalp)
372 (let ((pos (position expr vars :test #'equalp)))
[1657]373 (make-poly-variable ring (length vars) pos)))
[53]374 ((atom expr)
375 (coerce-coeff ring expr vars))
376 ((eq (car expr) list-marker)
377 (cons list-marker (p-eval-list (cdr expr))))
378 (t
379 (case (car expr)
380 (+ (reduce #'p-add (p-eval-list (cdr expr))))
381 (- (case (length expr)
382 (1 (make-poly-zero))
383 (2 (poly-uminus ring (p-eval (cadr expr))))
[989]384 (3 (poly-sub ring-and-order (p-eval (cadr expr)) (p-eval (caddr expr))))
385 (otherwise (poly-sub ring-and-order (p-eval (cadr expr))
[53]386 (reduce #'p-add (p-eval-list (cddr expr)))))))
387 (*
388 (if (endp (cddr expr)) ;unary
389 (p-eval (cdr expr))
[989]390 (reduce #'(lambda (p q) (poly-mul ring-and-order p q)) (p-eval-list (cdr expr)))))
[1106]391 (/
392 ;; A polynomial can be divided by a scalar
[1115]393 (cond
394 ((endp (cddr expr))
[1117]395 ;; A special case (/ ?), the inverse
[1119]396 (coerce-coeff ring (apply (ring-div ring) (cdr expr)) vars))
[1128]397 (t
[1115]398 (let ((num (p-eval (cadr expr)))
[1142]399 (denom-inverse (apply (ring-div ring)
400 (cons (funcall (ring-unit ring))
401 (mapcar #'p-eval-scalar (cddr expr))))))
[1118]402 (scalar-times-poly ring denom-inverse num)))))
[53]403 (expt
404 (cond
405 ((member (cadr expr) vars :test #'equalp)
406 ;;Special handling of (expt var pow)
407 (let ((pos (position (cadr expr) vars :test #'equalp)))
[1657]408 (make-poly-variable ring (length vars) pos (caddr expr))))
[53]409 ((not (and (integerp (caddr expr)) (plusp (caddr expr))))
410 ;; Negative power means division in coefficient ring
411 ;; Non-integer power means non-polynomial coefficient
412 (coerce-coeff ring expr vars))
[989]413 (t (poly-expt ring-and-order (p-eval (cadr expr)) (caddr expr)))))
[53]414 (otherwise
415 (coerce-coeff ring expr vars)))))))
416
[1133]417(defun poly-eval-scalar (expr
418 &optional
[1668]419 (ring +ring-of-integers+)
[1133]420 &aux
421 (order #'lex>))
422 "Evaluate a scalar expression EXPR in ring RING."
[1910]423 (declare (type ring ring))
[1133]424 (poly-lc (poly-eval expr nil ring order)))
425
[1189]426(defun spoly (ring-and-order f g
427 &aux
428 (ring (ro-ring ring-and-order)))
[55]429 "It yields the S-polynomial of polynomials F and G."
[1911]430 (declare (type ring-and-order ring-and-order) (type poly f g))
[55]431 (let* ((lcm (monom-lcm (poly-lm f) (poly-lm g)))
[2913]432 (mf (monom-div lcm (poly-lm f)))
433 (mg (monom-div lcm (poly-lm g))))
[55]434 (declare (type monom mf mg))
435 (multiple-value-bind (c cf cg)
436 (funcall (ring-ezgcd ring) (poly-lc f) (poly-lc g))
437 (declare (ignore c))
438 (poly-sub
[1189]439 ring-and-order
[55]440 (scalar-times-poly ring cg (monom-times-poly mf f))
441 (scalar-times-poly ring cf (monom-times-poly mg g))))))
[53]442
443
[55]444(defun poly-primitive-part (ring p)
445 "Divide polynomial P with integer coefficients by gcd of its
446coefficients and return the result."
[1912]447 (declare (type ring ring) (type poly p))
[55]448 (if (poly-zerop p)
449 (values p 1)
[2913]450 (let ((c (poly-content ring p)))
451 (values (make-poly-from-termlist
452 (mapcar
453 #'(lambda (x)
454 (make-term :monom (term-monom x)
455 :coeff (funcall (ring-div ring) (term-coeff x) c)))
456 (poly-termlist p))
457 (poly-sugar p))
458 c))))
[55]459
460(defun poly-content (ring p)
461 "Greatest common divisor of the coefficients of the polynomial P. Use the RING structure
462to compute the greatest common divisor."
[1913]463 (declare (type ring ring) (type poly p))
[55]464 (reduce (ring-gcd ring) (mapcar #'term-coeff (rest (poly-termlist p))) :initial-value (poly-lc p)))
[1066]465
[1091]466(defun read-infix-form (&key (stream t))
[1066]467 "Parser of infix expressions with integer/rational coefficients
468The parser will recognize two kinds of polynomial expressions:
469
470- polynomials in fully expanded forms with coefficients
471 written in front of symbolic expressions; constants can be optionally
472 enclosed in (); for example, the infix form
473 X^2-Y^2+(-4/3)*U^2*W^3-5
474 parses to
475 (+ (- (EXPT X 2) (EXPT Y 2)) (* (- (/ 4 3)) (EXPT U 2) (EXPT W 3)) (- 5))
476
477- lists of polynomials; for example
478 [X-Y, X^2+3*Z]
479 parses to
480 (:[ (- X Y) (+ (EXPT X 2) (* 3 Z)))
481 where the first symbol [ marks a list of polynomials.
482
483-other infix expressions, for example
484 [(X-Y)*(X+Y)/Z,(X+1)^2]
485parses to:
486 (:[ (/ (* (- X Y) (+ X Y)) Z) (EXPT (+ X 1) 2))
487Currently this function is implemented using M. Kantrowitz's INFIX package."
488 (read-from-string
489 (concatenate 'string
[2913]490 "#I("
491 (with-output-to-string (s)
492 (loop
493 (multiple-value-bind (line eof)
494 (read-line stream t)
495 (format s "~A" line)
496 (when eof (return)))))
497 ")")))
498
[1145]499(defun read-poly (vars &key
500 (stream t)
[1668]501 (ring +ring-of-integers+)
[1145]502 (order #'lex>))
[1067]503 "Reads an expression in prefix form from a stream STREAM.
[1144]504The expression read from the strem should represent a polynomial or a
505list of polynomials in variables VARS, over the ring RING. The
506polynomial or list of polynomials is returned, with terms in each
507polynomial ordered according to monomial order ORDER."
[1146]508 (poly-eval (read-infix-form :stream stream) vars ring order))
[1092]509
[1146]510(defun string->poly (str vars
[1164]511 &optional
[1668]512 (ring +ring-of-integers+)
[1146]513 (order #'lex>))
514 "Converts a string STR to a polynomial in variables VARS."
[1097]515 (with-input-from-string (s str)
[1165]516 (read-poly vars :stream s :ring ring :order order)))
[1095]517
[1143]518(defun poly->alist (p)
519 "Convert a polynomial P to an association list. Thus, the format of the
520returned value is ((MONOM[0] . COEFF[0]) (MONOM[1] . COEFF[1]) ...), where
521MONOM[I] is a list of exponents in the monomial and COEFF[I] is the
522corresponding coefficient in the ring."
[1171]523 (cond
524 ((poly-p p)
525 (mapcar #'term->cons (poly-termlist p)))
526 ((and (consp p) (eq (car p) :[))
[1172]527 (cons :[ (mapcar #'poly->alist (cdr p))))))
[1143]528
[1164]529(defun string->alist (str vars
[2913]530 &optional
531 (ring +ring-of-integers+)
532 (order #'lex>))
[1143]533 "Convert a string STR representing a polynomial or polynomial list to
[1158]534an association list (... (MONOM . COEFF) ...)."
[1166]535 (poly->alist (string->poly str vars ring order)))
[1440]536
537(defun poly-equal-no-sugar-p (p q)
538 "Compare polynomials for equality, ignoring sugar."
[1914]539 (declare (type poly p q))
[1440]540 (equalp (poly-termlist p) (poly-termlist q)))
[1559]541
542(defun poly-set-equal-no-sugar-p (p q)
543 "Compare polynomial sets P and Q for equality, ignoring sugar."
544 (null (set-exclusive-or p q :test #'poly-equal-no-sugar-p )))
[1560]545
546(defun poly-list-equal-no-sugar-p (p q)
547 "Compare polynomial lists P and Q for equality, ignoring sugar."
548 (every #'poly-equal-no-sugar-p p q))
[2456]549|#
Note: See TracBrowser for help on using the repository browser.