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

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

* empty log message *

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