Changeset 4135 for branches/f4grobner

Timestamp:

2016-06-01T19:50:56-07:00 (8 years ago)

Author:

Marek Rychlik

Message:

* empty log message *

File:

• branches/f4grobner/pair-queue.lisp (modified) (3 diffs)

branches/f4grobner/pair-queue.lisp

@@ -27 +27 @@
            "CRITICAL-PAIR-QUEUE"
            "SELECTION-STRATEGY"
-           "MIN-TOTAL-DEGREE-STRATEGY"
-           "MIN-COMBINED-LENGTH-STRATEGY"
+           "+NORMAL-STRATEGY+"
+           "+MIN-TOTAL-DEGREE-STRATEGY+"
+           "+MIN-COMBINED-LENGTH-STRATEGY+"
            "MAKE-CRITICAL-PAIR-QUEUE"
            )
@@ -58 +59 @@
                   :initarg :pair-order-fn 
                   :accessor pair-order-fn))
-  (:documentation "Represents the normal critical pair selection
-strategy.  The two ingredients of a strategy is a function
+  (:documentation "The two ingredients of a strategy is a function
 PAIR-KEY-FUNCTION which computes a key from the critical pair, which
 can be any type of data, and a function PAIR-ORDER-FN used to compaire
@@ -75 +75 @@
               pair-key-fn pair-order-fn))))
 
-(defclass min-total-degree-strategy (selection-strategy)
-  ((pair-key-fn :initform #'(lambda (p q) (total-degree (universal-lcm (leading-monomial p) (leading-monomial q)))))
-   (pair-order-fn :initform #'<))
-  (:documentation "Make a selection strategy where a pair with a
-minimum total degree of LCM of leading monomials is selected."))
+(defparameter +normal-strategy+
+  (make-instance 
+   'selection-strategy
+   :pair-key-fn #'(lambda (p q) (universal-lcm (leading-monomial p) (leading-monomial q)))
+   :pair-order-fn #'lex>)
+  "The normal selection strategy where a pair with the largest LCM of
+leading monomials is selected.")
 
-(defclass min-combined-length-strategy (selection-strategy)
-  ((pair-key-fn :initform #'(lambda (p q) (+ (poly-length p) (poly-length q))))
-   (pair-order-fn :initform #'<))
-  (:documentation "Make a selection strategy where a pair with the minimum combined length of both
-polynomials is selected."))
+(defparameter +min-total-degree-strategy+
+  (make-instance 
+   'selection-strategy
+   :pair-key-fn #'(lambda (p q) (total-degree (universal-lcm (leading-monomial p) (leading-monomial q))))
+   :pair-order-fn #'<)
+  "A selection strategy where a pair with a minimum total degree of
+  LCM of leading monomials is selected.")
 
-(defun make-critical-pair-queue (&key pair-key-fn pair-order-fn (poly-list nil) (start 1)
-                                 &aux (pq (make-instance '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."
-    ;; 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 pq)
-      (enqueue pq pair))))
+(defparameter +min-combined-length-strategy+
+  (make-instance
+   'selection-strategy
+   :pair-key-fn #'(lambda (p q) (+ (poly-length p) (poly-length q)))
+   :pair-order-fn #'<)
+  "A selection strategy where a pair with the minimum combined length of both
+polynomials is selected.")
+
+(defclass critical-pair-queue (priority-queue) 
+  ()
+  (:documentation "Implements critical pair priority queue."))
+
+(defmethod allocate-instance ((self critical-pair-queue) &key strategy poly-list start)
+  "Allocates a priority queue SELF for critical pairs from strategy SELF."
+  (declare (ignore poly-list start))
+  (with-slots (pair-key-fn pair-order-fn)
+      strategy
+    (reinitialize-instance self
+                           :element-type 'critical-pair
+                           :element-key #'(lambda (pair) (funcall pair-key-fn 
+                                                                  (critical-pair-first pair)
+                                                                  (critical-pair-second pair)))
+                           :test pair-order-fn)))
+
+(defgeneric enqueue-critical-pairs (self &optional poly-list start)
+  (:method ((self critical-pair-queue) &optional (poly-list nil) (start 0))
+    "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."
+    (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 self)
+        (enqueue self pair)))))