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.

Changeset 3441 for branches/f4grobner


Ignore:
Timestamp:
2015-09-05T08:59:06-07:00 (9 years ago)
Author:
Marek Rychlik
Message:

* empty log message *

File:
1 edited

Legend:

Unmodified
Added
Removed
  • branches/f4grobner/monom.lisp

    r3417 r3441  
    102102     (error "Initarg DIMENSION or EXPONENTS must be supplied."))))
    103103
    104 (defmacro monom-dimension (m)
    105   `(length (monom-exponents ,m)))
    106 
    107 (defmethod r-equalp ((m1 monom) (m2 monom))
     104(defmethod monom-dimension (m)
     105  (length (monom-exponents ,m)))
     106
     107(defmethod monom-equalp (m1 m2)
    108108  "Returns T iff monomials M1 and M2 have identical
    109109EXPONENTS."
    110   (equalp (monom-exponents m1) (monom-exponents m2)))
    111 
    112 (defmethod r-coeff ((m monom))
    113   "A MONOM can be treated as a special case of TERM,
    114 where the coefficient is 1."
    115   1)
    116  
    117 (defmethod r-elt ((m monom) index)
     110  `(equalp (monom-exponents ,m1) (monom-exponents ,m2)))
     111
     112(defmethod monom-elt (m index)
    118113  "Return the power in the monomial M of variable number INDEX."
    119114  (with-slots (exponents)
     
    121116    (elt exponents index)))
    122117
    123 (defmethod (setf r-elt) (new-value (m monom) index)
     118(defmethod (setf monom-elt) (new-value m index)
    124119  "Return the power in the monomial M of variable number INDEX."
    125120  (with-slots (exponents)
     
    127122    (setf (elt exponents index) new-value)))
    128123
    129 (defmethod r-total-degree ((m monom) &optional (start 0) (end (monom-dimension m)))
     124(defmethod monom-total-degree (m &optional (start 0) (end (monom-dimension m)))
    130125  "Return the todal degree of a monomoal M. Optinally, a range
    131126of variables may be specified with arguments START and END."
     
    136131
    137132
    138 (defmethod r-sugar ((m monom) &aux (start 0) (end (monom-dimension m)))
     133(defmethod monom-sugar (m &aux (start 0) (end (monom-dimension m)))
    139134  "Return the sugar of a monomial M. Optinally, a range
    140135of variables may be specified with arguments START and END."
    141136  (declare (type fixnum start end))
    142     (r-total-degree m start end))
     137  (monom-total-degree m start end))
    143138
    144139(defmethod multiply-by ((self monom) (other monom))
     
    173168    copy))
    174169
    175 (defmethod r* ((m1 monom) (m2 monom))
     170(defmethod monom* ((m1 monom) (m2 monom))
    176171  "Non-destructively multiply monomial M1 by M2."
    177172  (multiply-by (copy-instance m1) (copy-instance m2)))
    178173
    179 (defmethod r/ ((numerator monom) &rest denominators)
     174(defmethod monom* ((numerator monom) &rest denominators)
    180175  "Non-destructively divide monomial NUMERATOR by product of DENOMINATORS."
    181   (divide-by (copy-instance numerator) (reduce #'r* denominators)))
    182 
    183 (defmethod r-divides-p ((m1 monom) (m2 monom))
     176  (divide-by (copy-instance numerator) (reduce #'
     177                                        monom* denominators)))
     178
     179(defmethod monom-divides-p ((m1 monom) (m2 monom))
    184180  "Returns T if monomial M1 divides monomial M2, NIL otherwise."
    185181  (with-slots ((exponents1 exponents))
     
    190186
    191187
    192 (defmethod r-divides-lcm-p ((m1 monom) (m2 monom) (m3 monom))
     188(defmethod monom-divides-lcm-p ((m1 monom) (m2 monom) (m3 monom))
    193189  "Returns T if monomial M1 divides LCM(M2,M3), NIL otherwise."
    194190  (every #'(lambda (x y z) (<= x (max y z)))
     
    196192
    197193
    198 (defmethod r-lcm-divides-lcm-p ((m1 monom) (m2 monom) (m3 monom) (m4 monom))
     194(defmethod monom-lcm-divides-lcm-p ((m1 monom) (m2 monom) (m3 monom) (m4 monom))
    199195  "Returns T if monomial MONOM-LCM(M1,M2) divides MONOM-LCM(M3,M4), NIL otherwise."
    200196  (declare (type monom m1 m2 m3 m4))
     
    202198         m1 m2 m3 m4))
    203199         
    204 (defmethod r-lcm-equal-lcm-p (m1 m2 m3 m4)
     200(defmethod monom-lcm-equal-lcm-p (m1 m2 m3 m4)
    205201  "Returns T if monomial LCM(M1,M2) equals LCM(M3,M4), NIL otherwise."
    206202  (with-slots ((exponents1 exponents))
     
    216212           exponents1 exponents2 exponents3 exponents4))))))
    217213
    218 (defmethod r-divisible-by-p ((m1 monom) (m2 monom))
     214(defmethod monom-divisible-by-p ((m1 monom) (m2 monom))
    219215  "Returns T if monomial M1 is divisible by monomial M2, NIL otherwise."
    220216  (with-slots ((exponents1 exponents))
     
    224220      (every #'>= exponents1 exponents2))))
    225221
    226 (defmethod r-rel-prime-p ((m1 monom) (m2 monom))
     222(defmethod monom-rel-prime-p ((m1 monom) (m2 monom))
    227223  "Returns T if two monomials M1 and M2 are relatively prime (disjoint)."
    228224  (with-slots ((exponents1 exponents))
     
    233229
    234230
    235 (defmethod r-lcm ((m1 monom) (m2 monom))
     231(defmethod monom-lcm ((m1 monom) (m2 monom))
    236232  "Returns least common multiple of monomials M1 and M2."
    237233  (with-slots ((exponents1 exponents))
     
    244240
    245241
    246 (defmethod r-gcd ((m1 monom) (m2 monom))
     242(defmethod monom-gcd ((m1 monom) (m2 monom))
    247243  "Returns greatest common divisor of monomials M1 and M2."
    248244  (with-slots ((exponents1 exponents))
     
    254250        (make-instance 'monom :exponents exponents)))))
    255251
    256 (defmethod r-depends-p ((m monom) k)
     252(defmethod monom-depends-p ((m monom) k)
    257253  "Return T if the monomial M depends on variable number K."
    258254  (declare (type fixnum k))
     
    261257    (plusp (elt exponents k))))
    262258
    263 (defmethod left-tensor-product-by ((self monom) (other monom))
     259(defmethod monom-left-tensor-product-by ((self monom) (other monom))
    264260  (with-slots ((exponents1 exponents))
    265261      self
     
    269265  self)
    270266
    271 (defmethod right-tensor-product-by ((self monom) (other monom))
     267(defmethod monom-right-tensor-product-by ((self monom) (other monom))
    272268  (with-slots ((exponents1 exponents))
    273269      self
     
    277273  self)
    278274
    279 (defmethod left-contract ((self monom) k)
     275(defmethod monom-left-contract ((self monom) k)
    280276  "Drop the first K variables in monomial M."
    281277  (declare (fixnum k))
     
    298294    m))
    299295
    300 (defmethod r->list ((m monom))
     296(defmethod monom->list ((m monom))
    301297  "A human-readable representation of a monomial M as a list of exponents." 
    302298  (coerce (monom-exponents m) 'list))
    303 
    304 (defmethod r-dimension ((self monom))
    305   (monom-dimension self))
    306 
    307 (defmethod r-exponents ((self monom))
    308   (monom-exponents self))
Note: See TracChangeset for help on using the changeset viewer.