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

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

* empty log message *

File size: 10.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 :ring)
24 (:export "MONOM"
25 "EXPONENT"
26 "MONOM-DIMENSION"
27 "MONOM-EXPONENTS"
28 "MONOM-EQUALP"
29 "MONOM-CLONE"
30 "MAKE-MONOM-VARIABLE")
31 (:documentation
32 "This package implements basic operations on monomials.
33DATA STRUCTURES: Conceptually, monomials can be represented as lists:
34
35 monom: (n1 n2 ... nk) where ni are non-negative integers
36
37However, lists may be implemented as other sequence types, so the
38flexibility to change the representation should be maintained in the
39code to use general operations on sequences whenever possible. The
40optimization for the actual representation should be left to
41declarations and the compiler.
42
43EXAMPLES: Suppose that variables are x and y. Then
44
45 Monom x*y^2 ---> (1 2) "))
46
47(in-package :monom)
48
49(proclaim '(optimize (speed 3) (space 0) (safety 0) (debug 0)))
50
51(deftype exponent ()
52 "Type of exponent in a monomial."
53 'fixnum)
54
55(defclass monom ()
56 ((dimension :initarg :dimension :accessor monom-dimension)
57 (exponents :initarg :exponents :accessor monom-exponents))
58 (:default-initargs :dimension nil :exponents nil :exponent nil)
59 (:documentation
60 "Implements a monomial, i.e. a product of powers
61of variables, like X*Y^2."))
62
63(defmethod print-object ((self monom) stream)
64 (format stream "#<MONOM DIMENSION=~A EXPONENTS=~A>"
65 (monom-dimension self)
66 (monom-exponents self)))
67
68(defmethod shared-initialize :after ((self monom) slot-names
69 &key
70 dimension
71 exponents
72 exponent
73 &allow-other-keys
74 )
75 (if (eq slot-names t) (setf slot-names '(dimension exponents)))
76 (dolist (slot-name slot-names)
77 (case slot-name
78 (dimension
79 (cond (dimension
80 (setf (slot-value self 'dimension) dimension))
81 (exponents
82 (setf (slot-value self 'dimension) (length exponents)))
83 (t
84 (error "DIMENSION or EXPONENTS must not be NIL"))))
85 (exponents
86 (cond
87 ;; when exponents are supplied
88 (exponents
89 (let ((dim (length exponents)))
90 (when (and dimension (/= dimension dim))
91 (error "EXPONENTS must have length DIMENSION"))
92 (setf (slot-value self 'dimension) dim
93 (slot-value self 'exponents) (make-array dim :initial-contents exponents))))
94 ;; when all exponents are to be identical
95 (t
96 (let ((dim (slot-value self 'dimension)))
97 (setf (slot-value self 'exponents)
98 (make-array (list dim) :initial-element (or exponent 0)
99 :element-type 'exponent)))))))))
100
101(defun monom-clone (m)
102 (make-instance 'monom
103 :dimension (monom-dimension m)
104 :exponents (copy-seq (monom-exponents m))))
105
106(defun monom-equalp (m1 m2)
107 "Returns T iff monomials M1 and M2 have identical
108EXPONENTS."
109 (declare (type monom m1 m2))
110 (equalp (monom-exponents m1) (monom-exponents m2)))
111
112(defmethod r-coeff ((m monom))
113 "A MONOM can be treated as a special case of TERM,
114where the coefficient is 1."
115 1)
116
117(defmethod r-elt ((m monom) index)
118 "Return the power in the monomial M of variable number INDEX."
119 (with-slots (exponents)
120 m
121 (elt exponents index)))
122
123(defmethod (setf r-elt) (new-value (m monom) index)
124 "Return the power in the monomial M of variable number INDEX."
125 (with-slots (exponents)
126 m
127 (setf (elt exponents index) new-value)))
128
129(defmethod r-total-degree ((m monom) &optional (start 0) (end (monom-dimension m)))
130 "Return the todal degree of a monomoal M. Optinally, a range
131of variables may be specified with arguments START and END."
132 (declare (type fixnum start end))
133 (with-slots (exponents)
134 m
135 (reduce #'+ exponents :start start :end end)))
136
137
138(defmethod r-sugar ((m monom) &aux (start 0) (end (monom-dimension m)))
139 "Return the sugar of a monomial M. Optinally, a range
140of variables may be specified with arguments START and END."
141 (declare (type fixnum start end))
142 (r-total-degree m start end))
143
144(defmethod multiply-by ((self monom) (other monom))
145 (with-slots ((exponents1 exponents) (dimension1 dimension))
146 self
147 (with-slots ((exponents2 exponents) (dimension2 dimension))
148 other
149 (unless (= dimension1 dimension2)
150 (error "Incompatible dimensions: ~A and ~A.~%" dimension1 dimension2))
151 (map-into exponents1 #'+ exponents1 exponents2)))
152 self)
153
154(defmethod divide-by ((self monom) (other monom))
155 (with-slots ((exponents1 exponents) (dimension1 dimension))
156 self
157 (with-slots ((exponents2 exponents) (dimension2 dimension))
158 other
159 (unless (= dimension1 dimension2)
160 (error "Incompatible dimensions: ~A and ~A.~%" dimension1 dimension2))
161 (map-into exponents1 #'- exponents1 exponents2)))
162 self)
163
164(defmethod r* ((m1 monom) (m2 monom))
165 "Non-destructively multiply monomial M1 by M2."
166 (multiply-by (monom-clone m1) (monom-clone m2)))
167
168(defmethod r/ ((m1 monom) (m2 monom))
169 "Divide monomial M1 by monomial M2."
170 (with-slots ((exponents1 exponents) (dimension1 dimension))
171 m1
172 (with-slots ((exponents2 exponents))
173 m2
174 (let* ((exponents (copy-seq exponents1))
175 (dimension dimension1))
176 (map-into exponents #'- exponents1 exponents2)
177 (make-instance 'monom :dimension dimension :exponents exponents)))))
178
179(defmethod r-divides-p ((m1 monom) (m2 monom))
180 "Returns T if monomial M1 divides monomial M2, NIL otherwise."
181 (with-slots ((exponents1 exponents))
182 m1
183 (with-slots ((exponents2 exponents))
184 m2
185 (every #'<= exponents1 exponents2))))
186
187
188(defmethod r-divides-lcm-p ((m1 monom) (m2 monom) (m3 monom))
189 "Returns T if monomial M1 divides LCM(M2,M3), NIL otherwise."
190 (every #'(lambda (x y z) (<= x (max y z)))
191 m1 m2 m3))
192
193
194(defmethod r-lcm-divides-lcm-p ((m1 monom) (m2 monom) (m3 monom) (m4 monom))
195 "Returns T if monomial MONOM-LCM(M1,M2) divides MONOM-LCM(M3,M4), NIL otherwise."
196 (declare (type monom m1 m2 m3 m4))
197 (every #'(lambda (x y z w) (<= (max x y) (max z w)))
198 m1 m2 m3 m4))
199
200(defmethod r-lcm-equal-lcm-p (m1 m2 m3 m4)
201 "Returns T if monomial LCM(M1,M2) equals LCM(M3,M4), NIL otherwise."
202 (with-slots ((exponents1 exponents))
203 m1
204 (with-slots ((exponents2 exponents))
205 m2
206 (with-slots ((exponents3 exponents))
207 m3
208 (with-slots ((exponents4 exponents))
209 m4
210 (every
211 #'(lambda (x y z w) (= (max x y) (max z w)))
212 exponents1 exponents2 exponents3 exponents4))))))
213
214(defmethod r-divisible-by-p ((m1 monom) (m2 monom))
215 "Returns T if monomial M1 is divisible by monomial M2, NIL otherwise."
216 (with-slots ((exponents1 exponents))
217 m1
218 (with-slots ((exponents2 exponents))
219 m2
220 (every #'>= exponents1 exponents2))))
221
222(defmethod r-rel-prime-p ((m1 monom) (m2 monom))
223 "Returns T if two monomials M1 and M2 are relatively prime (disjoint)."
224 (with-slots ((exponents1 exponents))
225 m1
226 (with-slots ((exponents2 exponents))
227 m2
228 (every #'(lambda (x y) (zerop (min x y))) exponents1 exponents2))))
229
230
231(defmethod r-equalp ((m1 monom) (m2 monom))
232 "Returns T if two monomials M1 and M2 are equal."
233 (monom-equalp m1 m2))
234
235(defmethod r-lcm ((m1 monom) (m2 monom))
236 "Returns least common multiple of monomials M1 and M2."
237 (with-slots ((exponents1 exponents) (dimension1 dimension))
238 m1
239 (with-slots ((exponents2 exponents))
240 m2
241 (let* ((exponents (copy-seq exponents1))
242 (dimension dimension1))
243 (map-into exponents #'max exponents1 exponents2)
244 (make-instance 'monom :dimension dimension :exponents exponents)))))
245
246
247(defmethod r-gcd ((m1 monom) (m2 monom))
248 "Returns greatest common divisor of monomials M1 and M2."
249 (with-slots ((exponents1 exponents) (dimension1 dimension))
250 m1
251 (with-slots ((exponents2 exponents))
252 m2
253 (let* ((exponents (copy-seq exponents1))
254 (dimension dimension1))
255 (map-into exponents #'min exponents1 exponents2)
256 (make-instance 'monom :dimension dimension :exponents exponents)))))
257
258(defmethod r-depends-p ((m monom) k)
259 "Return T if the monomial M depends on variable number K."
260 (declare (type fixnum k))
261 (with-slots (exponents)
262 m
263 (plusp (elt exponents k))))
264
265(defmethod r-tensor-product ((m1 monom) (m2 monom))
266 (with-slots ((exponents1 exponents) (dimension1 dimension))
267 m1
268 (with-slots ((exponents2 exponents) (dimension2 dimension))
269 m2
270 (make-instance 'monom
271 :dimension (+ dimension1 dimension2)
272 :exponents (concatenate 'vector exponents1 exponents2)))))
273
274(defmethod r-contract ((m monom) k)
275 "Drop the first K variables in monomial M."
276 (declare (fixnum k))
277 (with-slots (dimension exponents)
278 m
279 (setf dimension (- dimension k)
280 exponents (subseq exponents k))))
281
282(defun make-monom-variable (nvars pos &optional (power 1)
283 &aux (m (make-instance 'monom :dimension nvars)))
284 "Construct a monomial in the polynomial ring
285RING[X[0],X[1],X[2],...X[NVARS-1]] over the (unspecified) ring RING
286which represents a single variable. It assumes number of variables
287NVARS and the variable is at position POS. Optionally, the variable
288may appear raised to power POWER. "
289 (declare (type fixnum nvars pos power) (type monom m))
290 (with-slots (exponents)
291 m
292 (setf (elt exponents pos) power)
293 m))
294
295(defmethod r->list ((m monom))
296 "A human-readable representation of a monomial M as a list of exponents."
297 (coerce (monom-exponents m) 'list))
298
299(defmethod r-dimension ((self monom))
300 (monom-dimension self))
301
302(defmethod r-exponents ((self monom))
303 (monom-exponents self))
Note: See TracBrowser for help on using the repository browser.