Changeset 4170 for branches

Timestamp:

2016-06-03T02:03:26-07:00 (8 years ago)

Author:

Marek Rychlik

Message:

Moved files infix-errors* to junk

Location:

branches/f4grobner

Files:

• .junk/infix-errors.lisp (moved) (moved from branches/f4grobner/infix-errors.lisp )
• .junk/infix-errors.txt.orig (moved) (moved from branches/f4grobner/infix-errors.txt.orig )
• buchberger.lisp (modified) (5 diffs)
• pair-queue.lisp (modified) (2 diffs)
• test0.lisp (added)

branches/f4grobner/buchberger.lisp

@@ -75 +75 @@
                 nil)
                (t
-                (setf sp (poly-primitive-part ring sp)
+                (setf sp (poly-primitive-part sp)
                       f (nconc f (list sp)))
                 ;; Add new critical pairs
@@ -86 +86 @@
               t)))))
 
-(defun parallel-buchberger (ring-and-order f 
+(defun parallel-buchberger (f 
                             &optional 
                               (start 0)
-                              (top-reduction-only $poly_top_reduction_only)
-                            &aux
-                              (ring (ro-ring ring-and-order)))
+                              (top-reduction-only $poly_top_reduction_only))
   "An implementation of the Buchberger algorithm. Return Grobner basis
 of the ideal generated by the polynomial list F.  Polynomials 0 to
@@ -97 +95 @@
 critical pairs will not be examined. If TOP-REDUCTION-ONLY set, top
 reduction will be preformed."
-  (declare (type ring-and-order ring-and-order)
-           (ignore top-reduction-only)
+  (declare (ignore top-reduction-only)
            (type fixnum start))
   (when (endp f) (return-from parallel-buchberger f)) ;cut startup costs
@@ -104 +101 @@
   (when (plusp start) (debug-cgb "~&INCREMENTAL:~d done" start))
   #+grobner-check  (when (plusp start)
-                     (grobner-test ring-and-order (subseq f 0 start) (subseq f 0 start)))
+                     (grobner-test (subseq f 0 start) (subseq f 0 start)))
   ;;Initialize critical pairs
   (let ((b (pair-queue-initialize (make-pair-queue) f start))
@@ -116 +113 @@
     (do ()
         ((pair-queue-empty-p b)
-         #+grobner-check(grobner-test ring-and-order f f)
+         #+grobner-check(grobner-test f f)
          (debug-cgb "~&GROBNER END")
          f)
       (let ((pair (pair-queue-remove b)))
         (when (null (pair-division-data pair))
-          (setf (pair-division-data pair) (list (spoly ring-and-order
+          (setf (pair-division-data pair) (list (s-polynomial
                                                        (pair-first pair)
                                                        (pair-second pair))

branches/f4grobner/pair-queue.lisp

@@ -125 +125 @@
                    (i start (1- s)) (j (1+ i) s))))
 
-(defgeneric enqueue-critical-pairs (self pair-lst)
+(defgeneric enqueue-critical-pairs (self pair-lst) 
+  (:documentation "Place pairs in PAIR-LST on the queue SELF.")
   (:method ((self critical-pair-queue) pair-lst)
+    "Enqueue into queue QUEUE the elements of the list PAIR-LST."
     (dolist (pair pair-lst self)
       (enqueue self pair))))
-
 
 (defgeneric make-critical-pair-queue (object &optional poly-lst start)
@@ -136 +137 @@
     (with-slots (pair-key-fn pair-order-fn)
         object
-      (make-instance 'critical-pair-queue
-                     :element-key #'(lambda (pair)
-                                      (funcall pair-key-fn 
-                                               (critical-pair-first pair)
-                                               (critical-pair-second pair)))
-                     :test pair-order-fn))))
+      (let ((queue (make-instance 'critical-pair-queue
+                                  :element-key #'(lambda (pair)
+                                                   (funcall pair-key-fn 
+                                                            (critical-pair-first pair)
+                                                            (critical-pair-second pair)))
+                                  :test pair-order-fn)))
+           (enqueue-critical-pairs queue (make-critical-pairs poly-lst start))))))