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 4241 for branches/f4grobner


Ignore:
Timestamp:
2016-06-04T19:45:29-07:00 (9 years ago)
Author:
Marek Rychlik
Message:

* empty log message *

File:
1 edited

Legend:

Unmodified
Added
Removed
  • branches/f4grobner/monom.lisp

    r4240 r4241  
    526526
    527527(defclass term (monom)
    528   ((coeff :initarg :coeff :accessor term-coeff :type ring))
     528  ((coeff :initarg :coeff :initform 1 :accessor term-coeff :type ring))
    529529  (:default-initargs :coeff 1)
    530530  (:documentation "Implements a term, i.e. a product of a scalar
     
    603603  self)
    604604
    605 (defgeneric universal-zerop (self)
    606   (:documentation "Return T iff SELF is zero.")
    607   (:method ((self number)) (zerop self))
    608   (:method ((self term))
    609     (universal-zerop (term-coeff self))))
     605(defmethod universal-zerop ((self term))
     606  (universal-zerop (term-coeff self)))
    610607
    611608(defgeneric ->list (self)
     
    617614    (cons (coerce (monom-exponents self) 'list) (->sexp (term-coeff self)))))
    618615
    619 (defgeneric ->sexp (object &optional vars)
    620   (:documentation "Convert a polynomial OBJECT to an S-expression, using variables VARS.")
    621   (:method :before ((object monom) &optional vars)
    622            "Check the length of variables VARS against the length of exponents in OBJECT."
    623            (with-slots (exponents)
    624                object
    625              (assert (= (length vars) (length exponents))
    626                      nil
    627                      "Variables ~A and exponents ~A must have the same length." vars exponents)))
    628   (:method ((object monom) &optional vars)
    629     "Convert a monomial OBJECT to infix form, using variable VARS to build the representation."
     616(defmethod ->sexp :before ((object monom) &optional vars)
     617  "Check the length of variables VARS against the length of exponents in OBJECT."
     618  (with-slots (exponents)
     619      object
     620    (assert (= (length vars) (length exponents))
     621            nil
     622            "Variables ~A and exponents ~A must have the same length." vars exponents)))
     623
     624(defmethod ->sexp ((object monom) &optional vars)
     625  "Convert a monomial OBJECT to infix form, using variable VARS to build the representation."
    630626    (with-slots (exponents)
    631627        object
     
    639635              (t
    640636               (cons '* m))))))
    641   (:method :around ((object term) &optional vars)
    642     "Convert a term OBJECT to infix form, using variable VARS to build the representation."
    643     (declare (ignore vars))
    644     (with-slots (coeff)
    645         object
    646       (let ((monom-sexp (call-next-method))
    647             (coeff-sexp (->sexp coeff)))
    648         (cond ((eql coeff-sexp 1) monom-sexp)
    649               ((atom monom-sexp)
    650                (cond ((eql monom-sexp 1) coeff-sexp)
    651                      (t (list '* coeff-sexp monom-sexp))))
    652               ((eql (car monom-sexp) '*)
    653                (list* '* coeff-sexp (cdr monom-sexp)))
    654               (t
    655                (list '* coeff-sexp monom-sexp)))))))
     637
     638(defmethod ->sexp :around ((object term) &optional vars)
     639  "Convert a term OBJECT to infix form, using variable VARS to build the representation."
     640  (declare (ignore vars))
     641  (with-slots (coeff)
     642      object
     643    (let ((monom-sexp (call-next-method))
     644          (coeff-sexp (->sexp coeff)))
     645      (cond ((eql coeff-sexp 1) monom-sexp)
     646            ((atom monom-sexp)
     647             (cond ((eql monom-sexp 1) coeff-sexp)
     648                   (t (list '* coeff-sexp monom-sexp))))
     649            ((eql (car monom-sexp) '*)
     650             (list* '* coeff-sexp (cdr monom-sexp)))
     651            (t
     652             (list '* coeff-sexp monom-sexp))))))
Note: See TracChangeset for help on using the changeset viewer.