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 1051 for branches/f4grobner


Ignore:
Timestamp:
2015-06-10T08:53:27-07:00 (9 years ago)
Author:
Marek Rychlik
Message:

* empty log message *

File:
1 edited

Legend:

Unmodified
Added
Removed
  • branches/f4grobner/polynomial.lisp

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