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


Ignore:
Timestamp:
2016-05-29T14:28:38-07:00 (9 years ago)
Author:
Marek Rychlik
Message:

* empty log message *

File:
1 edited

Legend:

Unmodified
Added
Removed
  • branches/f4grobner/polynomial.lisp

    r3887 r3899  
    560560                   (poly-termlist self))))
    561561 
     562
     563(defun poly-eval (expr vars order)
     564  "Evaluate Lisp form EXPR to a polynomial or a list of polynomials in
     565variables VARS. Return the resulting polynomial or list of
     566polynomials.  Standard arithmetical operators in form EXPR are
     567replaced with their analogues in the ring of polynomials, and the
     568resulting expression is evaluated, resulting in a polynomial or a list
     569of polynomials in internal form. A similar operation in another computer
     570algebra system could be called 'expand' or so."
     571  (labels ((p-eval (p) (poly-eval p vars order))
     572           (p-eval-scalar (p) (poly-eval p '() order))
     573           (p-eval-list (plist) (mapcar #'p-eval plist)))
     574    (cond
     575      ((eq expr 0)
     576       (make-instance 'poly :dimension (length vars)))
     577      ((member expr vars :test #'equalp)
     578       (let ((pos (position expr vars :test #'equalp)))
     579         (make-poly-variable (length vars) pos)))
     580      ((atom expr)
     581       expr)
     582      ((eq (car expr) +list-marker+)
     583       (cons +list-marker+ (p-eval-list (cdr expr))))
     584      (t
     585       (case (car expr)
     586         (+ (reduce #'add (p-eval-list (cdr expr))))
     587         (- (apply #'subtract (p-eval-list (cdr expr))))
     588         (*
     589          (if (endp (cddr expr))        ;unary
     590              (p-eval (cadr expr))
     591              (reduce #'multiply (p-eval-list (cdr expr)))))
     592         (/
     593          ;; A polynomial can be divided by a scalar
     594          (cond
     595            ((endp (cddr expr))
     596             ;; A special case (/ ?), the inverse
     597             (divide (cadr expr)))
     598            (t
     599             (let ((num (p-eval (cadr expr)))
     600                   (denom-inverse (apply #'divide (mapcar #'p-eval-scalar (cddr expr)))))
     601               (multiply denom-inverse num)))))
     602         (expt
     603          (cond
     604            ((member (cadr expr) vars :test #'equalp)
     605             ;;Special handling of (expt var pow)
     606             (let ((pos (position (cadr expr) vars :test #'equalp)))
     607               (make-poly-variable (length vars) pos (caddr expr))))
     608            ((not (and (integerp (caddr expr)) (plusp (caddr expr))))
     609             ;; Negative power means division in coefficient ring
     610             ;; Non-integer power means non-polynomial coefficient
     611             expr)
     612            (t (universal-expt (p-eval (cadr expr)) (caddr expr)))))
     613         (otherwise
     614          expr))))))
Note: See TracChangeset for help on using the changeset viewer.