Changeset 615 for branches/f4grobner

Timestamp:

2015-06-07T00:06:23-07:00 (9 years ago)

Author:

Marek Rychlik

Message:

* empty log message *

File:

• branches/f4grobner/mx-grobner.lisp (modified) (1 diff)

branches/f4grobner/mx-grobner.lisp

@@ -100 +100 @@
       *ratdisrep-fun* '$ratdisrep     ; Coefficients are converted to general form
       )
-
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;;
-;; Maxima expression parsing
-;;
-;;
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;;
-;; Functions and macros dealing with internal representation
-;; structure.
-;;
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-
-(defun equal-test-p (expr1 expr2)
-  (alike1 expr1 expr2))
-
-(defun coerce-maxima-list (expr)
-  "Convert a Maxima list to Lisp list."
-  (cond
-   ((and (consp (car expr)) (eql (caar expr) 'mlist)) (cdr expr))
-   (t expr)))
-
-(defun free-of-vars (expr vars) (apply #'$freeof `(,@vars ,expr)))
-
-(defun parse-poly (expr vars &aux (vars (coerce-maxima-list vars)))
-  "Convert a maxima polynomial expression EXPR in variables VARS to internal form."
-  (labels ((parse (arg) (parse-poly arg vars))
-           (parse-list (args) (mapcar #'parse args)))
-    (cond
-     ((eql expr 0) (make-poly-zero))
-     ((member expr vars :test #'equal-test-p)
-      (let ((pos (position expr vars :test #'equal-test-p)))
-        (make-variable *expression-ring* (length vars) pos)))
-     ((free-of-vars expr vars)
-      ;;This means that variable-free CRE and Poisson forms will be converted
-      ;;to coefficients intact
-      (coerce-coeff *expression-ring* expr vars))
-     (t
-      (case (caar expr)
-        (mplus (reduce #'(lambda (x y) (poly-add *expression-ring* x y)) (parse-list (cdr expr))))
-        (mminus (poly-uminus *expression-ring* (parse (cadr expr))))
-        (mtimes
-         (if (endp (cddr expr))         ;unary
-             (parse (cdr expr))
-           (reduce #'(lambda (p q) (poly-mul *expression-ring* p q)) (parse-list (cdr expr)))))
-        (mexpt
-         (cond
-          ((member (cadr expr) vars :test #'equal-test-p)
-           ;;Special handling of (expt var pow)
-           (let ((pos (position (cadr expr) vars :test #'equal-test-p)))
-             (make-variable *expression-ring* (length vars) pos (caddr expr))))
-          ((not (and (integerp (caddr expr)) (plusp (caddr expr))))
-           ;; Negative power means division in coefficient ring
-           ;; Non-integer power means non-polynomial coefficient
-           (mtell "~%Warning: Expression ~%~M~%contains power which is not a positive integer. Parsing as coefficient.~%"
-                  expr)
-           (coerce-coeff *expression-ring* expr vars))
-          (t (poly-expt *expression-ring* (parse (cadr expr)) (caddr expr)))))
-        (mrat (parse ($ratdisrep expr)))
-        (mpois (parse ($outofpois expr)))
-        (otherwise
-         (coerce-coeff *expression-ring* expr vars)))))))
-
-(defun parse-poly-list (expr vars)
-  "Parse a Maxima representation of a list of polynomials."
-  (case (caar expr)
-    (mlist (mapcar #'(lambda (p) (parse-poly p vars)) (cdr expr)))
-    (t (merror "Expression ~M is not a list of polynomials in variables ~M."
-               expr vars))))
-
-(defun parse-poly-list-list (poly-list-list vars)
-  "Parse a Maxima representation of a list of lists of polynomials."
-  (mapcar #'(lambda (g) (parse-poly-list g vars)) (coerce-maxima-list poly-list-list)))