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


Ignore:
Timestamp:
2015-06-05T12:13:37-07:00 (9 years ago)
Author:
Marek Rychlik
Message:

* empty log message *

File:
1 edited

Legend:

Unmodified
Added
Removed
  • branches/f4grobner/mx-grobner.lisp

    r112 r114  
    7171are assumed to be defined.")
    7272
     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
    73140;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
    74141;;
Note: See TracChangeset for help on using the changeset viewer.