Changeset 1543 for branches

Timestamp:

2015-06-12T15:30:53-07:00 (10 years ago)

Author:

Marek Rychlik

Message:

* empty log message *

File:

• branches/f4grobner/gb-postprocessing.lisp (modified) (1 diff)

branches/f4grobner/gb-postprocessing.lisp

@@ -42 +42 @@
   (declare (type ring-and-order ring-and-order))
   (do ((q plist)
-       (found t))
+       (found t)
+       p)
       ((not found)
        (mapcar #'(lambda (x) (poly-primitive-part ring x)) q))
-    ;;Find p in Q such that p is reducible mod Q\{p}
+    ;; 1) Find p in Q such that p is reducible mod Q\{p}
+    ;; 2) Replace p with remainder from division by Q\{p}, if
+    ;;    non-zero, else set Q to Q\{p}
     (setf found nil)
-    (let ((x (find-if
-              #'(lambda (y)
-                  (multiple-value-bind (h c div-count)
-                      (normal-form ring-and-order 
-                                   y 
-                                   (remove y q)
-                                   nil #| not a top reduction! |# 
-                                   )
-                    (declare (ignore h c))
-                    (plusp div-count))))))
-      (when x
-        (setf found t
-              q (delete x q))))))
+    (dolist (x q)
+      (multiple-value-bind (h c div-count)
+          (normal-form ring-and-order x (remove x q) nil #| not a top reduction! |#)
+        (declare (ignore c))
+        (when (plusp div-count)
+          (setf found t
+                p h)
+          (return))))
+    (when found
+      (if (poly-zerop p)
+          (setf q q1)
+          (setf q (cons p q1))))))
+
 
 (defun minimization (plist)