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


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

* empty log message *

File:
1 edited

Legend:

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

    r578 r615  
    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)))
    175102
    176103
Note: See TracChangeset for help on using the changeset viewer.