Changeset 4177 for branches

Timestamp:

2016-06-03T11:14:45-07:00 (9 years ago)

Author:

Marek Rychlik

Message:

* empty log message *

File:

• branches/f4grobner/5am-criterion.lisp (modified) (2 diffs)

branches/f4grobner/5am-criterion.lisp

@@ -88 +88 @@
                                    :first p1 
                                    :second p2))
-         (b-done (make-hash-table))
+         (b-done (make-hash-table))     ;TODO: make meaningful B-DONE table
          (partial-basis nil))
     (&body)))
@@ -97 +97 @@
     (is-false (criterion-2 pair b-done partial-basis))))
 
+(def-fixture criterion-2-success-context () 
+  (let* ((f (string->poly "x^2+2*y" '(x y z)))
+         (g (string->poly "y*z + z^2" '(x y z)))
+         (h (string->poly "x^2*y*z" '(x y z)))
+         (pair (make-instance 'critical-pair :first f :second g))
+         (b-done (make-hash-table :test #'equal)) ;TODO: make meaningful B-DONE table
+         (partial-basis (list h)))
+    (setf (gethash (list f h) b-done) t
+          (gethash (list h f) b-done) t
+          (gethash (list h g) b-done) t
+          (gethash (list g h) b-done) t)
+    (maphash #'(lambda (key value) 
+                 (declare (ignore value)) 
+                 (print (mapcar #'->sexp key)))
+             b-done)
+    (&body)))
+
+(test criterion-2-success
+  "Second Buchberger criterion success"
+  (with-fixture criterion-2-success-context ()
+    (is-true (criterion-2 pair b-done partial-basis))))
+
 
 (run! 'criterion-suite)