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

Last change on this file since 3824 was 3824, checked in by Marek Rychlik, 8 years ago

* empty log message *

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