Changeset 3974 for branches

Timestamp:

2016-05-30T17:28:04-07:00 (9 years ago)

Author:

Marek Rychlik

Message:

* empty log message *

File:

• branches/f4grobner/pair-queue.lisp (modified) (1 diff)

branches/f4grobner/pair-queue.lisp

@@ -90 +90 @@
 polynomials is selected."))
 
-(defclass critical-pair-queue (selection-strategy)
-  ((pq :initform nil :initarg :pq :accessor pq :type priority-queue))
-  (:documentation "Represents the priority queue of critical pairs. It is a subclass
-of SELECTION-STRATEGY."))
-
-(defmethod initialize-instance :after ((self critical-pair-queue) &key (poly-list nil) (start 1))
-  "Initializes the priority queue SELF of critical pairs, where POLY-LIST is the initial list of polynomials.
+(defun make-critical-pair-queue (&key pair-key-fn pair-order-fn (poly-list nil) (start 1)
+                                 &aux (pq (make-priority-queue
+                                           :element-type 'critical-pair
+                                           :element-key #'(lambda (pair) (funcall pair-key-fn 
+                                                                                  (critical-pair-first pair)
+                                                                                  (critical-pair-second pair)))
+                                           :test pair-order-fn)))
+  "Makes a priority queue for critical pairs. The argument POLY-LIST should the initial list of polynomials.
 and START is the first position beyond the elements which form a
 partial Grobner basis, i.e. satisfy the Buchberger criterion."
-  (with-accessors ((pair-key-fn pair-key-fn)
-                   (pair-order-fn pair-order-fn)
-                   (pq pq))
-      self
-    (setf pq (make-priority-queue
-                :element-type 'critical-pair
-                :element-key #'(lambda (pair) (funcall pair-key-fn (critical-pair-first pair) (critical-pair-second pair)))
-                :test pair-order-fn))
     ;; Add critical pairs for polynomials in POLY-LIST
-    (let* ((s (1- (length poly-list)))
-           (b (nconc (makelist (make-instance 'critical-pair :first (elt poly-list i) :second (elt poly-list j))
-                               (i 0 (1- start)) (j start s))
-                     (makelist (make-instance 'critical-pair :first (elt poly-list i) :second (elt poly-list j))
-                               (i start (1- s)) (j (1+ i) s)))))
-      (dolist (pair b)
-        (priority-queue-insert pq pair)))))
+  (let* ((s (1- (length poly-list)))
+         (b (nconc (makelist (make-instance 'critical-pair :first (elt poly-list i) :second (elt poly-list j))
+                             (i 0 (1- start)) (j start s))
+                   (makelist (make-instance 'critical-pair :first (elt poly-list i) :second (elt poly-list j))
+                             (i start (1- s)) (j (1+ i) s)))))
+    (dolist (pair b pq)
+      (priority-queue-insert pq pair)))))
 
-(defmethod print-object ((self critical-pair-queue) stream)
-  (print-unreadable-object (self stream :type t :identity t)
-    (with-accessors ((pair-key-fn pair-key-fn)
-                     (pair-order-fn pair-order-fn)
-                     (pq pq))
-        self
-      (format stream "PAIR-KEY-FN=~A PAIR-ORDER-FN=~A PQ=~A" 
-              pair-key-fn pair-order-fn pq))))
 
-(defgeneric enqueue (self object)
-  (:documentation "Insert an object OBJECT into a queue SELF.")
-  (:method ((self critical-pair-queue) (pair critical-pair))
-    (with-slots (pq)
-        self
-      (priority-queue-insert pq pair))))
-
-(defgeneric dequeue (self) 
-  (:documentation "Remove an object from a queue SELF. Returns the removed object.")
-  (:method ((self critical-pair-queue))
-    (with-slots (pq)
-        self
-      (priority-queue-remove pq))))
-
-(defgeneric queue-size (self) 
-  (:documentation "Returns the number of elements in the queue SELF.")
-  (:method ((self critical-pair-queue))
-    (with-slots (pq)
-        self
-      (priority-queue-size pq))))
-
-(defgeneric queue-empty-p (self)
-  (:documentation "Returns T if the queue SELF is empty, NIL otherwise.")
-  (:method ((self critical-pair-queue))
-    (with-slots (pq)
-        self
-      (priority-queue-empty-p pq))))
-