Changeset 3864 for branches/f4grobner
- Timestamp:
- 2016-05-28T18:02:44-07:00 (8 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/f4grobner/symbolic-polynomial.lisp
r3858 r3864 62 62 (assert (= (length (symbolic-poly-vars new)) (poly-dimension new)))) 63 63 64 (def genericpoly-eval (expr vars order)65 (:documentation"Evaluate Lisp form EXPR to a polynomial or a list of polynomials in64 (defun poly-eval (expr vars order) 65 "Evaluate Lisp form EXPR to a polynomial or a list of polynomials in 66 66 variables VARS. Return the resulting polynomial or list of 67 67 polynomials. Standard arithmetical operators in form EXPR are … … 69 69 resulting expression is evaluated, resulting in a polynomial or a list 70 70 of 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))))))) 71 algebra 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)))))) 118 116 119 117 #|
Note:
See TracChangeset
for help on using the changeset viewer.