Changeset 233 for branches

Timestamp:

2015-06-05T15:58:42-07:00 (10 years ago)

Author:

Marek Rychlik

Message:

* empty log message *

File:

• branches/f4grobner/mx-grobner.lisp (modified) (17 diffs)

branches/f4grobner/mx-grobner.lisp

@@ -136 +136 @@
      ((member expr vars :test #'equal-test-p)
       (let ((pos (position expr vars :test #'equal-test-p)))
-        (make-variable *coefficient-ring* (length vars) pos)))
+        (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 *coefficient-ring* expr vars))
+      (coerce-coeff *expression-ring* expr vars))
      (t
       (case (caar expr)
-        (mplus (reduce #'(lambda (x y) (poly-add *coefficient-ring* x y)) (parse-list (cdr expr))))
-        (mminus (poly-uminus *coefficient-ring* (parse (cadr 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 *coefficient-ring* p q)) (parse-list (cdr expr)))))
+           (reduce #'(lambda (p q) (poly-mul *expression-ring* p q)) (parse-list (cdr expr)))))
         (mexpt
          (cond
@@ -154 +154 @@
            ;;Special handling of (expt var pow)
            (let ((pos (position (cadr expr) vars :test #'equal-test-p)))
-             (make-variable *coefficient-ring* (length vars) pos (caddr expr))))
+             (make-variable *expression-ring* (length vars) pos (caddr expr))))
           ((not (and (integerp (caddr expr)) (plusp (caddr expr))))
            ;; Negative power means division in coefficient ring
@@ -160 +160 @@
            (mtell "~%Warning: Expression ~%~M~%contains power which is not a positive integer. Parsing as coefficient.~%"
                   expr)
-           (coerce-coeff *coefficient-ring* expr vars))
-          (t (poly-expt *coefficient-ring* (parse (cadr expr)) (caddr 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 *coefficient-ring* expr vars)))))))
+         (coerce-coeff *expression-ring* expr vars)))))))
 
 (defun parse-poly-list (expr vars)
@@ -190 +190 @@
                              (p (parse-poly p vars)))
      ,@(when documentation-supplied-p (list documentation))
-     (coerce-to-maxima :polynomial (,fun-name *coefficient-ring* p) vars)))
+     (coerce-to-maxima :polynomial (,fun-name *expression-ring* p) vars)))
 
 (defmacro define-binop (maxima-name fun-name
@@ -201 +201 @@
                              (q (parse-poly q vars)))
      ,@(when documentation-supplied-p (list documentation))
-     (coerce-to-maxima :polynomial (,fun-name *coefficient-ring* p q) vars)))
+     (coerce-to-maxima :polynomial (,fun-name *expression-ring* p q) vars)))
 
 
@@ -218 +218 @@
 (defmacro with-coefficient-ring ((ring) &body body)
   "Evaluate BODY with coefficient ring set to RING."
-  `(let ((*coefficient-ring* (or (find-ring ,ring) *coefficient-ring*)))
+  `(let ((*expression-ring* (or (find-ring ,ring) *expression-ring*)))
      . ,body))
 
