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

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

* empty log message *

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