Changeset 4437

Timestamp:

2016-06-10T15:19:03-07:00 (8 years ago)

Author:

Marek Rychlik

Message:

* empty log message *

File:

• branches/f4grobner/5am-division.lisp (modified) (1 diff)

branches/f4grobner/5am-division.lisp

@@ -162 +162 @@
       (is (universal-equalp fl fl-copy)))))
 
-(test buchberger-criterion-full
+(test buchberger-criterion-with-normal-form
+  "Buchberger criterion using normal form"
   (with-fixture buchberger-criterion-context 
       ()
-    (loop 
-       for i from 0 below (length gb)
-       do
-         (loop 
-            for j from (1+ i) below (length gb)
-            do
-              (is (universal-zerop (normal-form (s-polynomial (elt gb i) (elt gb j)) gb))
-                  "Failed with I=~S, J=~S~%" I J)))))
-
-(test buchberger-criterion
-  "Buchberger criterion"
+    (let ((fl-copy (mapcar #'copy-instance fl))
+          (gb-copy (mapcar #'copy-instance gb)))
+      (loop 
+         for i from 0 below (length gb)
+         do
+           (loop 
+              for j from (1+ i) below (length gb)
+              do
+                (is (universal-zerop (normal-form (s-polynomial (elt gb i) (elt gb j)) gb))
+                    "Failed with I=~S, J=~S~%" I J)))
+      (is (universal-equalp fl fl-copy))
+      (is (universal-equalp gb gb-copy)))))
+
+(test buchberger-criterion-with-pseudo-division
+  "Buchberger criterion using pseudo-division"
+  (with-fixture buchberger-criterion-context ()
+    (let ((fl-copy (mapcar #'copy-instance fl))
+          (gb-copy (mapcar #'copy-instance gb)))
+      (loop 
+         for i from 0 below (length gb)
+         do
+           (loop 
+              for j from (1+ i) below (length gb)
+              do
+                (is (universal-zerop (second (multiple-value-list (poly-pseudo-divide (s-polynomial (elt gb i) (elt gb j)) gb))))
+                    "Failed with I=~S, J=~S~%" I J)))
+      (is (universal-equalp fl fl-copy))
+      (is (universal-equalp gb gb-copy)))))
+
+(test buchberger-criterion-with-grobner-tes
+  "Buchberger criterion using grobner-test"
   (with-fixture buchberger-criterion-context ()
     (is-true (grobner-test gb fl))