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

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

* empty log message *

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