Changeset 3531 for branches

Timestamp:

2015-09-05T15:36:37-07:00 (9 years ago)

Author:

Marek Rychlik

Message:

* empty log message *

File:

• branches/f4grobner/monom.lisp (modified) (1 diff)

branches/f4grobner/monom.lisp

@@ -477 +477 @@
                    (values primary nil))))))))
 
+
+(defclass term (monom)
+  ((coeff :initarg :coeff :accessor term-coeff))
+  (:default-initargs :coeff nil)
+  (:documentation "Implements a term, i.e. a product of a scalar
+and powers of some variables, such as 5*X^2*Y^3."))
+
+(defmethod print-object ((self term) stream)
+  (print-unreadable-object (self stream :type t :identity t)
+    (with-accessors ((exponents monom-exponents)
+                     (coeff scalar-coeff))
+        self
+      (format stream "EXPONENTS=~A COEFF=~A"
+              exponents coeff))))
+
+
+(defmethod r-equalp ((term1 term) (term2 term))
+  (when (r-equalp (scalar-coeff term1) (scalar-coeff term2))
+    (call-next-method)))
+
+(defmethod update-instance-for-different-class :after ((old monom) (new  scalar) &key)
+  (setf (scalar-coeff new) 1))
+
+(defmethod multiply-by :before ((self term) (other term))
+  "Destructively multiply terms SELF and OTHER and store the result into SELF.
+It returns SELF."
+  (setf (scalar-coeff self) (multiply-by (scalar-coeff self) (scalar-coeff other))))
+
+(defmethod left-tensor-product-by ((self term) (other term))
+  (setf (scalar-coeff self) (multiply-by (scalar-coeff self) (scalar-coeff other)))
+  (call-next-method))
+
+(defmethod right-tensor-product-by ((self term) (other term))
+  (setf (scalar-coeff self) (multiply-by (scalar-coeff self) (scalar-coeff other)))
+  (call-next-method))
+
+(defmethod left-tensor-product-by ((self term) (other monom))
+  (call-next-method))
+
+(defmethod right-tensor-product-by ((self term) (other monom))
+  (call-next-method))
+
+(defmethod divide-by ((self term) (other term))
+  "Destructively divide term SELF by OTHER and store the result into SELF.
+It returns SELF."
+  (setf (scalar-coeff self) (divide-by (scalar-coeff self) (scalar-coeff other)))
+  (call-next-method))
+
+(defmethod unary-minus ((self term))
+  (setf (scalar-coeff self) (unary-minus (scalar-coeff self)))
+  self)
+
+(defmethod r* ((term1 term) (term2 term))
+  "Non-destructively multiply TERM1 by TERM2."
+  (multiply-by (copy-instance term1) (copy-instance term2)))
+
+(defmethod r* ((term1 number) (term2 monom))
+  "Non-destructively multiply TERM1 by TERM2."
+  (r* term1 (change-class (copy-instance term2) 'term)))
+
+(defmethod r* ((term1 number) (term2 term))
+  "Non-destructively multiply TERM1 by TERM2."
+  (setf (scalar-coeff term2) 
+        (r* term1 (scalar-coeff term2)))
+  term2)
+
+(defmethod r-zerop ((self term))
+  (r-zerop (scalar-coeff self)))