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 619 for branches


Ignore:
Timestamp:
2015-06-07T00:14:03-07:00 (9 years ago)
Author:
Marek Rychlik
Message:

* empty log message *

File:
1 edited

Legend:

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

    r615 r619  
    100100      *ratdisrep-fun* '$ratdisrep     ; Coefficients are converted to general form
    101101      )
     102
     103;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
     104;;
     105;; Maxima expression parsing
     106;;
     107;;
     108;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
     109;;
     110;; Functions and macros dealing with internal representation
     111;; structure.
     112;;
     113;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
     114
     115(defun equal-test-p (expr1 expr2)
     116  (alike1 expr1 expr2))
     117
     118(defun coerce-maxima-list (expr)
     119  "Convert a Maxima list to Lisp list."
     120  (cond
     121   ((and (consp (car expr)) (eql (caar expr) 'mlist)) (cdr expr))
     122   (t expr)))
     123
     124(defun free-of-vars (expr vars) (apply #'$freeof `(,@vars ,expr)))
     125
     126(defun parse-poly (expr vars &aux (vars (coerce-maxima-list vars)))
     127  "Convert a maxima polynomial expression EXPR in variables VARS to internal form."
     128  (labels ((parse (arg) (parse-poly arg vars))
     129           (parse-list (args) (mapcar #'parse args)))
     130    (cond
     131     ((eql expr 0) (make-poly-zero))
     132     ((member expr vars :test #'equal-test-p)
     133      (let ((pos (position expr vars :test #'equal-test-p)))
     134        (make-variable *expression-ring* (length vars) pos)))
     135     ((free-of-vars expr vars)
     136      ;;This means that variable-free CRE and Poisson forms will be converted
     137      ;;to coefficients intact
     138      (coerce-coeff *expression-ring* expr vars))
     139     (t
     140      (case (caar expr)
     141        (mplus (reduce #'(lambda (x y) (poly-add *expression-ring* x y)) (parse-list (cdr expr))))
     142        (mminus (poly-uminus *expression-ring* (parse (cadr expr))))
     143        (mtimes
     144         (if (endp (cddr expr))         ;unary
     145             (parse (cdr expr))
     146           (reduce #'(lambda (p q) (poly-mul *expression-ring* p q)) (parse-list (cdr expr)))))
     147        (mexpt
     148         (cond
     149          ((member (cadr expr) vars :test #'equal-test-p)
     150           ;;Special handling of (expt var pow)
     151           (let ((pos (position (cadr expr) vars :test #'equal-test-p)))
     152             (make-variable *expression-ring* (length vars) pos (caddr expr))))
     153          ((not (and (integerp (caddr expr)) (plusp (caddr expr))))
     154           ;; Negative power means division in coefficient ring
     155           ;; Non-integer power means non-polynomial coefficient
     156           (mtell "~%Warning: Expression ~%~M~%contains power which is not a positive integer. Parsing as coefficient.~%"
     157                  expr)
     158           (coerce-coeff *expression-ring* expr vars))
     159          (t (poly-expt *expression-ring* (parse (cadr expr)) (caddr expr)))))
     160        (mrat (parse ($ratdisrep expr)))
     161        (mpois (parse ($outofpois expr)))
     162        (otherwise
     163         (coerce-coeff *expression-ring* expr vars)))))))
     164
     165(defun parse-poly-list (expr vars)
     166  "Parse a Maxima representation of a list of polynomials."
     167  (case (caar expr)
     168    (mlist (mapcar #'(lambda (p) (parse-poly p vars)) (cdr expr)))
     169    (t (merror "Expression ~M is not a list of polynomials in variables ~M."
     170               expr vars))))
     171
     172(defun parse-poly-list-list (poly-list-list vars)
     173  "Parse a Maxima representation of a list of lists of polynomials."
     174  (mapcar #'(lambda (g) (parse-poly-list g vars)) (coerce-maxima-list poly-list-list)))
    102175
    103176
Note: See TracChangeset for help on using the changeset viewer.