| 1 |
|
|---|
| 2 | (defun poly-eval-1 (expr vars &optional (ring *ring-of-integers*) (order #'lex>)
|
|---|
| 3 | &aux
|
|---|
| 4 | (ring-and-order (make-ring-and-order :ring ring :order order))
|
|---|
| 5 | (n (length vars))
|
|---|
| 6 | (basis (variable-basis ring (length vars))))
|
|---|
| 7 | "Evaluate an expression EXPR as polynomial by substituting operators
|
|---|
| 8 | + - * expt with corresponding polynomial operators and variables VARS
|
|---|
| 9 | with the corresponding polynomials in internal form. We use special
|
|---|
| 10 | versions of binary operators $poly+, $poly-, $minus-poly, $poly* and
|
|---|
| 11 | $poly-expt which work like the corresponding functions in the POLY
|
|---|
| 12 | package, but accept scalars as arguments as well. The result is a
|
|---|
| 13 | polynomial in internal form. This operation is somewhat similar to
|
|---|
| 14 | the function EXPAND in CAS."
|
|---|
| 15 | (cond
|
|---|
| 16 | ((numberp expr)
|
|---|
| 17 | (cond
|
|---|
| 18 | ((zerop expr) NIL)
|
|---|
| 19 | (t (make-poly-from-termlist (list (make-term (make-monom :dimension n) expr))))))
|
|---|
| 20 | ((symbolp expr)
|
|---|
| 21 | (nth (position expr vars) basis))
|
|---|
| 22 | ((consp expr)
|
|---|
| 23 | (case (car expr)
|
|---|
| 24 | (expt
|
|---|
| 25 | (if (= (length expr) 3)
|
|---|
| 26 | ($poly-expt ring-and-order
|
|---|
| 27 | (poly-eval-1 (cadr expr) vars ring order)
|
|---|
| 28 | (caddr expr)
|
|---|
| 29 | n)
|
|---|
| 30 | (error "Too many arguments to EXPT")))
|
|---|
| 31 | (/
|
|---|
| 32 | (if (and (= (length expr) 3)
|
|---|
| 33 | (numberp (caddr expr)))
|
|---|
| 34 | ($poly/ ring (cadr expr) (caddr expr))
|
|---|
| 35 | (error "The second argument to / must be a number")))
|
|---|
| 36 | (otherwise
|
|---|
| 37 | (let ((r (mapcar
|
|---|
| 38 | #'(lambda (e) (poly-eval-1 e vars ring order))
|
|---|
| 39 | (cdr expr))))
|
|---|
| 40 | (ecase (car expr)
|
|---|
| 41 | (+ (reduce #'(lambda (p q) ($poly+ ring-and-order p q n)) r))
|
|---|
| 42 | (-
|
|---|
| 43 | (if (endp (cdr r))
|
|---|
| 44 | ($minus-poly ring (car r) n)
|
|---|
| 45 | ($poly- ring-and-order
|
|---|
| 46 | (car r)
|
|---|
| 47 | (reduce #'(lambda (p q) ($poly+ ring-and-order p q n)) (cdr r))
|
|---|
| 48 | n)))
|
|---|
| 49 | (*
|
|---|
| 50 | (reduce #'(lambda (p q) ($poly* ring-and-order p q n)) r))
|
|---|
| 51 | )))))))
|
|---|
| 52 |
|
|---|
| 53 |
|
|---|
| 54 |
|
|---|
| 55 | (defun poly-eval (expr vars &optional (order #'lex>) (ring *ring-of-integers*))
|
|---|
| 56 | "Evaluate an expression EXPR, which should be a polynomial
|
|---|
| 57 | expression or a list of polynomial expressions (a list of expressions
|
|---|
| 58 | marked by prepending keyword :[ to it) given in Lisp prefix notation,
|
|---|
| 59 | in variables VARS, which should be a list of symbols. The result of
|
|---|
| 60 | the evaluation is a polynomial or a list of polynomials (marked by
|
|---|
| 61 | prepending symbol '[) in the internal alist form. This evaluator is
|
|---|
| 62 | used by the PARSE package to convert input from strings directly to
|
|---|
| 63 | internal form."
|
|---|
| 64 | (cond
|
|---|
| 65 | ((numberp expr)
|
|---|
| 66 | (unless (zerop expr)
|
|---|
| 67 | (make-poly-from-termlist
|
|---|
| 68 | (list (make-term (make-monom :dimension (length vars)) expr)))))
|
|---|
| 69 | ((or (symbolp expr) (not (eq (car expr) :[)))
|
|---|
| 70 | (poly-eval-1 expr vars ring order))
|
|---|
| 71 | (t (cons '[ (mapcar #'(lambda (p) (poly-eval-1 p vars ring order)) (rest expr))))))
|
|---|
| 72 |
|
|---|
| 73 |
|
|---|
