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


Ignore:
Timestamp:
2015-06-05T15:58:42-07:00 (9 years ago)
Author:
Marek Rychlik
Message:

* empty log message *

File:
1 edited

Legend:

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

    r231 r233  
    136136     ((member expr vars :test #'equal-test-p)
    137137      (let ((pos (position expr vars :test #'equal-test-p)))
    138         (make-variable *coefficient-ring* (length vars) pos)))
     138        (make-variable *expression-ring* (length vars) pos)))
    139139     ((free-of-vars expr vars)
    140140      ;;This means that variable-free CRE and Poisson forms will be converted
    141141      ;;to coefficients intact
    142       (coerce-coeff *coefficient-ring* expr vars))
     142      (coerce-coeff *expression-ring* expr vars))
    143143     (t
    144144      (case (caar expr)
    145         (mplus (reduce #'(lambda (x y) (poly-add *coefficient-ring* x y)) (parse-list (cdr expr))))
    146         (mminus (poly-uminus *coefficient-ring* (parse (cadr expr))))
     145        (mplus (reduce #'(lambda (x y) (poly-add *expression-ring* x y)) (parse-list (cdr expr))))
     146        (mminus (poly-uminus *expression-ring* (parse (cadr expr))))
    147147        (mtimes
    148148         (if (endp (cddr expr))         ;unary
    149149             (parse (cdr expr))
    150            (reduce #'(lambda (p q) (poly-mul *coefficient-ring* p q)) (parse-list (cdr expr)))))
     150           (reduce #'(lambda (p q) (poly-mul *expression-ring* p q)) (parse-list (cdr expr)))))
    151151        (mexpt
    152152         (cond
     
    154154           ;;Special handling of (expt var pow)
    155155           (let ((pos (position (cadr expr) vars :test #'equal-test-p)))
    156              (make-variable *coefficient-ring* (length vars) pos (caddr expr))))
     156             (make-variable *expression-ring* (length vars) pos (caddr expr))))
    157157          ((not (and (integerp (caddr expr)) (plusp (caddr expr))))
    158158           ;; Negative power means division in coefficient ring
     
    160160           (mtell "~%Warning: Expression ~%~M~%contains power which is not a positive integer. Parsing as coefficient.~%"
    161161                  expr)
    162            (coerce-coeff *coefficient-ring* expr vars))
    163           (t (poly-expt *coefficient-ring* (parse (cadr expr)) (caddr expr)))))
     162           (coerce-coeff *expression-ring* expr vars))
     163          (t (poly-expt *expression-ring* (parse (cadr expr)) (caddr expr)))))
    164164        (mrat (parse ($ratdisrep expr)))
    165165        (mpois (parse ($outofpois expr)))
    166166        (otherwise
    167          (coerce-coeff *coefficient-ring* expr vars)))))))
     167         (coerce-coeff *expression-ring* expr vars)))))))
    168168
    169169(defun parse-poly-list (expr vars)
     
    190190                             (p (parse-poly p vars)))
    191191     ,@(when documentation-supplied-p (list documentation))
    192      (coerce-to-maxima :polynomial (,fun-name *coefficient-ring* p) vars)))
     192     (coerce-to-maxima :polynomial (,fun-name *expression-ring* p) vars)))
    193193
    194194(defmacro define-binop (maxima-name fun-name
     
    201201                             (q (parse-poly q vars)))
    202202     ,@(when documentation-supplied-p (list documentation))
    203      (coerce-to-maxima :polynomial (,fun-name *coefficient-ring* p q) vars)))
     203     (coerce-to-maxima :polynomial (,fun-name *expression-ring* p q) vars)))
    204204
    205205
     
    218218(defmacro with-coefficient-ring ((ring) &body body)
    219219  "Evaluate BODY with coefficient ring set to RING."
    220   `(let ((*coefficient-ring* (or (find-ring ,ring) *coefficient-ring*)))
     220  `(let ((*expression-ring* (or (find-ring ,ring) *expression-ring*)))
    221221     . ,body))
    222222
     
    309309(defmfun $poly_expt (p n vars)
    310310  (with-parsed-polynomials ((vars) :polynomials (p) :value-type :polynomial)
    311     (poly-expt *coefficient-ring* p n)))
     311    (poly-expt *expression-ring* p n)))
    312312
    313313(defmfun $poly_content (p vars)
    314314  (with-parsed-polynomials ((vars) :polynomials (p))
    315     (poly-content *coefficient-ring* p)))
     315    (poly-content *expression-ring* p)))
    316316
    317317(defmfun $poly_pseudo_divide (f fl vars
     
    320320                                 (fl (parse-poly-list fl vars)))
    321321  (multiple-value-bind (quot rem c division-count)
    322       (poly-pseudo-divide *coefficient-ring* f fl)
     322      (poly-pseudo-divide *expression-ring* f fl)
    323323    `((mlist)
    324324      ,(coerce-to-maxima :poly-list quot vars)
     
    329329(defmfun $poly_exact_divide (f g vars)
    330330  (with-parsed-polynomials ((vars) :polynomials (f g) :value-type :polynomial)
    331     (poly-exact-divide *coefficient-ring* f g)))
     331    (poly-exact-divide *expression-ring* f g)))
    332332
    333333(defmfun $poly_normal_form (f fl vars)
     
    335335                                   :poly-lists (fl)
    336336                                   :value-type :polynomial)
    337     (normal-form *coefficient-ring* f (remzero fl) nil)))
     337    (normal-form *expression-ring* f (remzero fl) nil)))
    338338
    339339(defmfun $poly_buchberger_criterion (g vars)
    340340  (with-parsed-polynomials ((vars) :poly-lists (g) :value-type :logical)
    341     (buchberger-criterion *coefficient-ring* g)))
     341    (buchberger-criterion *expression-ring* g)))
    342342
    343343(defmfun $poly_buchberger (fl vars)
    344344  (with-parsed-polynomials ((vars) :poly-lists (fl) :value-type :poly-list)
    345     (buchberger *coefficient-ring*  (remzero fl) 0 nil)))
     345    (buchberger *expression-ring*  (remzero fl) 0 nil)))
    346346
    347347(defmfun $poly_reduction (plist vars)
    348348  (with-parsed-polynomials ((vars) :poly-lists (plist)
    349349                                   :value-type :poly-list)
    350     (reduction *coefficient-ring* plist)))
     350    (reduction *expression-ring* plist)))
    351351
    352352(defmfun $poly_minimization (plist vars)
     
    358358  (with-parsed-polynomials ((vars) :poly-lists (plist)
    359359                                   :value-type :poly-list)
    360     (poly-normalize-list *coefficient-ring* plist)))
     360    (poly-normalize-list *expression-ring* plist)))
    361361
    362362(defmfun $poly_grobner (f vars)
    363363  (with-parsed-polynomials ((vars) :poly-lists (f)
    364364                                   :value-type :poly-list)
    365     (grobner *coefficient-ring* (remzero f))))
     365    (grobner *expression-ring* (remzero f))))
    366366
    367367(defmfun $poly_reduced_grobner (f vars)
    368368  (with-parsed-polynomials ((vars) :poly-lists (f)
    369369                                   :value-type :poly-list)
    370     (reduced-grobner *coefficient-ring* (remzero f))))
     370    (reduced-grobner *expression-ring* (remzero f))))
    371371
    372372(defmfun $poly_depends_p (p var mvars
     
    380380  (with-parsed-polynomials ((vars) :poly-lists (flist)
    381381                                   :value-type :poly-list)
    382     (elimination-ideal *coefficient-ring* flist k nil 0)))
     382    (elimination-ideal *expression-ring* flist k nil 0)))
    383383
    384384(defmfun $poly_colon_ideal (f g vars)
    385385  (with-parsed-polynomials ((vars) :poly-lists (f g) :value-type :poly-list)
    386     (colon-ideal *coefficient-ring* f g nil)))
     386    (colon-ideal *expression-ring* f g nil)))
    387387
    388388(defmfun $poly_ideal_intersection (f g vars)
    389389  (with-parsed-polynomials ((vars) :poly-lists (f g) :value-type :poly-list) 
    390     (ideal-intersection *coefficient-ring* f g nil)))
     390    (ideal-intersection *expression-ring* f g nil)))
    391391
    392392(defmfun $poly_lcm (f g vars)
    393393  (with-parsed-polynomials ((vars) :polynomials (f g) :value-type :polynomial)
    394     (poly-lcm *coefficient-ring* f g)))
     394    (poly-lcm *expression-ring* f g)))
    395395
    396396(defmfun $poly_gcd (f g vars)
     
    399399(defmfun $poly_grobner_equal (g1 g2 vars)
    400400  (with-parsed-polynomials ((vars) :poly-lists (g1 g2))
    401     (grobner-equal *coefficient-ring* g1 g2)))
     401    (grobner-equal *expression-ring* g1 g2)))
    402402
    403403(defmfun $poly_grobner_subsetp (g1 g2 vars)
    404404  (with-parsed-polynomials ((vars) :poly-lists (g1 g2))
    405     (grobner-subsetp *coefficient-ring* g1 g2)))
     405    (grobner-subsetp *expression-ring* g1 g2)))
    406406
    407407(defmfun $poly_grobner_member (p g vars)
    408408  (with-parsed-polynomials ((vars) :polynomials (p) :poly-lists (g))
    409     (grobner-member *coefficient-ring* p g)))
     409    (grobner-member *expression-ring* p g)))
    410410
    411411(defmfun $poly_ideal_saturation1 (f p vars)
    412412  (with-parsed-polynomials ((vars) :poly-lists (f) :polynomials (p)
    413413                                   :value-type :poly-list)
    414     (ideal-saturation-1 *coefficient-ring* f p 0)))
     414    (ideal-saturation-1 *expression-ring* f p 0)))
    415415
    416416(defmfun $poly_saturation_extension (f plist vars new-vars)
     
    418418                            :poly-lists (f plist)
    419419                            :value-type :poly-list)
    420     (saturation-extension *coefficient-ring* f plist)))
     420    (saturation-extension *expression-ring* f plist)))
    421421
    422422(defmfun $poly_polysaturation_extension (f plist vars new-vars)
     
    424424                            :poly-lists (f plist)
    425425                            :value-type :poly-list)
    426     (polysaturation-extension *coefficient-ring* f plist)))
     426    (polysaturation-extension *expression-ring* f plist)))
    427427
    428428(defmfun $poly_ideal_polysaturation1 (f plist vars)
    429429  (with-parsed-polynomials ((vars) :poly-lists (f plist)
    430430                                   :value-type :poly-list)
    431     (ideal-polysaturation-1 *coefficient-ring* f plist 0 nil)))
     431    (ideal-polysaturation-1 *expression-ring* f plist 0 nil)))
    432432
    433433(defmfun $poly_ideal_saturation (f g vars)
    434434  (with-parsed-polynomials ((vars) :poly-lists (f g)
    435435                                   :value-type  :poly-list)
    436     (ideal-saturation *coefficient-ring* f g 0 nil)))
     436    (ideal-saturation *expression-ring* f g 0 nil)))
    437437
    438438(defmfun $poly_ideal_polysaturation (f ideal-list vars)
     
    440440                                   :poly-list-lists (ideal-list)
    441441                                   :value-type :poly-list)
    442     (ideal-polysaturation *coefficient-ring* f ideal-list 0 nil)))
     442    (ideal-polysaturation *expression-ring* f ideal-list 0 nil)))
    443443
    444444(defmfun $poly_lt (f vars)
     
    448448(defmfun $poly_lm (f vars)
    449449  (with-parsed-polynomials ((vars) :polynomials (f) :value-type :polynomial)
    450     (make-poly-from-termlist (list (make-term (poly-lm f) (funcall (ring-unit *coefficient-ring*)))))))
    451 
     450    (make-poly-from-termlist (list (make-term (poly-lm f) (funcall (ring-unit *expression-ring*)))))))
     451
Note: See TracChangeset for help on using the changeset viewer.