Changeset 3441 for branches/f4grobner/monom.lisp

Timestamp:

2015-09-05T08:59:06-07:00 (9 years ago)

Author:

Marek Rychlik

Message:

* empty log message *

File:

• branches/f4grobner/monom.lisp (modified) (17 diffs)

branches/f4grobner/monom.lisp

@@ -102 +102 @@
      (error "Initarg DIMENSION or EXPONENTS must be supplied."))))
 
-(defmacro monom-dimension (m)
-  `(length (monom-exponents ,m)))
-
-(defmethod r-equalp ((m1 monom) (m2 monom))
+(defmethod monom-dimension (m)
+  (length (monom-exponents ,m)))
+
+(defmethod monom-equalp (m1 m2)
   "Returns T iff monomials M1 and M2 have identical
 EXPONENTS."
-  (equalp (monom-exponents m1) (monom-exponents m2)))
-
-(defmethod r-coeff ((m monom))
-  "A MONOM can be treated as a special case of TERM,
-where the coefficient is 1."
-  1)
-  
-(defmethod r-elt ((m monom) index)
+  `(equalp (monom-exponents ,m1) (monom-exponents ,m2)))
+
+(defmethod monom-elt (m index)
   "Return the power in the monomial M of variable number INDEX."
   (with-slots (exponents)
@@ -121 +116 @@
     (elt exponents index)))
 
-(defmethod (setf r-elt) (new-value (m monom) index)
+(defmethod (setf monom-elt) (new-value m index)
   "Return the power in the monomial M of variable number INDEX."
   (with-slots (exponents)
@@ -127 +122 @@
     (setf (elt exponents index) new-value)))
 
-(defmethod r-total-degree ((m monom) &optional (start 0) (end (monom-dimension m)))
+(defmethod monom-total-degree (m &optional (start 0) (end (monom-dimension m)))
   "Return the todal degree of a monomoal M. Optinally, a range
 of variables may be specified with arguments START and END."
@@ -136 +131 @@
 
 
-(defmethod r-sugar ((m monom) &aux (start 0) (end (monom-dimension m)))
+(defmethod monom-sugar (m &aux (start 0) (end (monom-dimension m)))
   "Return the sugar of a monomial M. Optinally, a range
 of variables may be specified with arguments START and END."
   (declare (type fixnum start end))
-    (r-total-degree m start end))
+  (monom-total-degree m start end))
 
 (defmethod multiply-by ((self monom) (other monom))
@@ -173 +168 @@
     copy))
 
-(defmethod r* ((m1 monom) (m2 monom))
+(defmethod monom* ((m1 monom) (m2 monom))
   "Non-destructively multiply monomial M1 by M2."
   (multiply-by (copy-instance m1) (copy-instance m2)))
 
-(defmethod r/ ((numerator monom) &rest denominators)
+(defmethod monom* ((numerator monom) &rest denominators)
   "Non-destructively divide monomial NUMERATOR by product of DENOMINATORS."
-  (divide-by (copy-instance numerator) (reduce #'r* denominators)))
-
-(defmethod r-divides-p ((m1 monom) (m2 monom))
+  (divide-by (copy-instance numerator) (reduce #'
+                                        monom* denominators)))
+
+(defmethod monom-divides-p ((m1 monom) (m2 monom))
   "Returns T if monomial M1 divides monomial M2, NIL otherwise."
   (with-slots ((exponents1 exponents))
@@ -190 +186 @@
 
 
-(defmethod r-divides-lcm-p ((m1 monom) (m2 monom) (m3 monom))
+(defmethod monom-divides-lcm-p ((m1 monom) (m2 monom) (m3 monom))
   "Returns T if monomial M1 divides LCM(M2,M3), NIL otherwise."
   (every #'(lambda (x y z) (<= x (max y z))) 
@@ -196 +192 @@
 
 
-(defmethod r-lcm-divides-lcm-p ((m1 monom) (m2 monom) (m3 monom) (m4 monom))
+(defmethod monom-lcm-divides-lcm-p ((m1 monom) (m2 monom) (m3 monom) (m4 monom))
   "Returns T if monomial MONOM-LCM(M1,M2) divides MONOM-LCM(M3,M4), NIL otherwise."
   (declare (type monom m1 m2 m3 m4))
@@ -202 +198 @@
          m1 m2 m3 m4))
          
-(defmethod r-lcm-equal-lcm-p (m1 m2 m3 m4)
+(defmethod monom-lcm-equal-lcm-p (m1 m2 m3 m4)
   "Returns T if monomial LCM(M1,M2) equals LCM(M3,M4), NIL otherwise."
   (with-slots ((exponents1 exponents))
@@ -216 +212 @@
            exponents1 exponents2 exponents3 exponents4))))))
 
-(defmethod r-divisible-by-p ((m1 monom) (m2 monom))
+(defmethod monom-divisible-by-p ((m1 monom) (m2 monom))
   "Returns T if monomial M1 is divisible by monomial M2, NIL otherwise."
   (with-slots ((exponents1 exponents))
@@ -224 +220 @@
       (every #'>= exponents1 exponents2))))
 
-(defmethod r-rel-prime-p ((m1 monom) (m2 monom))
+(defmethod monom-rel-prime-p ((m1 monom) (m2 monom))
   "Returns T if two monomials M1 and M2 are relatively prime (disjoint)."
   (with-slots ((exponents1 exponents))
@@ -233 +229 @@
 
 
-(defmethod r-lcm ((m1 monom) (m2 monom)) 
+(defmethod monom-lcm ((m1 monom) (m2 monom)) 
   "Returns least common multiple of monomials M1 and M2."
   (with-slots ((exponents1 exponents))
@@ -244 +240 @@
 
 
-(defmethod r-gcd ((m1 monom) (m2 monom))
+(defmethod monom-gcd ((m1 monom) (m2 monom))
   "Returns greatest common divisor of monomials M1 and M2."
   (with-slots ((exponents1 exponents))
@@ -254 +250 @@
         (make-instance 'monom :exponents exponents)))))
 
-(defmethod r-depends-p ((m monom) k)
+(defmethod monom-depends-p ((m monom) k)
   "Return T if the monomial M depends on variable number K."
   (declare (type fixnum k))
@@ -261 +257 @@
     (plusp (elt exponents k))))
 
-(defmethod left-tensor-product-by ((self monom) (other monom))
+(defmethod monom-left-tensor-product-by ((self monom) (other monom))
   (with-slots ((exponents1 exponents))
       self
@@ -269 +265 @@
   self)
 
-(defmethod right-tensor-product-by ((self monom) (other monom))
+(defmethod monom-right-tensor-product-by ((self monom) (other monom))
   (with-slots ((exponents1 exponents))
       self
@@ -277 +273 @@
   self)
 
-(defmethod left-contract ((self monom) k)
+(defmethod monom-left-contract ((self monom) k)
   "Drop the first K variables in monomial M."
   (declare (fixnum k))
@@ -298 +294 @@
     m))
 
-(defmethod r->list ((m monom))
+(defmethod monom->list ((m monom))
   "A human-readable representation of a monomial M as a list of exponents."  
   (coerce (monom-exponents m) 'list))
-
-(defmethod r-dimension ((self monom))
-  (monom-dimension self))
-
-(defmethod r-exponents ((self monom))
-  (monom-exponents self))