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 1043


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

* empty log message *

File:
1 edited

Legend:

Unmodified
Added
Removed
  • branches/f4grobner/parse.lisp

    r1042 r1043  
    251251   (t (sort-poly-1 poly-or-poly-list order))))
    252252
    253 ;; Return the standard basis of the monomials in n variables
    254 (defun variable-basis (ring n &aux (basis (make-list n)))
    255   "Generate a list of polynomials X[i], i=0,1,...,N-1."
    256   (dotimes (i n basis)
    257     (setf (elt basis i) (make-variable ring n i))))
    258 
    259 (defun poly-eval-1 (expr vars &optional (ring *ring-of-integers*) (order #'lex>)
    260                     &aux
    261                       (ring-and-order (make-ring-and-order :ring ring :order order))
    262                       (n (length vars))
    263                       (basis (variable-basis ring (length vars))))
    264   "Evaluate an expression EXPR as polynomial by substituting operators
    265 + - * expt with corresponding polynomial operators and variables VARS
    266 with the corresponding polynomials in internal form.  We use special
    267 versions of binary operators $poly+, $poly-, $minus-poly, $poly* and
    268 $poly-expt which work like the corresponding functions in the POLY
    269 package, but accept scalars as arguments as well. The result is a
    270 polynomial in internal form.  This operation is somewhat similar to
    271 the function EXPAND in CAS."
    272   (cond
    273     ((numberp expr)
    274      (cond
    275        ((zerop expr) NIL)
    276        (t (make-poly-from-termlist (list (make-term (make-monom :dimension n) expr))))))
    277     ((symbolp expr)
    278      (nth (position expr vars) basis))
    279     ((consp expr)
    280      (case (car expr)
    281        (expt
    282         (if (= (length expr) 3)
    283             ($poly-expt ring-and-order
    284                         (poly-eval-1 (cadr expr) vars ring order)
    285                         (caddr expr)
    286                         n)
    287             (error "Too many arguments to EXPT")))
    288        (/
    289         (if (and (= (length expr) 3)
    290                  (numberp (caddr expr)))
    291             ($poly/ ring (cadr expr) (caddr expr))
    292             (error "The second argument to / must be a number")))
    293        (otherwise
    294         (let ((r (mapcar
    295                   #'(lambda (e) (poly-eval-1 e vars ring order))
    296                   (cdr expr))))
    297           (ecase (car expr)
    298             (+ (reduce #'(lambda (p q) ($poly+ ring-and-order p q n)) r))
    299             (-
    300              (if (endp (cdr r))
    301                  ($minus-poly ring (car r) n)
    302                  ($poly- ring-and-order
    303                          (car r)
    304                          (reduce #'(lambda (p q) ($poly+ ring-and-order p q n)) (cdr r))
    305                          n)))
    306             (*
    307              (reduce #'(lambda (p q) ($poly* ring-and-order p q n)) r))
    308             )))))))
    309 
    310              
    311 (defun poly-eval (expr vars &optional (order #'lex>) (ring *ring-of-integers*))
    312   "Evaluate an expression EXPR, which should be a polynomial
    313 expression or a list of polynomial expressions (a list of expressions
    314 marked by prepending keyword :[ to it) given in Lisp prefix notation,
    315 in variables VARS, which should be a list of symbols. The result of
    316 the evaluation is a polynomial or a list of polynomials (marked by
    317 prepending symbol '[) in the internal alist form. This evaluator is
    318 used by the PARSE package to convert input from strings directly to
    319 internal form."
    320   (cond
    321    ((numberp expr)
    322     (unless (zerop expr)
    323       (make-poly-from-termlist
    324        (list (make-term (make-monom :dimension (length vars)) expr)))))
    325    ((or (symbolp expr) (not (eq (car expr) :[)))
    326     (poly-eval-1 expr vars ring order))
    327    (t (cons '[ (mapcar #'(lambda (p) (poly-eval-1 p vars ring order)) (rest expr))))))
    328 
    329 
     253
     254
Note: See TracChangeset for help on using the changeset viewer.