[68] | 1 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
---|
| 2 | ;;
|
---|
| 3 | ;; Maxima expression parsing
|
---|
| 4 | ;;
|
---|
| 5 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
---|
| 6 |
|
---|
| 7 | (defun equal-test-p (expr1 expr2)
|
---|
| 8 | (alike1 expr1 expr2))
|
---|
| 9 |
|
---|
| 10 | (defun coerce-maxima-list (expr)
|
---|
| 11 | "convert a maxima list to lisp list."
|
---|
| 12 | (cond
|
---|
| 13 | ((and (consp (car expr)) (eql (caar expr) 'mlist)) (cdr expr))
|
---|
| 14 | (t expr)))
|
---|
| 15 |
|
---|
| 16 | (defun free-of-vars (expr vars) (apply #'$freeof `(,@vars ,expr)))
|
---|
| 17 |
|
---|
| 18 | (defun parse-poly (expr vars &aux (vars (coerce-maxima-list vars)))
|
---|
| 19 | "Convert a maxima polynomial expression EXPR in variables VARS to internal form."
|
---|
| 20 | (labels ((parse (arg) (parse-poly arg vars))
|
---|
| 21 | (parse-list (args) (mapcar #'parse args)))
|
---|
| 22 | (cond
|
---|
| 23 | ((eql expr 0) (make-poly-zero))
|
---|
| 24 | ((member expr vars :test #'equal-test-p)
|
---|
| 25 | (let ((pos (position expr vars :test #'equal-test-p)))
|
---|
| 26 | (make-variable *maxima-ring* (length vars) pos)))
|
---|
| 27 | ((free-of-vars expr vars)
|
---|
| 28 | ;;This means that variable-free CRE and Poisson forms will be converted
|
---|
| 29 | ;;to coefficients intact
|
---|
| 30 | (coerce-coeff *maxima-ring* expr vars))
|
---|
| 31 | (t
|
---|
| 32 | (case (caar expr)
|
---|
| 33 | (mplus (reduce #'(lambda (x y) (poly-add *maxima-ring* x y)) (parse-list (cdr expr))))
|
---|
| 34 | (mminus (poly-uminus *maxima-ring* (parse (cadr expr))))
|
---|
| 35 | (mtimes
|
---|
| 36 | (if (endp (cddr expr)) ;unary
|
---|
| 37 | (parse (cdr expr))
|
---|
| 38 | (reduce #'(lambda (p q) (poly-mul *maxima-ring* p q)) (parse-list (cdr expr)))))
|
---|
| 39 | (mexpt
|
---|
| 40 | (cond
|
---|
| 41 | ((member (cadr expr) vars :test #'equal-test-p)
|
---|
| 42 | ;;Special handling of (expt var pow)
|
---|
| 43 | (let ((pos (position (cadr expr) vars :test #'equal-test-p)))
|
---|
| 44 | (make-variable *maxima-ring* (length vars) pos (caddr expr))))
|
---|
| 45 | ((not (and (integerp (caddr expr)) (plusp (caddr expr))))
|
---|
| 46 | ;; Negative power means division in coefficient ring
|
---|
| 47 | ;; Non-integer power means non-polynomial coefficient
|
---|
| 48 | (mtell "~%Warning: Expression ~%~M~%contains power which is not a positive integer. Parsing as coefficient.~%"
|
---|
| 49 | expr)
|
---|
| 50 | (coerce-coeff *maxima-ring* expr vars))
|
---|
| 51 | (t (poly-expt *maxima-ring* (parse (cadr expr)) (caddr expr)))))
|
---|
| 52 | (mrat (parse ($ratdisrep expr)))
|
---|
| 53 | (mpois (parse ($outofpois expr)))
|
---|
| 54 | (otherwise
|
---|
| 55 | (coerce-coeff *maxima-ring* expr vars)))))))
|
---|
| 56 |
|
---|
| 57 | (defun parse-poly-list (expr vars)
|
---|
| 58 | (case (caar expr)
|
---|
| 59 | (mlist (mapcar #'(lambda (p) (parse-poly p vars)) (cdr expr)))
|
---|
| 60 | (t (merror "Expression ~M is not a list of polynomials in variables ~M."
|
---|
| 61 | expr vars))))
|
---|
| 62 | (defun parse-poly-list-list (poly-list-list vars)
|
---|
| 63 | (mapcar #'(lambda (g) (parse-poly-list g vars)) (coerce-maxima-list poly-list-list)))
|
---|