Changeset 114
- Timestamp:
- 2015-06-05T12:13:37-07:00 (10 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/f4grobner/mx-grobner.lisp
r112 r114 71 71 are assumed to be defined.") 72 72 73 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 74 ;; 75 ;; Maxima expression parsing 76 ;; 77 ;; NOTE: This code depends on several Maxima lisp functions: 78 ;; 79 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 80 81 (defun equal-test-p (expr1 expr2) 82 (alike1 expr1 expr2)) 83 84 (defun coerce-maxima-list (expr) 85 "convert a maxima list to lisp list." 86 (cond 87 ((and (consp (car expr)) (eql (caar expr) 'mlist)) (cdr expr)) 88 (t expr))) 89 90 (defun free-of-vars (expr vars) (apply #'$freeof `(,@vars ,expr))) 91 92 (defun parse-poly (expr vars &aux (vars (coerce-maxima-list vars))) 93 "Convert a maxima polynomial expression EXPR in variables VARS to internal form." 94 (labels ((parse (arg) (parse-poly arg vars)) 95 (parse-list (args) (mapcar #'parse args))) 96 (cond 97 ((eql expr 0) (make-poly-zero)) 98 ((member expr vars :test #'equal-test-p) 99 (let ((pos (position expr vars :test #'equal-test-p))) 100 (make-variable *maxima-ring* (length vars) pos))) 101 ((free-of-vars expr vars) 102 ;;This means that variable-free CRE and Poisson forms will be converted 103 ;;to coefficients intact 104 (coerce-coeff *maxima-ring* expr vars)) 105 (t 106 (case (caar expr) 107 (mplus (reduce #'(lambda (x y) (poly-add *maxima-ring* x y)) (parse-list (cdr expr)))) 108 (mminus (poly-uminus *maxima-ring* (parse (cadr expr)))) 109 (mtimes 110 (if (endp (cddr expr)) ;unary 111 (parse (cdr expr)) 112 (reduce #'(lambda (p q) (poly-mul *maxima-ring* p q)) (parse-list (cdr expr))))) 113 (mexpt 114 (cond 115 ((member (cadr expr) vars :test #'equal-test-p) 116 ;;Special handling of (expt var pow) 117 (let ((pos (position (cadr expr) vars :test #'equal-test-p))) 118 (make-variable *maxima-ring* (length vars) pos (caddr expr)))) 119 ((not (and (integerp (caddr expr)) (plusp (caddr expr)))) 120 ;; Negative power means division in coefficient ring 121 ;; Non-integer power means non-polynomial coefficient 122 (mtell "~%Warning: Expression ~%~M~%contains power which is not a positive integer. Parsing as coefficient.~%" 123 expr) 124 (coerce-coeff *maxima-ring* expr vars)) 125 (t (poly-expt *maxima-ring* (parse (cadr expr)) (caddr expr))))) 126 (mrat (parse ($ratdisrep expr))) 127 (mpois (parse ($outofpois expr))) 128 (otherwise 129 (coerce-coeff *maxima-ring* expr vars))))))) 130 131 (defun parse-poly-list (expr vars) 132 (case (caar expr) 133 (mlist (mapcar #'(lambda (p) (parse-poly p vars)) (cdr expr))) 134 (t (merror "Expression ~M is not a list of polynomials in variables ~M." 135 expr vars)))) 136 (defun parse-poly-list-list (poly-list-list vars) 137 (mapcar #'(lambda (g) (parse-poly-list g vars)) (coerce-maxima-list poly-list-list))) 138 139 73 140 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 74 141 ;;
Note:
See TracChangeset
for help on using the changeset viewer.