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

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

* empty log message *

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