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


Ignore:
Timestamp:
2015-06-14T20:51:10-07:00 (9 years ago)
Author:
Marek Rychlik
Message:

* empty log message *

File:
1 edited

Legend:

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

    r1658 r1670  
    6969;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
    7070
    71 (defparameter *maxima-ring*
     71(defparameter +maxima-ring+
    7272    (make-ring
    7373     ;;(defun coeff-zerop (expr) (meval1 `(($is) (($equal) ,expr 0))))
     
    127127     ((member expr vars :test #'equal-test-p)
    128128      (let ((pos (position expr vars :test #'equal-test-p)))
    129         (make-poly-variable *maxima-ring* (length vars) pos)))
     129        (make-poly-variable +maxima-ring+ (length vars) pos)))
    130130     ((free-of-vars expr vars)
    131131      ;;This means that variable-free CRE and Poisson forms will be converted
    132132      ;;to coefficients intact
    133       (coerce-coeff *maxima-ring* expr vars))
     133      (coerce-coeff +maxima-ring+ expr vars))
    134134     (t
    135135      (case (caar expr)
    136         (mplus (reduce #'(lambda (x y) (poly-add *maxima-ring* x y)) (parse-list (cdr expr))))
    137         (mminus (poly-uminus *maxima-ring* (parse (cadr expr))))
     136        (mplus (reduce #'(lambda (x y) (poly-add +maxima-ring+ x y)) (parse-list (cdr expr))))
     137        (mminus (poly-uminus +maxima-ring+ (parse (cadr expr))))
    138138        (mtimes
    139139         (if (endp (cddr expr))         ;unary
    140140             (parse (cdr expr))
    141            (reduce #'(lambda (p q) (poly-mul *maxima-ring* p q)) (parse-list (cdr expr)))))
     141           (reduce #'(lambda (p q) (poly-mul +maxima-ring+ p q)) (parse-list (cdr expr)))))
    142142        (mexpt
    143143         (cond
     
    145145           ;;Special handling of (expt var pow)
    146146           (let ((pos (position (cadr expr) vars :test #'equal-test-p)))
    147              (make-poly-variable *maxima-ring* (length vars) pos (caddr expr))))
     147             (make-poly-variable +maxima-ring+ (length vars) pos (caddr expr))))
    148148          ((not (and (integerp (caddr expr)) (plusp (caddr expr))))
    149149           ;; Negative power means division in coefficient ring
     
    151151           (mtell "~%Warning: Expression ~%~M~%contains power which is not a positive integer. Parsing as coefficient.~%"
    152152                  expr)
    153            (coerce-coeff *maxima-ring* expr vars))
    154           (t (poly-expt *maxima-ring* (parse (cadr expr)) (caddr expr)))))
     153           (coerce-coeff +maxima-ring+ expr vars))
     154          (t (poly-expt +maxima-ring+ (parse (cadr expr)) (caddr expr)))))
    155155        (mrat (parse ($ratdisrep expr)))
    156156        (mpois (parse ($outofpois expr)))
    157157        (otherwise
    158          (coerce-coeff *maxima-ring* expr vars)))))))
     158         (coerce-coeff +maxima-ring+ expr vars)))))))
    159159
    160160(defun parse-poly-list (expr vars)
     
    211211                             (p (parse-poly p vars)))
    212212     ,@(when documentation-supplied-p (list documentation))
    213      (coerce-to-maxima :polynomial (,fun-name *maxima-ring* p) vars)))
     213     (coerce-to-maxima :polynomial (,fun-name +maxima-ring+ p) vars)))
    214214
    215215(defmacro define-binop (maxima-name fun-name
     
    222222                             (q (parse-poly q vars)))
    223223     ,@(when documentation-supplied-p (list documentation))
    224      (coerce-to-maxima :polynomial (,fun-name *maxima-ring* p q) vars)))
     224     (coerce-to-maxima :polynomial (,fun-name +maxima-ring+ p q) vars)))
    225225
    226226
     
    260260   ((symbolp ring)
    261261    (case ring
    262       ((maxima-ring  :maxima-ring $expression_ring) *maxima-ring*)
    263       ((ring-of-integers :ring-of-integers $ring_of_integers) *ring-of-integers*)
     262      ((maxima-ring  :maxima-ring $expression_ring) +maxima-ring+)
     263      ((ring-of-integers :ring-of-integers $ring_of_integers) +ring-of-integers+)
    264264      (otherwise
    265265       (mtell "~%Warning: Ring ~M not found. Using default.~%" ring))))
     
    283283(defmacro with-coefficient-ring ((ring) &body body)
    284284  "Evaluate BODY with coefficient ring set to RING."
    285   `(let ((*maxima-ring* (or (find-ring ,ring) *maxima-ring*)))
     285  `(let ((+maxima-ring+ (or (find-ring ,ring) +maxima-ring+)))
    286286     . ,body))
    287287
     
    289289  "Evaluate BODY with monomial order set to ORDER and coefficient ring set to RING."
    290290  `(let ((*monomial-order* (or (find-order ,order) *monomial-order*))
    291          (*maxima-ring* (or (find-ring ,ring) *maxima-ring*)))
     291         (+maxima-ring+ (or (find-ring ,ring) +maxima-ring+)))
    292292     . ,body))
    293293
     
    380380(defmfun $poly_expt (p n vars)
    381381  (with-parsed-polynomials ((vars) :polynomials (p) :value-type :polynomial)
    382     (poly-expt *maxima-ring* p n)))
     382    (poly-expt +maxima-ring+ p n)))
    383383
    384384(defmfun $poly_content (p vars)
    385385  (with-parsed-polynomials ((vars) :polynomials (p))
    386     (poly-content *maxima-ring* p)))
     386    (poly-content +maxima-ring+ p)))
    387387
    388388(defmfun $poly_pseudo_divide (f fl vars
     
    391391                                 (fl (parse-poly-list fl vars)))
    392392  (multiple-value-bind (quot rem c division-count)
    393       (poly-pseudo-divide *maxima-ring* f fl)
     393      (poly-pseudo-divide +maxima-ring+ f fl)
    394394    `((mlist)
    395395      ,(coerce-to-maxima :poly-list quot vars)
     
    400400(defmfun $poly_exact_divide (f g vars)
    401401  (with-parsed-polynomials ((vars) :polynomials (f g) :value-type :polynomial)
    402     (poly-exact-divide *maxima-ring* f g)))
     402    (poly-exact-divide +maxima-ring+ f g)))
    403403
    404404(defmfun $poly_normal_form (f fl vars)
     
    406406                                   :poly-lists (fl)
    407407                                   :value-type :polynomial)
    408     (normal-form *maxima-ring* f (remzero fl) nil)))
     408    (normal-form +maxima-ring+ f (remzero fl) nil)))
    409409
    410410(defmfun $poly_buchberger_criterion (g vars)
    411411  (with-parsed-polynomials ((vars) :poly-lists (g) :value-type :logical)
    412     (buchberger-criterion *maxima-ring* g)))
     412    (buchberger-criterion +maxima-ring+ g)))
    413413
    414414(defmfun $poly_buchberger (fl vars)
    415415  (with-parsed-polynomials ((vars) :poly-lists (fl) :value-type :poly-list)
    416     (buchberger *maxima-ring*  (remzero fl) 0 nil)))
     416    (buchberger +maxima-ring+  (remzero fl) 0 nil)))
    417417
    418418(defmfun $poly_reduction (plist vars)
    419419  (with-parsed-polynomials ((vars) :poly-lists (plist)
    420420                                   :value-type :poly-list)
    421     (reduction *maxima-ring* plist)))
     421    (reduction +maxima-ring+ plist)))
    422422
    423423(defmfun $poly_minimization (plist vars)
     
    429429  (with-parsed-polynomials ((vars) :poly-lists (plist)
    430430                                   :value-type :poly-list)
    431     (poly-normalize-list *maxima-ring* plist)))
     431    (poly-normalize-list +maxima-ring+ plist)))
    432432
    433433(defmfun $poly_grobner (f vars)
    434434  (with-parsed-polynomials ((vars) :poly-lists (f)
    435435                                   :value-type :poly-list)
    436     (grobner *maxima-ring* (remzero f))))
     436    (grobner +maxima-ring+ (remzero f))))
    437437
    438438(defmfun $poly_reduced_grobner (f vars)
    439439  (with-parsed-polynomials ((vars) :poly-lists (f)
    440440                                   :value-type :poly-list)
    441     (reduced-grobner *maxima-ring* (remzero f))))
     441    (reduced-grobner +maxima-ring+ (remzero f))))
    442442
    443443(defmfun $poly_depends_p (p var mvars
     
    451451  (with-parsed-polynomials ((vars) :poly-lists (flist)
    452452                                   :value-type :poly-list)
    453     (elimination-ideal *maxima-ring* flist k nil 0)))
     453    (elimination-ideal +maxima-ring+ flist k nil 0)))
    454454
    455455(defmfun $poly_colon_ideal (f g vars)
    456456  (with-parsed-polynomials ((vars) :poly-lists (f g) :value-type :poly-list)
    457     (colon-ideal *maxima-ring* f g nil)))
     457    (colon-ideal +maxima-ring+ f g nil)))
    458458
    459459(defmfun $poly_ideal_intersection (f g vars)
    460460  (with-parsed-polynomials ((vars) :poly-lists (f g) :value-type :poly-list) 
    461     (ideal-intersection *maxima-ring* f g nil)))
     461    (ideal-intersection +maxima-ring+ f g nil)))
    462462
    463463(defmfun $poly_lcm (f g vars)
    464464  (with-parsed-polynomials ((vars) :polynomials (f g) :value-type :polynomial)
    465     (poly-lcm *maxima-ring* f g)))
     465    (poly-lcm +maxima-ring+ f g)))
    466466
    467467(defmfun $poly_gcd (f g vars)
     
    470470(defmfun $poly_grobner_equal (g1 g2 vars)
    471471  (with-parsed-polynomials ((vars) :poly-lists (g1 g2))
    472     (grobner-equal *maxima-ring* g1 g2)))
     472    (grobner-equal +maxima-ring+ g1 g2)))
    473473
    474474(defmfun $poly_grobner_subsetp (g1 g2 vars)
    475475  (with-parsed-polynomials ((vars) :poly-lists (g1 g2))
    476     (grobner-subsetp *maxima-ring* g1 g2)))
     476    (grobner-subsetp +maxima-ring+ g1 g2)))
    477477
    478478(defmfun $poly_grobner_member (p g vars)
    479479  (with-parsed-polynomials ((vars) :polynomials (p) :poly-lists (g))
    480     (grobner-member *maxima-ring* p g)))
     480    (grobner-member +maxima-ring+ p g)))
    481481
    482482(defmfun $poly_ideal_saturation1 (f p vars)
    483483  (with-parsed-polynomials ((vars) :poly-lists (f) :polynomials (p)
    484484                                   :value-type :poly-list)
    485     (ideal-saturation-1 *maxima-ring* f p 0)))
     485    (ideal-saturation-1 +maxima-ring+ f p 0)))
    486486
    487487(defmfun $poly_saturation_extension (f plist vars new-vars)
     
    489489                            :poly-lists (f plist)
    490490                            :value-type :poly-list)
    491     (saturation-extension *maxima-ring* f plist)))
     491    (saturation-extension +maxima-ring+ f plist)))
    492492
    493493(defmfun $poly_polysaturation_extension (f plist vars new-vars)
     
    495495                            :poly-lists (f plist)
    496496                            :value-type :poly-list)
    497     (polysaturation-extension *maxima-ring* f plist)))
     497    (polysaturation-extension +maxima-ring+ f plist)))
    498498
    499499(defmfun $poly_ideal_polysaturation1 (f plist vars)
    500500  (with-parsed-polynomials ((vars) :poly-lists (f plist)
    501501                                   :value-type :poly-list)
    502     (ideal-polysaturation-1 *maxima-ring* f plist 0 nil)))
     502    (ideal-polysaturation-1 +maxima-ring+ f plist 0 nil)))
    503503
    504504(defmfun $poly_ideal_saturation (f g vars)
    505505  (with-parsed-polynomials ((vars) :poly-lists (f g)
    506506                                   :value-type  :poly-list)
    507     (ideal-saturation *maxima-ring* f g 0 nil)))
     507    (ideal-saturation +maxima-ring+ f g 0 nil)))
    508508
    509509(defmfun $poly_ideal_polysaturation (f ideal-list vars)
     
    511511                                   :poly-list-lists (ideal-list)
    512512                                   :value-type :poly-list)
    513     (ideal-polysaturation *maxima-ring* f ideal-list 0 nil)))
     513    (ideal-polysaturation +maxima-ring+ f ideal-list 0 nil)))
    514514
    515515(defmfun $poly_lt (f vars)
     
    519519(defmfun $poly_lm (f vars)
    520520  (with-parsed-polynomials ((vars) :polynomials (f) :value-type :polynomial)
    521     (make-poly-from-termlist (list (make-term (poly-lm f) (funcall (ring-unit *maxima-ring*)))))))
    522 
     521    (make-poly-from-termlist (list (make-term (poly-lm f) (funcall (ring-unit +maxima-ring+)))))))
     522
Note: See TracChangeset for help on using the changeset viewer.