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/monom.lisp@ 3589

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

* empty log message *

File size: 20.4 KB
RevLine 
[1201]1;;; -*- Mode: Lisp -*-
[81]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
[1610]22(defpackage "MONOM"
[3446]23 (:use :cl :copy)
[422]24 (:export "MONOM"
[423]25 "EXPONENT"
[2781]26 "MONOM-DIMENSION"
27 "MONOM-EXPONENTS"
[3442]28 "MONOM-EQUALP"
29 "MONOM-ELT"
30 "MONOM-TOTAL-DEGREE"
[3466]31 "MONOM-SUGAR"
[3442]32 "MONOM-MULTIPLY-BY"
33 "MONOM-DIVIDE-BY"
34 "MONOM-COPY-INSTANCE"
35 "MONOM-MULTIPLY-2"
36 "MONOM-MULTIPLY"
37 "MONOM-DIVIDES-P"
38 "MONOM-DIVIDES-LCM-P"
39 "MONOM-LCM-DIVIDES-LCM-P"
40 "MONOM-LCM-EQUAL-LCM-P"
41 "MONOM-DIVISIBLE-BY-P"
42 "MONOM-REL-PRIME-P"
43 "MONOM-LCM"
44 "MONOM-GCD"
45 "MONOM-DEPENDS-P"
46 "MONOM-LEFT-TENSOR-PRODUCT-BY"
47 "MONOM-RIGHT-TENSOR-PRODUCT-BY"
48 "MONOM-LEFT-CONTRACT"
49 "MAKE-MONOM-VARIABLE"
[3472]50 "MONOM->LIST"
51 "LEX>"
52 "GRLEX>"
53 "REVLEX>"
54 "GREVLEX>"
55 "INVLEX>"
56 "REVERSE-MONOMIAL-ORDER"
[3482]57 "MAKE-ELIMINATION-ORDER-FACTORY")
[2524]58 (:documentation
[3477]59 "This package implements basic operations on monomials, including
60various monomial orders.
61
[2524]62DATA STRUCTURES: Conceptually, monomials can be represented as lists:
[81]63
[2524]64 monom: (n1 n2 ... nk) where ni are non-negative integers
65
66However, lists may be implemented as other sequence types, so the
67flexibility to change the representation should be maintained in the
68code to use general operations on sequences whenever possible. The
69optimization for the actual representation should be left to
70declarations and the compiler.
71
72EXAMPLES: Suppose that variables are x and y. Then
73
74 Monom x*y^2 ---> (1 2) "))
75
[1610]76(in-package :monom)
[48]77
[1925]78(proclaim '(optimize (speed 3) (space 0) (safety 0) (debug 0)))
[1923]79
[48]80(deftype exponent ()
81 "Type of exponent in a monomial."
82 'fixnum)
83
[2022]84(defclass monom ()
[3312]85 ((exponents :initarg :exponents :accessor monom-exponents
[3054]86 :documentation "The powers of the variables."))
[3289]87 ;; default-initargs are not needed, they are handled by SHARED-INITIALIZE
88 ;;(:default-initargs :dimension 'foo :exponents 'bar :exponent 'baz)
[2779]89 (:documentation
90 "Implements a monomial, i.e. a product of powers
91of variables, like X*Y^2."))
[880]92
[2245]93(defmethod print-object ((self monom) stream)
[3196]94 (print-unreadable-object (self stream :type t :identity t)
[3313]95 (with-accessors ((exponents monom-exponents))
[3216]96 self
[3313]97 (format stream "EXPONENTS=~A"
98 exponents))))
[2027]99
[3299]100(defmethod initialize-instance :after ((self monom)
[3297]101 &key
102 (dimension 0 dimension-supplied-p)
103 (exponents nil exponents-supplied-p)
[3318]104 (exponent 0)
[3297]105 &allow-other-keys
[2390]106 )
[3329]107 "The following INITIALIZE-INSTANCE method allows instance initialization
108of a MONOM in a style similar to MAKE-ARRAY, e.g.:
[3328]109
110 (MAKE-INSTANCE :EXPONENTS '(1 2 3)) --> #<MONOM EXPONENTS=#(1 2 3)>
111 (MAKE-INSTANCE :DIMENSION 3) --> #<MONOM EXPONENTS=#(0 0 0)>
112 (MAKE-INSTANCE :DIMENSION 3 :EXPONENT 7) --> #<MONOM EXPONENTS=#(7 7 7)>
[3329]113
114If both DIMENSION and EXPONENTS are supplied, they must be compatible,
115i.e. the length of EXPONENTS must be equal DIMENSION. If EXPONENTS
116is not supplied, a monom with repeated value EXPONENT is created.
117By default EXPONENT is 0, which results in a constant monomial.
[3328]118"
[3315]119 (cond
120 (exponents-supplied-p
[3327]121 (when (and dimension-supplied-p
122 (/= dimension (length exponents)))
123 (error "EXPONENTS (~A) must have supplied length DIMENSION (~A)"
124 exponents dimension))
[3315]125 (let ((dim (length exponents)))
126 (setf (slot-value self 'exponents) (make-array dim :initial-contents exponents))))
[3321]127 (dimension-supplied-p
[3315]128 ;; when all exponents are to be identical
[3321]129 (setf (slot-value self 'exponents) (make-array (list dimension)
130 :initial-element exponent
131 :element-type 'exponent)))
132 (t
133 (error "Initarg DIMENSION or EXPONENTS must be supplied."))))
[3293]134
[3573]135(defgeneric monom-dimension (m)
[3443]136 (:method ((m monom))
137 (length (monom-exponents m))))
[3317]138
[3541]139(defgeneric universal-equalp (object1 object2)
140 (:documentation "Returns T iff OBJECT1 and OBJECT2 are equal.")
[3443]141 (:method ((m1 monom) (m2 monom))
[3541]142 "Returns T iff monomials M1 and M2 have identical EXPONENTS."
[3535]143 (equalp (monom-exponents m1) (monom-exponents m2))))
[2547]144
[3443]145(defgeneric monom-elt (m index)
[3574]146 (:documentation "Return the power in the monomial M of variable number INDEX.")
[3443]147 (:method ((m monom) index)
[3550]148 "Return the power in the monomial M of variable number INDEX."
[3443]149 (with-slots (exponents)
150 m
151 (elt exponents index))))
[48]152
[3443]153(defgeneric (setf monom-elt) (new-value m index)
[3550]154 (:documentation "Set the power in the monomial M of variable number INDEX.")
[3443]155 (:method (new-value (m monom) index)
156 (with-slots (exponents)
157 m
[3453]158 (setf (elt exponents index) new-value))))
[2023]159
[3551]160(defgeneric total-degree (m &optional start end)
161 (:documentation "Return the total degree of a monomoal M. Optinally, a range
[3449]162of variables may be specified with arguments START and END.")
163 (:method ((m monom) &optional (start 0) (end (monom-dimension m)))
164 (declare (type fixnum start end))
165 (with-slots (exponents)
166 m
167 (reduce #'+ exponents :start start :end end))))
[48]168
[3552]169(defgeneric sugar (m &optional start end)
[3446]170 (:documentation "Return the sugar of a monomial M. Optinally, a range
171of variables may be specified with arguments START and END.")
172 (:method ((m monom) &optional (start 0) (end (monom-dimension m)))
173 (declare (type fixnum start end))
[3552]174 (total-degree m start end)))
[48]175
[3553]176(defgeneric multiply-by (self other)
[3549]177 (:documentation "Multiply SELF by OTHER, return SELF.")
[3446]178 (:method ((self monom) (other monom))
179 (with-slots ((exponents1 exponents))
180 self
181 (with-slots ((exponents2 exponents))
182 other
183 (unless (= (length exponents1) (length exponents2))
184 (error "Incompatible dimensions"))
185 (map-into exponents1 #'+ exponents1 exponents2)))
186 self))
[2069]187
[3553]188(defgeneric divide-by (self other)
[3544]189 (:documentation "Divide SELF by OTHER, return SELF.")
[3446]190 (:method ((self monom) (other monom))
191 (with-slots ((exponents1 exponents))
192 self
193 (with-slots ((exponents2 exponents))
194 other
195 (unless (= (length exponents1) (length exponents2))
196 (error "divide-by: Incompatible dimensions."))
197 (unless (every #'>= exponents1 exponents2)
198 (error "divide-by: Negative power would result."))
199 (map-into exponents1 #'- exponents1 exponents2)))
200 self))
[2818]201
[3448]202(defmethod copy-instance :around ((object monom) &rest initargs &key &allow-other-keys)
203 "An :AROUND method of COPY-INSTANCE. It replaces
204exponents with a fresh copy of the sequence."
[3446]205 (declare (ignore object initargs))
206 (let ((copy (call-next-method)))
207 (setf (monom-exponents copy) (copy-seq (monom-exponents copy)))
[3453]208 copy))
[2950]209
[3560]210(defun multiply-2 (object1 object2)
[3559]211 "Multiply OBJECT1 by OBJECT2"
212 (multiply-by (copy-instance object1) (copy-instance object2)))
[2816]213
[3557]214(defun multiply (&rest factors)
215 "Non-destructively multiply list FACTORS."
216 (reduce #'multiply-2 factors))
[3554]217
[3557]218(defun divide (numerator &rest denominators)
219 "Non-destructively divide object NUMERATOR by product of DENOMINATORS."
[3558]220 (divide-by (copy-instance numerator) (multiply denominators)))
[48]221
[3441]222(defmethod monom-divides-p ((m1 monom) (m2 monom))
[48]223 "Returns T if monomial M1 divides monomial M2, NIL otherwise."
[2039]224 (with-slots ((exponents1 exponents))
225 m1
226 (with-slots ((exponents2 exponents))
227 m2
228 (every #'<= exponents1 exponents2))))
[48]229
[3585]230(defgeneric divides-lcm-p (object1 object2 object3)
231 (:documentation "Returns T if OBJECT1 divides LCM(OBJECT2,OBJECT3), NIL otherwise."
232 (:method ((m1 monom) (m2 monom) (m3 monom))
233 "Returns T if monomial M1 divides LCM(M2,M3), NIL otherwise."
234 (every #'(lambda (x y z) (<= x (max y z)))
[3586]235 exponents1 exponents2 exponents3)))
[48]236
[3588]237(defgeneric lcm-divides-lcm-p (object1 object2 object3 object4)
238 (:method ((m1 monom) (m2 monom) (m3 monom) (m4 monom))
239 "Returns T if monomial LCM(M1,M2) divides LCM(M3,M4), NIL otherwise."
240 (with-slots ((exponents1 exponents))
241 m1
242 (with-slots ((exponents2 exponents))
243 m2
244 (with-slots ((exponents3 exponents))
245 m3
246 (with-slots ((exponents4 exponents))
247 m4
248 (every #'(lambda (x y z w) (<= (max x y) (max z w)))
249 exponents1 exponents2 exponents3 exponents4))))))
[869]250
[3589]251(defgeneric monom-lcm-equal-lcm-p (object1 object2 object3 object4)
252 (:method ((m1 monom) (m2 monom) (m3 monom) (m4 monom))
253 "Returns T if monomial LCM(M1,M2) equals LCM(M3,M4), NIL otherwise."
254 (with-slots ((exponents1 exponents))
255 m1
256 (with-slots ((exponents2 exponents))
257 m2
258 (with-slots ((exponents3 exponents))
259 m3
260 (with-slots ((exponents4 exponents))
261 m4
262 (every
263 #'(lambda (x y z w) (= (max x y) (max z w)))
264 exponents1 exponents2 exponents3 exponents4)))))))
[48]265
[3563]266(defgeneric divisible-by-p (object1 object2)
267 (:documentation "Return T if OBJECT1 is divisible by OBJECT2.")
268 (:method ((m1 monom) (m2 monom))
269 "Returns T if monomial M1 is divisible by monomial M2, NIL otherwise."
270 (with-slots ((exponents1 exponents))
271 m1
272 (with-slots ((exponents2 exponents))
273 m2
274 (every #'>= exponents1 exponents2)))))
[2078]275
[3565]276(defgeneric rel-prime-p (object1 object2)
[3575]277 (:documentation "Returns T if objects OBJECT1 and OBJECT2 are relatively prime.")
[3563]278 (:method ((m1 monom) (m2 monom))
279 "Returns T if two monomials M1 and M2 are relatively prime (disjoint)."
280 (with-slots ((exponents1 exponents))
281 m1
282 (with-slots ((exponents2 exponents))
283 m2
284 (every #'(lambda (x y) (zerop (min x y))) exponents1 exponents2)))))
[48]285
[3566]286(defgeneric monom-lcm (object1 object2)
287 (:documentation "Returns the multiple of objects OBJECT1 and OBJECT2.")
288 (:method ((m1 monom) (m2 monom))
289 "Returns least common multiple of monomials M1 and M2."
290 (with-slots ((exponents1 exponents))
291 m1
292 (with-slots ((exponents2 exponents))
293 m2
294 (let* ((exponents (copy-seq exponents1)))
295 (map-into exponents #'max exponents1 exponents2)
296 (make-instance 'monom :exponents exponents))))))
[48]297
[2080]298
[3567]299(defgeneric universal-gcd (object1 object2)
300 (:documentation "Returns GCD of objects OBJECT1 and OBJECT2")
301 (:method ((m1 monom) (m2 monom))
[3568]302 "Returns greatest common divisor of monomials M1 and M2."
303 (with-slots ((exponents1 exponents))
304 m1
305 (with-slots ((exponents2 exponents))
306 m2
307 (let* ((exponents (copy-seq exponents1)))
308 (map-into exponents #'min exponents1 exponents2)
309 (make-instance 'monom :exponents exponents))))))
[48]310
[3569]311(defgeneric depends-p (object k)
312 (:documentation "Returns T iff object OBJECT depends on variable K.")
313 (:method ((m monom) k)
314 "Return T if the monomial M depends on variable number K."
315 (declare (type fixnum k))
316 (with-slots (exponents)
317 m
318 (plusp (elt exponents k)))))
[48]319
[3570]320(defgeneric left-tensor-product-by (self other)
321 (:documentation "Returns a tensor product SELF by OTHER, stored into
322 SELF. Return SELF.")
323 (:method ((self monom) (other monom))
324 (with-slots ((exponents1 exponents))
325 self
326 (with-slots ((exponents2 exponents))
327 other
328 (setf exponents1 (concatenate 'vector exponents2 exponents1))))
329 self))
[48]330
[3570]331(defgeneric right-tensor-product-by (self other)
332 (:documentation "Returns a tensor product of OTHER by SELF, stored
333 into SELF. Returns SELF.")
334 (:method ((self monom) (other monom))
335 (with-slots ((exponents1 exponents))
336 self
337 (with-slots ((exponents2 exponents))
338 other
339 (setf exponents1 (concatenate 'vector exponents1 exponents2))))
340 self))
[3026]341
[3571]342(defgeneric left-contract (self k)
343 (:documentation "Drop the first K variables in object SELF.")
344 (:method ((self monom) k)
345 "Drop the first K variables in monomial M."
346 (declare (fixnum k))
347 (with-slots (exponents)
348 self
349 (setf exponents (subseq exponents k)))
350 self))
[886]351
352(defun make-monom-variable (nvars pos &optional (power 1)
[2218]353 &aux (m (make-instance 'monom :dimension nvars)))
[886]354 "Construct a monomial in the polynomial ring
355RING[X[0],X[1],X[2],...X[NVARS-1]] over the (unspecified) ring RING
356which represents a single variable. It assumes number of variables
357NVARS and the variable is at position POS. Optionally, the variable
358may appear raised to power POWER. "
[1924]359 (declare (type fixnum nvars pos power) (type monom m))
[2089]360 (with-slots (exponents)
361 m
[2154]362 (setf (elt exponents pos) power)
[2089]363 m))
[1151]364
[3441]365(defmethod monom->list ((m monom))
[1152]366 "A human-readable representation of a monomial M as a list of exponents."
[2779]367 (coerce (monom-exponents m) 'list))
[3472]368
369
[3474]370;; pure lexicographic
[3472]371(defgeneric lex> (p q &optional start end)
372 (:documentation "Return T if P>Q with respect to lexicographic
373order, otherwise NIL. The second returned value is T if P=Q,
374otherwise it is NIL.")
[3483]375 (:method ((p monom) (q monom) &optional (start 0) (end (monom-dimension p)))
[3472]376 (declare (type fixnum start end))
377 (do ((i start (1+ i)))
378 ((>= i end) (values nil t))
379 (cond
[3483]380 ((> (monom-elt p i) (monom-elt q i))
[3472]381 (return-from lex> (values t nil)))
[3483]382 ((< (monom-elt p i) (monom-elt q i))
[3472]383 (return-from lex> (values nil nil)))))))
384
[3475]385;; total degree order, ties broken by lexicographic
[3472]386(defgeneric grlex> (p q &optional start end)
387 (:documentation "Return T if P>Q with respect to graded
388lexicographic order, otherwise NIL. The second returned value is T if
389P=Q, otherwise it is NIL.")
[3483]390 (:method ((p monom) (q monom) &optional (start 0) (end (monom-dimension p)))
[3472]391 (declare (type monom p q) (type fixnum start end))
[3583]392 (let ((d1 (total-degree p start end))
393 (d2 (total-degree q start end)))
[3472]394 (declare (type fixnum d1 d2))
395 (cond
396 ((> d1 d2) (values t nil))
397 ((< d1 d2) (values nil nil))
398 (t
399 (lex> p q start end))))))
400
401;; reverse lexicographic
402(defgeneric revlex> (p q &optional start end)
403 (:documentation "Return T if P>Q with respect to reverse
404lexicographic order, NIL otherwise. The second returned value is T if
405P=Q, otherwise it is NIL. This is not and admissible monomial order
406because some sets do not have a minimal element. This order is useful
407in constructing other orders.")
[3483]408 (:method ((p monom) (q monom) &optional (start 0) (end (monom-dimension p)))
[3472]409 (declare (type fixnum start end))
410 (do ((i (1- end) (1- i)))
411 ((< i start) (values nil t))
412 (declare (type fixnum i))
413 (cond
[3483]414 ((< (monom-elt p i) (monom-elt q i))
[3472]415 (return-from revlex> (values t nil)))
[3483]416 ((> (monom-elt p i) (monom-elt q i))
[3472]417 (return-from revlex> (values nil nil)))))))
418
419
420;; total degree, ties broken by reverse lexicographic
421(defgeneric grevlex> (p q &optional start end)
422 (:documentation "Return T if P>Q with respect to graded reverse
423lexicographic order, NIL otherwise. The second returned value is T if
424P=Q, otherwise it is NIL.")
[3483]425 (:method ((p monom) (q monom) &optional (start 0) (end (monom-dimension p)))
[3472]426 (declare (type fixnum start end))
[3584]427 (let ((d1 (total-degree p start end))
428 (d2 (total-degree q start end)))
[3472]429 (declare (type fixnum d1 d2))
430 (cond
431 ((> d1 d2) (values t nil))
432 ((< d1 d2) (values nil nil))
433 (t
434 (revlex> p q start end))))))
435
436(defgeneric invlex> (p q &optional start end)
437 (:documentation "Return T if P>Q with respect to inverse
438lexicographic order, NIL otherwise The second returned value is T if
439P=Q, otherwise it is NIL.")
[3483]440 (:method ((p monom) (q monom) &optional (start 0) (end (monom-dimension p)))
[3472]441 (declare (type fixnum start end))
442 (do ((i (1- end) (1- i)))
443 ((< i start) (values nil t))
444 (declare (type fixnum i))
445 (cond
[3483]446 ((> (monom-elt p i) (monom-elt q i))
[3472]447 (return-from invlex> (values t nil)))
[3483]448 ((< (monom-elt p i) (monom-elt q i))
[3472]449 (return-from invlex> (values nil nil)))))))
450
451(defun reverse-monomial-order (order)
452 "Create the inverse monomial order to the given monomial order ORDER."
[3483]453 #'(lambda (p q &optional (start 0) (end (monom-dimension q)))
[3472]454 (declare (type monom p q) (type fixnum start end))
455 (funcall order q p start end)))
456
457;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
458;;
459;; Order making functions
460;;
461;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
462
463;; This returns a closure with the same signature
464;; as all orders such as #'LEX>.
[3487]465(defun make-elimination-order-factory-1 (&optional (secondary-elimination-order #'lex>))
[3472]466 "It constructs an elimination order used for the 1-st elimination ideal,
467i.e. for eliminating the first variable. Thus, the order compares the degrees of the
468first variable in P and Q first, with ties broken by SECONDARY-ELIMINATION-ORDER."
[3483]469 #'(lambda (p q &optional (start 0) (end (monom-dimension p)))
[3472]470 (declare (type monom p q) (type fixnum start end))
471 (cond
[3483]472 ((> (monom-elt p start) (monom-elt q start))
[3472]473 (values t nil))
[3483]474 ((< (monom-elt p start) (monom-elt q start))
[3472]475 (values nil nil))
476 (t
477 (funcall secondary-elimination-order p q (1+ start) end)))))
478
479;; This returns a closure which is called with an integer argument.
480;; The result is *another closure* with the same signature as all
481;; orders such as #'LEX>.
[3486]482(defun make-elimination-order-factory (&optional
[3472]483 (primary-elimination-order #'lex>)
484 (secondary-elimination-order #'lex>))
485 "Return a function with a single integer argument K. This should be
486the number of initial K variables X[0],X[1],...,X[K-1], which precede
487remaining variables. The call to the closure creates a predicate
488which compares monomials according to the K-th elimination order. The
489monomial orders PRIMARY-ELIMINATION-ORDER and
490SECONDARY-ELIMINATION-ORDER are used to compare the first K and the
491remaining variables, respectively, with ties broken by lexicographical
492order. That is, if PRIMARY-ELIMINATION-ORDER yields (VALUES NIL T),
493which indicates that the first K variables appear with identical
494powers, then the result is that of a call to
495SECONDARY-ELIMINATION-ORDER applied to the remaining variables
496X[K],X[K+1],..."
497 #'(lambda (k)
498 (cond
499 ((<= k 0)
500 (error "K must be at least 1"))
501 ((= k 1)
[3485]502 (make-elimination-order-factory-1 secondary-elimination-order))
[3472]503 (t
[3483]504 #'(lambda (p q &optional (start 0) (end (monom-dimension p)))
[3472]505 (declare (type monom p q) (type fixnum start end))
506 (multiple-value-bind (primary equal)
507 (funcall primary-elimination-order p q start k)
508 (if equal
509 (funcall secondary-elimination-order p q k end)
510 (values primary nil))))))))
511
[3531]512(defclass term (monom)
513 ((coeff :initarg :coeff :accessor term-coeff))
514 (:default-initargs :coeff nil)
515 (:documentation "Implements a term, i.e. a product of a scalar
516and powers of some variables, such as 5*X^2*Y^3."))
517
518(defmethod print-object ((self term) stream)
519 (print-unreadable-object (self stream :type t :identity t)
520 (with-accessors ((exponents monom-exponents)
[3532]521 (coeff term-coeff))
[3531]522 self
523 (format stream "EXPONENTS=~A COEFF=~A"
524 exponents coeff))))
525
[3542]526(defmethod universal-equalp ((term1 term) (term2 term))
527 "Returns T if TERM1 and TERM2 are equal as MONOM, and coefficients
528are UNIVERSAL-EQUALP."
[3540]529 (and (call-next-method)
530 (universal-equalp (term-coeff term1) (term-coeff term2))))
[3531]531
[3533]532(defmethod update-instance-for-different-class :after ((old monom) (new term) &key)
533 (setf (term-coeff new) 1))
[3531]534
[3556]535(defmethod multiply-by :before ((self term) (other term))
[3531]536 "Destructively multiply terms SELF and OTHER and store the result into SELF.
537It returns SELF."
[3580]538 (setf (term-coeff self) (multiply-by (term-coeff self) (term-coeff other))))
[3531]539
[3581]540(defmethod left-tensor-product-by :before ((self term) (other term))
[3579]541 (setf (term-coeff self) (multiply-by (term-coeff self) (term-coeff other))))
[3531]542
[3581]543(defmethod right-tensor-product-by :before ((self term) (other term))
[3556]544 (setf (term-coeff self) (multiply-by (term-coeff self) (term-coeff other))))
[3531]545
[3556]546(defmethod divide-by :before ((self term) (other term))
547 (setf (term-coeff self) (divide-by (term-coeff self) (term-coeff other))))
[3531]548
[3582]549(defgeneric unary-minus (self)
550 (:method ((self term))
551 (setf (term-coeff self) (unary-minus (term-coeff self)))
552 self))
[3531]553
[3578]554(defgeneric universal-zerop (self)
555 (:method ((self term))
556 (universal-zerop (term-coeff self))))
Note: See TracBrowser for help on using the repository browser.