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

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

* empty log message *

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