Changeset 1044 for branches/f4grobner

Timestamp:

2015-06-10T08:41:24-07:00 (10 years ago)

Author:

Marek Rychlik

Message:

* empty log message *

File:

• branches/f4grobner/polynomial.lisp (modified) (1 diff)

branches/f4grobner/polynomial.lisp

@@ -318 +318 @@
   (reduce (ring-gcd ring) (mapcar #'term-coeff (rest (poly-termlist p))) :initial-value (poly-lc p)))
 
+;; Return the standard basis of the monomials in n variables
+(defun variable-basis (ring n &aux (basis (make-list n)))
+  "Generate a list of polynomials X[i], i=0,1,...,N-1."
+  (dotimes (i n basis)
+    (setf (elt basis i) (make-variable ring n i))))
+
+(defun poly-eval-1 (expr vars &optional (ring *ring-of-integers*) (order #'lex>)
+                    &aux
+                      (ring-and-order (make-ring-and-order :ring ring :order order))
+                      (n (length vars))
+                      (basis (variable-basis ring (length vars))))
+  "Evaluate an expression EXPR as polynomial by substituting operators
++ - * expt with corresponding polynomial operators and variables VARS
+with the corresponding polynomials in internal form.  We use special
+versions of binary operators $poly+, $poly-, $minus-poly, $poly* and
+$poly-expt which work like the corresponding functions in the POLY
+package, but accept scalars as arguments as well. The result is a
+polynomial in internal form.  This operation is somewhat similar to
+the function EXPAND in CAS."
+  (cond
+    ((numberp expr)
+     (cond
+       ((zerop expr) NIL)
+       (t (make-poly-from-termlist (list (make-term (make-monom :dimension n) expr))))))
+    ((symbolp expr)
+     (nth (position expr vars) basis))
+    ((consp expr)
+     (case (car expr)
+       (expt
+        (if (= (length expr) 3)
+            ($poly-expt ring-and-order
+                        (poly-eval-1 (cadr expr) vars ring order)
+                        (caddr expr)
+                        n)
+            (error "Too many arguments to EXPT")))
+       (/
+        (if (and (= (length expr) 3)
+                 (numberp (caddr expr)))
+            ($poly/ ring (cadr expr) (caddr expr))
+            (error "The second argument to / must be a number")))
+       (otherwise
+        (let ((r (mapcar
+                  #'(lambda (e) (poly-eval-1 e vars ring order))
+                  (cdr expr))))
+          (ecase (car expr)
+            (+ (reduce #'(lambda (p q) ($poly+ ring-and-order p q n)) r))
+            (-
+             (if (endp (cdr r))
+                 ($minus-poly ring (car r) n)
+                 ($poly- ring-and-order
+                         (car r)
+                         (reduce #'(lambda (p q) ($poly+ ring-and-order p q n)) (cdr r))
+                         n)))
+            (*
+             (reduce #'(lambda (p q) ($poly* ring-and-order p q n)) r))
+            )))))))
+
+             
+(defun poly-eval (expr vars &optional (order #'lex>) (ring *ring-of-integers*))
+  "Evaluate an expression EXPR, which should be a polynomial
+expression or a list of polynomial expressions (a list of expressions
+marked by prepending keyword :[ to it) given in Lisp prefix notation,
+in variables VARS, which should be a list of symbols. The result of
+the evaluation is a polynomial or a list of polynomials (marked by
+prepending symbol '[) in the internal alist form. This evaluator is
+used by the PARSE package to convert input from strings directly to
+internal form."
+  (cond
+   ((numberp expr)
+    (unless (zerop expr)
+      (make-poly-from-termlist 
+       (list (make-term (make-monom :dimension (length vars)) expr)))))
+   ((or (symbolp expr) (not (eq (car expr) :[)))
+    (poly-eval-1 expr vars ring order))
+   (t (cons '[ (mapcar #'(lambda (p) (poly-eval-1 p vars ring order)) (rest expr))))))