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.

source: branches/f4grobner/mx-parsing.lisp@ 92

Last change on this file since 92 was 68, checked in by Marek Rychlik, 10 years ago

* empty log message *

File size: 2.5 KB
RevLine 
[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)))
Note: See TracBrowser for help on using the repository browser.