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 3864


Ignore:
Timestamp:
2016-05-28T18:02:44-07:00 (8 years ago)
Author:
Marek Rychlik
Message:

* empty log message *

File:
1 edited

Legend:

Unmodified
Added
Removed
  • branches/f4grobner/symbolic-polynomial.lisp

    r3858 r3864  
    6262  (assert (= (length (symbolic-poly-vars new)) (poly-dimension new))))
    6363
    64 (defgeneric poly-eval (expr vars order)
    65   (:documentation "Evaluate Lisp form EXPR to a polynomial or a list of polynomials in
     64(defun poly-eval (expr vars order)
     65  "Evaluate Lisp form EXPR to a polynomial or a list of polynomials in
    6666variables VARS. Return the resulting polynomial or list of
    6767polynomials.  Standard arithmetical operators in form EXPR are
     
    6969resulting expression is evaluated, resulting in a polynomial or a list
    7070of polynomials in internal form. A similar operation in another computer
    71 algebra system could be called 'expand' or so.")
    72   (:method ((expr symbolic-poly) vars order) expr)
    73   (:method (expr vars order)
    74     (labels ((p-eval (p) (poly-eval p vars order))
    75              (p-eval-scalar (p) (poly-eval p '() order))
    76              (p-eval-list (plist) (mapcar #'p-eval plist)))
    77       (cond
    78         ((eq expr 0)
    79          (make-instance 'symbolic-poly :dimension (length vars) :vars vars))
    80         ((member expr vars :test #'equalp)
    81          (let ((pos (position expr vars :test #'equalp)))
    82            (make-poly-variable (length vars) pos)))
    83         ((atom expr)
    84          expr)
    85         ((eq (car expr) +list-marker+)
    86          (cons +list-marker+ (p-eval-list (cdr expr))))
    87         (t
    88          (case (car expr)
    89            (+ (reduce #'add (p-eval-list (cdr expr))))
    90            (- (apply #'subtract (p-eval-list (cdr expr))))
    91            (*
    92             (if (endp (cddr expr))      ;unary
    93                 (p-eval (cdr expr))
    94                 (reduce #'multiply (p-eval-list (cdr expr)))))
    95            (/
    96             ;; A polynomial can be divided by a scalar
    97             (cond
    98               ((endp (cddr expr))
    99                ;; A special case (/ ?), the inverse
    100                (divide (cadr expr)))
    101               (t
    102                (let ((num (p-eval (cadr expr)))
    103                      (denom-inverse (apply #'divide (mapcar #'p-eval-scalar (cddr expr)))))
    104                  (multiply denom-inverse num)))))
    105            (expt
    106             (cond
    107               ((member (cadr expr) vars :test #'equalp)
    108                ;;Special handling of (expt var pow)
    109                (let ((pos (position (cadr expr) vars :test #'equalp)))
    110                  (make-poly-variable (length vars) pos (caddr expr))))
    111               ((not (and (integerp (caddr expr)) (plusp (caddr expr))))
    112                ;; Negative power means division in coefficient ring
    113                ;; Non-integer power means non-polynomial coefficient
    114                expr)
    115               (t (universal-expt (p-eval (cadr expr)) (caddr expr)))))
    116            (otherwise
    117             expr)))))))
     71algebra system could be called 'expand' or so."
     72  (labels ((p-eval (p) (poly-eval p vars order))
     73           (p-eval-scalar (p) (poly-eval p '() order))
     74           (p-eval-list (plist) (mapcar #'p-eval plist)))
     75    (cond
     76      ((eq expr 0)
     77       (make-instance 'symbolic-poly :dimension (length vars) :vars vars))
     78      ((member expr vars :test #'equalp)
     79       (let ((pos (position expr vars :test #'equalp)))
     80         (make-poly-variable (length vars) pos)))
     81      ((atom expr)
     82       expr)
     83      ((eq (car expr) +list-marker+)
     84       (cons +list-marker+ (p-eval-list (cdr expr))))
     85      (t
     86       (case (car expr)
     87         (+ (reduce #'add (p-eval-list (cdr expr))))
     88         (- (apply #'subtract (p-eval-list (cdr expr))))
     89         (*
     90          (if (endp (cddr expr))        ;unary
     91              (p-eval (cdr expr))
     92              (reduce #'multiply (p-eval-list (cdr expr)))))
     93         (/
     94          ;; A polynomial can be divided by a scalar
     95          (cond
     96            ((endp (cddr expr))
     97             ;; A special case (/ ?), the inverse
     98             (divide (cadr expr)))
     99            (t
     100             (let ((num (p-eval (cadr expr)))
     101                   (denom-inverse (apply #'divide (mapcar #'p-eval-scalar (cddr expr)))))
     102               (multiply denom-inverse num)))))
     103         (expt
     104          (cond
     105            ((member (cadr expr) vars :test #'equalp)
     106             ;;Special handling of (expt var pow)
     107             (let ((pos (position (cadr expr) vars :test #'equalp)))
     108               (make-poly-variable (length vars) pos (caddr expr))))
     109            ((not (and (integerp (caddr expr)) (plusp (caddr expr))))
     110             ;; Negative power means division in coefficient ring
     111             ;; Non-integer power means non-polynomial coefficient
     112             expr)
     113            (t (universal-expt (p-eval (cadr expr)) (caddr expr)))))
     114         (otherwise
     115          expr))))))
    118116
    119117#|
Note: See TracChangeset for help on using the changeset viewer.