Changeset 3932 for branches

Timestamp:

2016-05-29T23:30:31-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

@@ -54 +54 @@
 
 (defclass selection-strategy ()
-  ((pair-key-fn   :initform nil :initarg :pair-key-fn :accessor pair-key-fn)
-   (pair-order-fn :initform nil :initarg :pair-order-fn :accessor pair-order-fn))
+  ((pair-key-fn   :initform (error "Must specify PAIR-KEY-FN") :initarg :pair-key-fn :accessor pair-key-fn)
+   (pair-order-fn :initform (error "Must specify PAIR-ORDER-FN") :initarg :pair-order-fn :accessor pair-order-fn))
   (:documentation "Represents a critical pair selection strategy.  The
 two ingredients of a strategy is a function PAIR-KEY-FUNCTION which
@@ -62 +62 @@
 determine which pair is more promising and should be considered first."))
 
-(defclass critical-pair-queue (selection-strategy)
+(defmethod print-object ((self selection-strategy) stream)
+  (print-unreadable-object (self stream :type t :identity t)
+    (with-accessors ((pair-key-fn pair-key-fn)
+                     (pair-order-fn pair-order-fn))
+        self
+      (format stream "PAIR-KEY-FN=~A PAIR-ORDER-FN=~A" 
+              pair-key-fn pair-order-fn))))
+
+(defclass normal-selection-strategy (selection-strategy) 
+  ((pair-key-fn :initform #'(lambda (p q) (universal-lcm (leading-monomial p) (leading-monomial q))))
+   (pair-order-fn :initform #'lex>))
+  (:documentation "The normal selection strategy for a given monomial order MONOMIAL-ORDER-FN. A pair
+with the minimal LCM of leading monomials is selected."))
+
+
+(defclass critical-pair-queue ()
   ((pq :initform (make-priority-queue
                   :element-type 'critical-pair
@@ -95 +110 @@
 
 
-(defun make-normal-strategy (monomial-order-fn)
-  "Make a normal selection strategy for a given monomial order MONOMIAL-ORDER-FN. A pair
-with the minimal LCM of leading monomials is selected."
-  (make-instance 'selection-strategy
-                 :pair-key-fn #'(lambda (p q) (universal-lcm (leading-monomial p) (leading-monomial q)))
-                 :pair-order-fn monomial-order-fn))
 
 (defun make-min-total-degree-strategy ()