Changeset 4051 for branches/f4grobner

Timestamp:

2016-05-31T17:52:08-07:00 (8 years ago)

Author:

Marek Rychlik

Message:

* empty log message *

File:

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

branches/f4grobner/division.lisp

@@ -48 +48 @@
   "Returns C2*F-C1*M*G, where F and G are polynomials M is a monomial.
 Assume that the leading terms will cancel."
-  (declare (type ring-and-order ring-and-order)
-           (type monom m)
+  (declare (type monom m)
            (type poly f g))
   #+grobner-check(universal-zerop
@@ -171 +170 @@
                          &aux 
                            (g (find (leading-monomial p) fl
-                                    :test #'monom-divisible-by-p
+                                    :test #'divisible-by-p
                                     :key #'leading-monomial)))
   (cond
@@ -221 +220 @@
       (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))
+      (poly-sub 
+       ring
+       (scalar-times-poly ring cg (monom-times-poly mf f))
+       (scalar-times-poly ring cf (monom-times-poly mg g))))))
+
 (defun buchberger-criterion (g)
   "Returns T if G is a Grobner basis, by using the Buchberger
 criterion: for every two polynomials h1 and h2 in G the S-polynomial
 S(h1,h2) reduces to 0 modulo G."
-  (every #'poly-zerop
-         (makelist (normal-form ring-and-order (spoly ring-and-order (elt g i) (elt g j)) g nil)
+  (every #'universal-zerop
+         (makelist (normal-form (spoly (elt g i) (elt g j)) g nil)
                    (i 0 (- (length g) 2))
                    (j (1+ i) (1- (length g))))))
 
 
-(defun poly-normalize (ring p &aux (c (poly-lc p)))
+(defun poly-normalize (p &aux (c (leading-coefficient p)))
   "Divide a polynomial by its leading coefficient. It assumes
 that the division is possible, which may not always be the
@@ -237 +251 @@
 is assumed to be provided by the RING structure."
   (mapc #'(lambda (term)
-            (setf (term-coeff term) (funcall (ring-div ring) (term-coeff term) c)))
+            (setf (term-coeff term) (divide (term-coeff term) c)))
         (poly-termlist p))
   p)
 
-(defun poly-normalize-list (ring plist)
+(defun poly-normalize-list (plist)
   "Divide every polynomial in a list PLIST by its leading coefficient. "
-  (mapcar #'(lambda (x) (poly-normalize ring x)) plist))
+  (mapcar #'(lambda (x) (poly-normalize x)) plist))
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
@@ -254 +268 @@
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
-(defun grobner-test (ring-and-order g f)
+(defun grobner-test (g f)
   "Test whether G is a Grobner basis and F is contained in G. Return T
 upon success and NIL otherwise."
   (debug-cgb "~&GROBNER CHECK: ")
   (let (($poly_grobner_debug nil)
-        (stat1 (buchberger-criterion ring-and-order g))
+        (stat1 (buchberger-criterion g))
         (stat2
-          (every #'poly-zerop
-                 (makelist (normal-form ring-and-order (copy-tree (elt f i)) g nil)
+          (every #'universal-zerop
+                 (makelist (normal-form (copy-tree (elt f i)) g nil)
                            (i 0 (1- (length f)))))))
     (unless stat1 (error "~&Buchberger criterion failed, not a grobner basis: ~A" g))