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 1044


Ignore:
Timestamp:
2015-06-10T08:41:24-07:00 (10 years ago)
Author:
Marek Rychlik
Message:

* empty log message *

File:
1 edited

Legend:

Unmodified
Added
Removed
  • branches/f4grobner/polynomial.lisp

    r993 r1044  
    318318  (reduce (ring-gcd ring) (mapcar #'term-coeff (rest (poly-termlist p))) :initial-value (poly-lc p)))
    319319
     320;; Return the standard basis of the monomials in n variables
     321(defun variable-basis (ring n &aux (basis (make-list n)))
     322  "Generate a list of polynomials X[i], i=0,1,...,N-1."
     323  (dotimes (i n basis)
     324    (setf (elt basis i) (make-variable ring n i))))
     325
     326(defun poly-eval-1 (expr vars &optional (ring *ring-of-integers*) (order #'lex>)
     327                    &aux
     328                      (ring-and-order (make-ring-and-order :ring ring :order order))
     329                      (n (length vars))
     330                      (basis (variable-basis ring (length vars))))
     331  "Evaluate an expression EXPR as polynomial by substituting operators
     332+ - * expt with corresponding polynomial operators and variables VARS
     333with the corresponding polynomials in internal form.  We use special
     334versions of binary operators $poly+, $poly-, $minus-poly, $poly* and
     335$poly-expt which work like the corresponding functions in the POLY
     336package, but accept scalars as arguments as well. The result is a
     337polynomial in internal form.  This operation is somewhat similar to
     338the function EXPAND in CAS."
     339  (cond
     340    ((numberp expr)
     341     (cond
     342       ((zerop expr) NIL)
     343       (t (make-poly-from-termlist (list (make-term (make-monom :dimension n) expr))))))
     344    ((symbolp expr)
     345     (nth (position expr vars) basis))
     346    ((consp expr)
     347     (case (car expr)
     348       (expt
     349        (if (= (length expr) 3)
     350            ($poly-expt ring-and-order
     351                        (poly-eval-1 (cadr expr) vars ring order)
     352                        (caddr expr)
     353                        n)
     354            (error "Too many arguments to EXPT")))
     355       (/
     356        (if (and (= (length expr) 3)
     357                 (numberp (caddr expr)))
     358            ($poly/ ring (cadr expr) (caddr expr))
     359            (error "The second argument to / must be a number")))
     360       (otherwise
     361        (let ((r (mapcar
     362                  #'(lambda (e) (poly-eval-1 e vars ring order))
     363                  (cdr expr))))
     364          (ecase (car expr)
     365            (+ (reduce #'(lambda (p q) ($poly+ ring-and-order p q n)) r))
     366            (-
     367             (if (endp (cdr r))
     368                 ($minus-poly ring (car r) n)
     369                 ($poly- ring-and-order
     370                         (car r)
     371                         (reduce #'(lambda (p q) ($poly+ ring-and-order p q n)) (cdr r))
     372                         n)))
     373            (*
     374             (reduce #'(lambda (p q) ($poly* ring-and-order p q n)) r))
     375            )))))))
     376
     377             
     378(defun poly-eval (expr vars &optional (order #'lex>) (ring *ring-of-integers*))
     379  "Evaluate an expression EXPR, which should be a polynomial
     380expression or a list of polynomial expressions (a list of expressions
     381marked by prepending keyword :[ to it) given in Lisp prefix notation,
     382in variables VARS, which should be a list of symbols. The result of
     383the evaluation is a polynomial or a list of polynomials (marked by
     384prepending symbol '[) in the internal alist form. This evaluator is
     385used by the PARSE package to convert input from strings directly to
     386internal form."
     387  (cond
     388   ((numberp expr)
     389    (unless (zerop expr)
     390      (make-poly-from-termlist
     391       (list (make-term (make-monom :dimension (length vars)) expr)))))
     392   ((or (symbolp expr) (not (eq (car expr) :[)))
     393    (poly-eval-1 expr vars ring order))
     394   (t (cons '[ (mapcar #'(lambda (p) (poly-eval-1 p vars ring order)) (rest expr))))))
Note: See TracChangeset for help on using the changeset viewer.