Changeset 162 for branches/f4grobner

Timestamp:

2015-06-05T13:39:08-07:00 (10 years ago)

Author:

Marek Rychlik

Message:

* empty log message *

File:

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

branches/f4grobner/pair-queue.lisp

@@ -98 +98 @@
 (defun pair-queue-empty-p (b)
   (priority-queue-empty-p b))
+
+(defun set-pair-heuristic (method)
+  "Sets up variables *PAIR-KEY-FUNCTION* and *PAIR-ORDER* used
+to determine the priority of critical pairs in the priority queue."
+  (ecase method
+    ((sugar :sugar $sugar)
+     (setf *pair-key-function* #'sugar-pair-key
+           *pair-order* #'sugar-order))
+;     ((minimal-mock-spoly :minimal-mock-spoly $minimal_mock_spoly)
+;      (setf *pair-key-function* #'mock-spoly
+;          *pair-order* #'mock-spoly-order))
+    ((minimal-lcm :minimal-lcm $minimal_lcm)
+     (setf *pair-key-function* #'(lambda (p q)
+                                   (monom-lcm (poly-lm p) (poly-lm q)))
+           *pair-order* #'reverse-monomial-order))
+    ((minimal-total-degree :minimal-total-degree $minimal_total_degree)
+     (setf *pair-key-function* #'(lambda (p q)
+                                   (monom-total-degree
+                                    (monom-lcm (poly-lm p) (poly-lm q))))
+           *pair-order* #'<))
+    ((minimal-length :minimal-length $minimal_length)
+     (setf *pair-key-function* #'(lambda (p q)
+                                   (+ (poly-length p) (poly-length q)))
+           *pair-order* #'<))))
+