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/polynomial-sugar.lisp@ 4515

Last change on this file since 4515 was 4515, checked in by Marek Rychlik, 8 years ago

* empty log message *

File size: 3.8 KB
RevLine 
[4502]1(in-package "POLYNOMIAL")
2
3(defgeneric static-sugar (object)
4 (:documentation "Return statically calculated sugar of object OBJECT. That is,
5the sugar value which does not assume that the object is a result of any prior calculations.")
6 (:method ((object monom))
[4505]7 "Static sugar of a monom OBJECT is simply the total degree."
[4502]8 (total-degree object))
9 (:method ((object poly))
[4505]10 "Static sugar of a poly OBJECT is the maximum sugar of its terms."
11 (with-slots (termlist)
[4502]12 object
[4511]13 (loop for trm in termlist maximize (static-sugar trm)))))
[4502]14
15(defclass sugar ()
[4507]16 ((value :initarg :value :initform -1 :accessor sugar-value :type fixnum))
[4509]17 (:documentation "Sugar is a quantity added to various objects, such as monomials, terms and polynomials."))
[4502]18
19(defclass monom-with-sugar (monom sugar) ())
20
[4505]21(defmethod print-object ((self monom-with-sugar) stream)
22 (print-unreadable-object (self stream :type t :identity t)
23 (with-accessors ((exponents monom-exponents) (value sugar-value))
24 self
25 (format stream "EXPONENTS=~A SUGAR=~A"
26 exponents value))))
27
28
[4502]29(defmethod shared-initialize :after ((self monom-with-sugar) slot-names &rest initargs &key)
[4504]30 "Initialize sugar value based on the exponents."
[4502]31 (declare (ignore slot-names initargs))
[4504]32 (setf (slot-value self 'value) (static-sugar self)))
[4502]33
[4514]34(defmethod update-instance-for-different-class :after ((old monom) (new monom-with-sugar) &key)
[4515]35 "Add sugar."
[4514]36 (reinitialize-instance new :value (static-sugar new)))
37
38
[4511]39(defmethod multiply-by :after ((self sugar) (other sugar))
40 (with-slots (value)
41 self
42 (with-slots ((other-value value))
43 other
44 (incf value other-value)))
45 self)
46
[4512]47(defmethod divide-by :after ((self sugar) (other sugar))
48 (with-slots (value)
49 self
50 (with-slots ((other-value value))
51 other
52 (decf value other-value)))
53 self)
54
[4505]55(defclass term-with-sugar (term sugar) ())
[4502]56
[4505]57(defmethod print-object ((self term-with-sugar) stream)
58 (print-unreadable-object (self stream :type t :identity t)
59 (with-accessors ((exponents monom-exponents) (value sugar-value) (coeff term-coeff))
60 self
61 (format stream "EXPONENTS=~A COEFF=~A SUGAR=~A"
62 exponents coeff value))))
[4510]63
[4515]64(defmethod update-instance-for-different-class :after ((old term) (new term-with-sugar) &key)
65 "Add sugar."
66 (reinitialize-instance new :value (static-sugar new)))
67
68
69
[4510]70(defclass poly-with-sugar (poly sugar) ())
71
72(defmethod shared-initialize :after ((self poly-with-sugar) slot-names &rest initargs &key)
[4511]73 "Initialize sugar to its static value, which is the maximum of sugar values of the terms."
[4510]74 (declare (ignore slot-names initargs))
75 (setf (slot-value self 'value) (static-sugar self)))
[4513]76
[4514]77(defmethod update-instance-for-different-class :after ((old poly) (new poly-with-sugar) &key)
78 "Add sugar to every term."
79 (reinitialize-instance new :termlist (mapc #'(lambda (trm) (change-class trm 'term-with-sugar)) (poly-termlist new))))
80
81(defmethod update-instance-for-different-class :after ((old poly-with-sugar) (new poly) &key)
82 "Drop sugar in every term."
83 (reinitialize-instance new :termlist (mapc #'(lambda (trm) (change-class trm 'term)) (poly-termlist new))))
84
85
[4513]86(defmethod add-to ((self poly-with-sugar) (other poly-with-sugar))
87 "Sugar value of the sum of two polynomials, SELF and OTHER, is by definition
[4514]88the maximum of the sugar values of the summands."
[4513]89 (with-accessors ((value sugar-value))
90 self
91 (with-accessors ((other-value sugar-value))
92 other
[4514]93 (setf value (max value other-value))))
94 self)
95
96(defmethod multiply-by ((self poly-with-sugar) (other poly-with-sugar))
97 "Sugar value of the product of two polynomials, SELF and OTHER, is by definition
98the sum of the sugar values of the factors."
99 (with-accessors ((value sugar-value))
100 self
101 (with-accessors ((other-value sugar-value))
102 other
103 (setf value (max value other-value))))
104 self)
Note: See TracBrowser for help on using the repository browser.