Changes in / [20:30]

Location:

/trunk

Files:

• Docs (added)
• Docs/f4.pdf (added)
• grobner.lisp (modified) (5 diffs)

/trunk/grobner.lisp

@@ -1074 +1074 @@
         (setf r (scalar-times-poly ring cg r)
               c (funcall (ring-mul ring) c cg)
+              ;; p := cg*p-cp*m*g
               p (grobner-op ring cp cg m p g))))
     (debug-cgb "/"))
@@ -1674 +1675 @@
 J the polynomial W*H belongs to I."
   (cond
-   ((endp g)
-    ;;Id(G) consists of 0 only so W*0=0 belongs to Id(F)
-    (if (every #'poly-zerop f)
-        (error "First ideal must be non-zero.")
-      (list (make-poly
-             (list (make-term
-                    (make-monom (monom-dimension (poly-lm (find-if-not #'poly-zerop f)))
-                                :initial-element 0)
-                    (funcall (ring-unit ring))))))))
-   ((endp (cdr g))
-    (colon-ideal-1 ring f (car g) top-reduction-only))
-   (t
-    (ideal-intersection ring
-                        (colon-ideal-1 ring f (car g) top-reduction-only)
-                        (colon-ideal ring f (rest g) top-reduction-only)
-                        top-reduction-only))))
+    ((endp g)
+     ;;Id(G) consists of 0 only so W*0=0 belongs to Id(F)
+     (if (every #'poly-zerop f)
+         (error "First ideal must be non-zero.")
+         (list (make-poly
+                (list (make-term
+                       (make-monom (monom-dimension (poly-lm (find-if-not #'poly-zerop f)))
+                                   :initial-element 0)
+                       (funcall (ring-unit ring))))))))
+    ((endp (cdr g))
+     (colon-ideal-1 ring f (car g) top-reduction-only))
+    (t
+     (ideal-intersection ring
+                         (colon-ideal-1 ring f (car g) top-reduction-only)
+                         (colon-ideal ring f (rest g) top-reduction-only)
+                         top-reduction-only))))
 
 (defun colon-ideal-1 (ring f g &optional (top-reduction-only $poly_top_reduction_only))
@@ -2048 +2049 @@
        ,@(mapcar #'(lambda (var power) `((mexpt) ,var ,power))
                  vars (monom-exponents (term-monom object)))))
+    ;; Assumes that Lisp and Maxima logicals coincide
+    (:logical object)
     (otherwise
      object)))
@@ -2183 +2186 @@
 
 (defmfun $poly_buchberger_criterion (g vars)
-  (with-parsed-polynomials ((vars) :poly-lists (g))
+  (with-parsed-polynomials ((vars) :poly-lists (g) :value-type :logical)
     (buchberger-criterion *maxima-ring* g)))
 
@@ -2287 +2290 @@
     (ideal-polysaturation *maxima-ring* f ideal-list 0 nil)))
 
+(defmfun $poly_lt (f vars)
+  (with-parsed-polynomials ((vars) :polynomials (f) :value-type :polynomial)
+    (make-poly-from-termlist (list (poly-lt f)))))
+
+(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 *maxima-ring*)))))))
+