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 |
|
---|