Changeset 4102 for branches

Timestamp:

2016-06-01T12:33:31-07:00 (8 years ago)

Author:

Marek Rychlik

Message:

* empty log message *

File:

• branches/f4grobner/division.lisp (modified) (5 diffs)

branches/f4grobner/division.lisp

@@ -118 +118 @@
         ((cond
            ((endp fl)                           ;no division occurred
+            (setf r (add-to r (leading-term p)) ;move lt(p) to remainder
+                  p (subtract-from p (leading-term p))) ;remove lt(p) from p
             t)
            ((divides-p (leading-monomial (car fl)) (leading-monomial p)) ;division occurred
@@ -127 +129 @@
                 ;; Multiply the equation c*f=sum ai*fi+r+p by c1.
                 (mapl #'(lambda (x)
-                          (setf (car x) (multiply (car x) c1)))
+                          (setf (car x) (multiply-by (car x) c1)))
                       a)
                 (setf r (multiply r c1)
@@ -175 +177 @@
     (debug-cgb "/"))
    (t                                                   ;no division possible
-    (push (leading-term p) (poly-termlist r))           ;move lt(p) to remainder
-    ;;(setf (poly-sugar r) (max (poly-sugar r) (term-sugar (poly-lt p))))
-    (pop (poly-termlist p))                             ;remove lt(p) from p
+    (setf r (add-to r (leading-term p))) ;move lt(p) to remainder
+    (setf p (subtract-from p (leading-term p))) ;move lt(p) to remainder
     (debug-cgb "+")))
   (values p r c division-count))
@@ -209 +210 @@
       (normal-form-step fl f r c division-count))))
 
-(defun spoly (f g)
-  "It yields the S-polynomial of polynomials F and G."
-  (declare (type poly f g))
-  (let* ((lcm (universal-lcm (leading-monomial f) (leading-monomial g)))
-          (mf (divide lcm (leading-monomial f)))
-          (mg (divide lcm (leading-monomial g))))
-    (declare (type monom mf mg))
-    (multiple-value-bind (c cf cg)
-        (universal-ezgcd (leading-coefficient f) (leading-coefficient g))
-      (declare (ignore c))
-      (subtract
-       (multiply (multiply mf f) cg)
-       (multiply (multiply mg g) cf)))))
-
 (defun buchberger-criterion (g)
   "Returns T if G is a Grobner basis, by using the Buchberger
@@ -228 +215 @@
 S(h1,h2) reduces to 0 modulo G."
   (every #'universal-zerop
-         (makelist (normal-form (spoly (elt g i) (elt g j)) g nil)
+         (makelist (normal-form (s-polynomial (elt g i) (elt g j)) g nil)
                    (i 0 (- (length g) 2))
                    (j (1+ i) (1- (length g))))))