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 3381


Ignore:
Timestamp:
2015-08-27T08:31:25-07:00 (9 years ago)
Author:
Marek Rychlik
Message:

* empty log message *

File:
1 edited

Legend:

Unmodified
Added
Removed

  • branches/f4grobner/symbolic-polynomial.lisp

    r3380 r3381  
    6969  (:method ((expr symbolic-poly) vars order) expr)
    7070  (:method (expr vars order)
    71     (cond
    72       ((eq expr 0)
    73        (make-instance 'symbolic-poly :dimension (length vars) :vars vars))
    74       ((member expr vars :test #'equalp)
    75        (let ((pos (position expr vars :test #'equalp)))
    76          (make-monom-variable (length vars) pos)))
    77       ((atom expr)
    78        expr)
    79       ((eq (car expr) +list-marker+)
    80        (cons +list-marker+ (p-eval-list (cdr expr))))
    81       (t
    82        (case (car expr)
    83          (+ (reduce #'r+ (p-eval-list (cdr expr))))
    84          (- (case (length expr)
    85               (1 (make-poly-zero))
    86               (2 (poly-uminus ring (p-eval (cadr expr))))
    87               (3 (poly-sub ring-and-order (p-eval (cadr expr)) (p-eval (caddr expr))))
    88               (otherwise (poly-sub ring-and-order (p-eval (cadr expr))
    89                                    (reduce #'p-add (p-eval-list (cddr expr)))))))
    90          (*
    91           (if (endp (cddr expr))                ;unary
    92               (p-eval (cdr expr))
    93               (reduce #'(lambda (p q) (poly-mul ring-and-order p q)) (p-eval-list (cdr expr)))))
    94          (/
    95           ;; A polynomial can be divided by a scalar
    96           (cond
    97             ((endp (cddr expr))
    98              ;; A special case (/ ?), the inverse
    99              (coerce-coeff ring (apply (ring-div ring) (cdr expr)) vars))
    100             (t
    101              (let ((num (p-eval (cadr expr)))
    102                    (denom-inverse (apply (ring-div ring)
    103                                          (cons (funcall (ring-unit ring))
    104                                                (mapcar #'p-eval-scalar (cddr expr))))))
    105                (scalar-times-poly ring denom-inverse num)))))
    106          (expt
    107           (cond
    108             ((member (cadr expr) vars :test #'equalp)
    109              ;;Special handling of (expt var pow)
    110              (let ((pos (position (cadr expr) vars :test #'equalp)))
    111                (make-poly-variable ring (length vars) pos (caddr expr))))
    112             ((not (and (integerp (caddr expr)) (plusp (caddr expr))))
    113              ;; Negative power means division in coefficient ring
    114              ;; Non-integer power means non-polynomial coefficient
    115              (coerce-coeff ring expr vars))
    116             (t (poly-expt ring-and-order (p-eval (cadr expr)) (caddr expr)))))
    117          (otherwise
    118           (coerce-coeff ring expr vars)))))))
     71    (labels ((p-eval (p) (poly-eval p vars))
     72             (p-eval-list (plist) (mapcar #'p-eval plist)))
     73      (cond
     74        ((eq expr 0)
     75         (make-instance 'symbolic-poly :dimension (length vars) :vars vars))
     76        ((member expr vars :test #'equalp)
     77         (let ((pos (position expr vars :test #'equalp)))
     78           (make-monom-variable (length vars) pos)))
     79        ((atom expr)
     80         expr)
     81        ((eq (car expr) +list-marker+)
     82         (cons +list-marker+ (p-eval-list (cdr expr))))
     83        (t
     84         (case (car expr)
     85           (+ (reduce #'r+ (p-eval-list (cdr expr))))
     86           (- (case (length expr)
     87                (1 (make-poly-zero))
     88                (2 (poly-uminus ring (p-eval (cadr expr))))
     89                (3 (poly-sub ring-and-order (p-eval (cadr expr)) (p-eval (caddr expr))))
     90                (otherwise (poly-sub ring-and-order (p-eval (cadr expr))
     91                                     (reduce #'p-add (p-eval-list (cddr expr)))))))
     92           (*
     93            (if (endp (cddr expr))      ;unary
     94                (p-eval (cdr expr))
     95                (reduce #'(lambda (p q) (r* p q)) (p-eval-list (cdr expr)))))
     96           (/
     97            ;; A polynomial can be divided by a scalar
     98            (cond
     99              ((endp (cddr expr))
     100               ;; A special case (/ ?), the inverse
     101               (coerce-coeff ring (apply (ring-div ring) (cdr expr)) vars))
     102              (t
     103               (let ((num (p-eval (cadr expr)))
     104                     (denom-inverse (apply (ring-div ring)
     105                                           (cons (funcall (ring-unit ring))
     106                                                 (mapcar #'p-eval-scalar (cddr expr))))))
     107                 (scalar-times-poly ring denom-inverse num)))))
     108           (expt
     109            (cond
     110              ((member (cadr expr) vars :test #'equalp)
     111               ;;Special handling of (expt var pow)
     112               (let ((pos (position (cadr expr) vars :test #'equalp)))
     113                 (make-poly-variable ring (length vars) pos (caddr expr))))
     114              ((not (and (integerp (caddr expr)) (plusp (caddr expr))))
     115               ;; Negative power means division in coefficient ring
     116               ;; Non-integer power means non-polynomial coefficient
     117               (coerce-coeff ring expr vars))
     118              (t (poly-expt ring-and-order (p-eval (cadr expr)) (caddr expr)))))
     119           (otherwise
     120            (coerce-coeff ring expr vars))))))))
    119121
    120122#|
Note: See TracChangeset for help on using the changeset viewer.