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/monomial.lisp@ 70

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

* empty log message *

File size: 5.2 KB
RevLine 
[48]1;;----------------------------------------------------------------
2;; This package implements BASIC OPERATIONS ON MONOMIALS
3;;----------------------------------------------------------------
4;; DATA STRUCTURES: Monomials are represented as lists:
5;;
6;; monom: (n1 n2 ... nk) where ni are non-negative integers
7;;
8;; However, lists may be implemented as other sequence types,
9;; so the flexibility to change the representation should be
10;; maintained in the code to use general operations on sequences
11;; whenever possible. The optimization for the actual representation
12;; should be left to declarations and the compiler.
13;;----------------------------------------------------------------
14;; EXAMPLES: Suppose that variables are x and y. Then
15;;
16;; Monom x*y^2 ---> (1 2)
17;;
18;;----------------------------------------------------------------
19
20(deftype exponent ()
21 "Type of exponent in a monomial."
22 'fixnum)
23
24(deftype monom (&optional dim)
25 "Type of monomial."
26 `(simple-array exponent (,dim)))
27
28;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
29;;
30;; Construction of monomials
31;;
32;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
33
34(defmacro make-monom (dim &key (initial-contents nil initial-contents-supplied-p)
35 (initial-element 0 initial-element-supplied-p))
36 "Make a monomial with DIM variables. Additional argument
37INITIAL-CONTENTS specifies the list of powers of the consecutive
38variables. The alternative additional argument INITIAL-ELEMENT
39specifies the common power for all variables."
40 ;;(declare (fixnum dim))
41 `(make-array ,dim
42 :element-type 'exponent
43 ,@(when initial-contents-supplied-p `(:initial-contents ,initial-contents))
44 ,@(when initial-element-supplied-p `(:initial-element ,initial-element))))
45
46
47
48;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
49;;
50;; Operations on monomials
51;;
52;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
53
54(defmacro monom-elt (m index)
55 "Return the power in the monomial M of variable number INDEX."
56 `(elt ,m ,index))
57
58(defun monom-dimension (m)
59 "Return the number of variables in the monomial M."
60 (length m))
61
62(defun monom-total-degree (m &optional (start 0) (end (length m)))
63 "Return the todal degree of a monomoal M. Optinally, a range
64of variables may be specified with arguments START and END."
65 (declare (type monom m) (fixnum start end))
66 (reduce #'+ m :start start :end end))
67
68(defun monom-sugar (m &aux (start 0) (end (length m)))
69 "Return the sugar of a monomial M. Optinally, a range
70of variables may be specified with arguments START and END."
71 (declare (type monom m) (fixnum start end))
72 (monom-total-degree m start end))
73
74(defun monom-div (m1 m2 &aux (result (copy-seq m1)))
75 "Divide monomial M1 by monomial M2."
76 (declare (type monom m1 m2 result))
77 (map-into result #'- m1 m2))
78
79(defun monom-mul (m1 m2 &aux (result (copy-seq m1)))
80 "Multiply monomial M1 by monomial M2."
81 (declare (type monom m1 m2 result))
82 (map-into result #'+ m1 m2))
83
84(defun monom-divides-p (m1 m2)
85 "Returns T if monomial M1 divides monomial M2, NIL otherwise."
86 (declare (type monom m1 m2))
87 (every #'<= m1 m2))
88
89(defun monom-divides-monom-lcm-p (m1 m2 m3)
90 "Returns T if monomial M1 divides MONOM-LCM(M2,M3), NIL otherwise."
91 (declare (type monom m1 m2 m3))
92 (every #'(lambda (x y z) (declare (type exponent x y z)) (<= x (max y z))) m1 m2 m3))
93
94(defun monom-lcm-divides-monom-lcm-p (m1 m2 m3 m4)
95 "Returns T if monomial MONOM-LCM(M1,M2) divides MONOM-LCM(M3,M4), NIL otherwise."
96 (declare (type monom m1 m2 m3 m4))
97 (every #'(lambda (x y z w) (declare (type exponent x y z w)) (<= (max x y) (max z w))) m1 m2 m3 m4))
98
99(defun monom-lcm-equal-monom-lcm-p (m1 m2 m3 m4)
100 "Returns T if monomial MONOM-LCM(M1,M2) equals MONOM-LCM(M3,M4), NIL otherwise."
101 (declare (type monom m1 m2 m3 m4))
102 (every #'(lambda (x y z w) (declare (type exponent x y z w)) (= (max x y) (max z w))) m1 m2 m3 m4))
103
104(defun monom-divisible-by-p (m1 m2)
105 "Returns T if monomial M1 is divisible by monomial M2, NIL otherwise."
106 (declare (type monom m1 m2))
107 (every #'>= m1 m2))
108
109(defun monom-rel-prime-p (m1 m2)
110 "Returns T if two monomials M1 and M2 are relatively prime (disjoint)."
111 (declare (type monom m1 m2))
112 (every #'(lambda (x y) (declare (type exponent x y)) (zerop (min x y))) m1 m2))
113
114(defun monom-equal-p (m1 m2)
115 "Returns T if two monomials M1 and M2 are equal."
116 (declare (type monom m1 m2))
117 (every #'= m1 m2))
118
119(defun monom-lcm (m1 m2 &aux (result (copy-seq m1)))
120 "Returns least common multiple of monomials M1 and M2."
121 (declare (type monom m1 m2))
122 (map-into result #'max m1 m2))
123
124(defun monom-gcd (m1 m2 &aux (result (copy-seq m1)))
125 "Returns greatest common divisor of monomials M1 and M2."
126 (declare (type monom m1 m2))
127 (map-into result #'min m1 m2))
128
129(defun monom-depends-p (m k)
130 "Return T if the monomial M depends on variable number K."
131 (declare (type monom m) (fixnum k))
132 (plusp (elt m k)))
133
134(defmacro monom-map (fun m &rest ml &aux (result `(copy-seq ,m)))
135 `(map-into ,result ,fun ,m ,@ml))
136
137(defmacro monom-append (m1 m2)
138 `(concatenate 'monom ,m1 ,m2))
139
140(defmacro monom-contract (k m)
141 `(subseq ,m ,k))
142
143(defun monom-exponents (m)
144 (declare (type monom m))
145 (coerce m 'list))
Note: See TracBrowser for help on using the repository browser.