@@ -309 +309 @@
 (defmfun $poly_expt (p n vars)
   (with-parsed-polynomials ((vars) :polynomials (p) :value-type :polynomial)
-    (poly-expt *coefficient-ring* p n)))
+    (poly-expt *expression-ring* p n)))
 
 (defmfun $poly_content (p vars)
   (with-parsed-polynomials ((vars) :polynomials (p))
-    (poly-content *coefficient-ring* p)))
+    (poly-content *expression-ring* p)))
 
 (defmfun $poly_pseudo_divide (f fl vars
@@ -320 +320 @@
                                  (fl (parse-poly-list fl vars)))
   (multiple-value-bind (quot rem c division-count)
-      (poly-pseudo-divide *coefficient-ring* f fl)
+      (poly-pseudo-divide *expression-ring* f fl)
     `((mlist)
       ,(coerce-to-maxima :poly-list quot vars)
@@ -329 +329 @@
 (defmfun $poly_exact_divide (f g vars)
   (with-parsed-polynomials ((vars) :polynomials (f g) :value-type :polynomial)
-    (poly-exact-divide *coefficient-ring* f g)))
+    (poly-exact-divide *expression-ring* f g)))
 
 (defmfun $poly_normal_form (f fl vars)
@@ -335 +335 @@
                                    :poly-lists (fl)
                                    :value-type :polynomial)
-    (normal-form *coefficient-ring* f (remzero fl) nil)))
+    (normal-form *expression-ring* f (remzero fl) nil)))
 
 (defmfun $poly_buchberger_criterion (g vars)
   (with-parsed-polynomials ((vars) :poly-lists (g) :value-type :logical)
-    (buchberger-criterion *coefficient-ring* g)))
+    (buchberger-criterion *expression-ring* g)))
 
 (defmfun $poly_buchberger (fl vars)
   (with-parsed-polynomials ((vars) :poly-lists (fl) :value-type :poly-list)
-    (buchberger *coefficient-ring*  (remzero fl) 0 nil)))
+    (buchberger *expression-ring*  (remzero fl) 0 nil)))
 
 (defmfun $poly_reduction (plist vars)
   (with-parsed-polynomials ((vars) :poly-lists (plist)
                                    :value-type :poly-list)
-    (reduction *coefficient-ring* plist)))
+    (reduction *expression-ring* plist)))
 
 (defmfun $poly_minimization (plist vars)
@@ -358 +358 @@
   (with-parsed-polynomials ((vars) :poly-lists (plist)
                                    :value-type :poly-list)
-    (poly-normalize-list *coefficient-ring* plist)))
+    (poly-normalize-list *expression-ring* plist)))
 
 (defmfun $poly_grobner (f vars)
   (with-parsed-polynomials ((vars) :poly-lists (f)
                                    :value-type :poly-list)
-    (grobner *coefficient-ring* (remzero f))))
+    (grobner *expression-ring* (remzero f))))
 
 (defmfun $poly_reduced_grobner (f vars)
   (with-parsed-polynomials ((vars) :poly-lists (f)
                                    :value-type :poly-list)
-    (reduced-grobner *coefficient-ring* (remzero f))))
+    (reduced-grobner *expression-ring* (remzero f))))
 
 (defmfun $poly_depends_p (p var mvars
@@ -380 +380 @@
   (with-parsed-polynomials ((vars) :poly-lists (flist)
                                    :value-type :poly-list)
-    (elimination-ideal *coefficient-ring* flist k nil 0)))
+    (elimination-ideal *expression-ring* flist k nil 0)))
 
 (defmfun $poly_colon_ideal (f g vars)
   (with-parsed-polynomials ((vars) :poly-lists (f g) :value-type :poly-list)
-    (colon-ideal *coefficient-ring* f g nil)))
+    (colon-ideal *expression-ring* f g nil)))
 
 (defmfun $poly_ideal_intersection (f g vars)
   (with-parsed-polynomials ((vars) :poly-lists (f g) :value-type :poly-list)  
-    (ideal-intersection *coefficient-ring* f g nil)))
+    (ideal-intersection *expression-ring* f g nil)))
 
 (defmfun $poly_lcm (f g vars)
   (with-parsed-polynomials ((vars) :polynomials (f g) :value-type :polynomial)
-    (poly-lcm *coefficient-ring* f g)))
+    (poly-lcm *expression-ring* f g)))
 
 (defmfun $poly_gcd (f g vars)
@@ -399 +399 @@
 (defmfun $poly_grobner_equal (g1 g2 vars)
   (with-parsed-polynomials ((vars) :poly-lists (g1 g2))
-    (grobner-equal *coefficient-ring* g1 g2)))
+    (grobner-equal *expression-ring* g1 g2)))
 
 (defmfun $poly_grobner_subsetp (g1 g2 vars)
   (with-parsed-polynomials ((vars) :poly-lists (g1 g2))
-    (grobner-subsetp *coefficient-ring* g1 g2)))
+    (grobner-subsetp *expression-ring* g1 g2)))
 
 (defmfun $poly_grobner_member (p g vars)
   (with-parsed-polynomials ((vars) :polynomials (p) :poly-lists (g))
-    (grobner-member *coefficient-ring* p g)))
+    (grobner-member *expression-ring* p g)))
 
 (defmfun $poly_ideal_saturation1 (f p vars)
   (with-parsed-polynomials ((vars) :poly-lists (f) :polynomials (p)
                                    :value-type :poly-list)
-    (ideal-saturation-1 *coefficient-ring* f p 0)))
+    (ideal-saturation-1 *expression-ring* f p 0)))
 
 (defmfun $poly_saturation_extension (f plist vars new-vars)
@@ -418 +418 @@
                             :poly-lists (f plist)
                             :value-type :poly-list)
-    (saturation-extension *coefficient-ring* f plist)))
+    (saturation-extension *expression-ring* f plist)))
 
 (defmfun $poly_polysaturation_extension (f plist vars new-vars)
@@ -424 +424 @@
                             :poly-lists (f plist)
                             :value-type :poly-list)
-    (polysaturation-extension *coefficient-ring* f plist)))
+    (polysaturation-extension *expression-ring* f plist)))
 
 (defmfun $poly_ideal_polysaturation1 (f plist vars)
   (with-parsed-polynomials ((vars) :poly-lists (f plist)
                                    :value-type :poly-list)
-    (ideal-polysaturation-1 *coefficient-ring* f plist 0 nil)))
+    (ideal-polysaturation-1 *expression-ring* f plist 0 nil)))
 
 (defmfun $poly_ideal_saturation (f g vars)
   (with-parsed-polynomials ((vars) :poly-lists (f g)
                                    :value-type  :poly-list)
-    (ideal-saturation *coefficient-ring* f g 0 nil)))
+    (ideal-saturation *expression-ring* f g 0 nil)))
 
 (defmfun $poly_ideal_polysaturation (f ideal-list vars)
@@ -440 +440 @@
                                    :poly-list-lists (ideal-list)
                                    :value-type :poly-list)
-    (ideal-polysaturation *coefficient-ring* f ideal-list 0 nil)))
+    (ideal-polysaturation *expression-ring* f ideal-list 0 nil)))
 
 (defmfun $poly_lt (f vars)
@@ -448 +448 @@
 (defmfun $poly_lm (f vars)
   (with-parsed-polynomials ((vars) :polynomials (f) :value-type :polynomial)
-    (make-poly-from-termlist (list (make-term (poly-lm f) (funcall (ring-unit *coefficient-ring*)))))))
-
+    (make-poly-from-termlist (list (make-term (poly-lm f) (funcall (ring-unit *expression-ring*)))))))
+