Changeset 4370 for branches/f4grobner
- Timestamp:
- 2016-06-06T19:28:40-07:00 (9 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/f4grobner/polynomial.lisp
r4366 r4370 622 622 (cons +list-marker+ (mapcar #'(lambda (p) (->sexp p vars)) (cdr self)))) 623 623 624 625 (defvar *coefficient-class* 'integer-ring626 "The default class in which coefficients are created from627 NUMBER tokens.")628 629 (defun poly-eval (expr vars order &optional (coefficient-class *coefficient-class*))630 "Evaluate Lisp form EXPR to a polynomial or a list of polynomials in631 variables VARS. Return the resulting polynomial or list of632 polynomials. Standard arithmetical operators in form EXPR are633 replaced with their analogues in the ring of polynomials, and the634 resulting expression is evaluated, resulting in a polynomial or a list635 of polynomials in internal form. A similar operation in another computer636 algebra system could be called 'expand' or so."637 (labels ((p-eval (p) (poly-eval p vars order))638 (p-eval-list (plist) (mapcar #'p-eval plist)))639 (cond640 ((eq expr 0)641 (make-instance 'poly :dimension (length vars)))642 ((member expr vars :test #'equalp)643 (let ((pos (position expr vars :test #'equalp)))644 (make-poly-variable (length vars) pos)))645 ((numberp expr)646 (make-poly-constant (length vars) (make-instance coefficient-class :value expr)))647 ((eq (car expr) +list-marker+)648 (cons +list-marker+ (p-eval-list (cdr expr))))649 (t650 (case (car expr)651 (+ (reduce #'add (p-eval-list (cdr expr))))652 (- (apply #'subtract (p-eval-list (cdr expr))))653 (*654 (if (endp (cddr expr)) ;unary655 (p-eval (cadr expr))656 (apply #'multiply (p-eval-list (cdr expr)))))657 (/658 ;; A polynomial can be divided by a scalar659 (cond660 ((endp (cddr expr))661 ;; A special case (/ ?), the inverse662 (divide (cadr expr)))663 (t664 (let ((num (p-eval (cadr expr)))665 (denom-inverse (apply #'divide (mapcar #'p-eval (cddr expr)))))666 (multiply denom-inverse num)))))667 (expt668 (cond669 ((member (cadr expr) vars :test #'equalp)670 ;;Special handling of (expt var pow)671 (let ((pos (position (cadr expr) vars :test #'equalp)))672 (make-poly-variable (length vars) pos (caddr expr))))673 ((not (and (integerp (caddr expr)) (plusp (caddr expr))))674 ;; Negative power means division in coefficient ring675 ;; Non-integer power means non-polynomial coefficient676 expr)677 (t (universal-expt (p-eval (cadr expr)) (caddr expr)))))678 (otherwise679 (error "Cannot evaluate as polynomial: ~A" expr)))))))680 681 624 (defmethod make-zero-for ((self poly)) 682 625 (make-instance 'poly :dimension (poly-dimension self)))
Note:
See TracChangeset
for help on using the changeset viewer.