Changeset 3918

Timestamp:

2016-05-29T21:24:00-07:00 (8 years ago)

Author:

Marek Rychlik

Message:

* empty log message *

File:

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

branches/f4grobner/pair-queue.lisp

@@ -20 +20 @@
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;;
-;; Critical pair queue implementation
-;;
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-
 (defpackage "PAIR-QUEUE"
   (:use :cl :priority-queue :monom :polynomial :utils)
-  (:export "SUGAR-PAIR-KEY"
-           "PAIR"
+  (:export "PAIR"
            "MAKE-PAIR"
            "PAIR-FIRST"
@@ -35 +28 @@
            "PAIR-SUGAR"
            "PAIR-DIVISION-DATA"
-           "SUGAR-ORDER"
            "*PAIR-KEY-FUNCTION*"
            "*PAIR-ORDER*"
@@ -45 +37 @@
            "PAIR-QUEUE-EMPTY-P"
            "SET-PAIR-HEURISTIC"
-           ))
+           )
+  (:documentation "Critical pair queue implementation. The pair queue is a list of critical
+pairs, ordered by some partial order. Pair queue is a kind of priority queue.")
+  )
            
 
 (in-package :pair-queue)
 
-(defun sugar-pair-key (p q &aux (lcm (universal-lcm (leading-monomial p) (leading-monomial q)))
-                                (d (sugar lcm)))
-  "Returns list (S LCM-TOTAL-DEGREE) where S is the sugar of the S-polynomial of
-polynomials P and Q, and LCM-TOTAL-DEGREE is the degree of LCM(LM(P),LM(Q))."
-  (declare (type poly p q) (type monom lcm) (type fixnum d))
-  (cons (max 
-         (+  (- d (sugar (leading-monomial p))) (sugar p))
-         (+  (- d (sugar (leading-monomial q))) (sugar q)))
-        lcm))
-
 (defstruct (pair
             (:constructor make-pair (first second
                                            &aux
-                                           (sugar (car (sugar-pair-key first second)))
                                            (division-data nil))))
   (first nil :type poly)
   (second nil :type poly)
-  (sugar 0 :type fixnum)
   (division-data nil :type list))
   
-;;(defun pair-sugar (pair &aux (p (pair-first pair)) (q (pair-second pair)))
-;;  (car (sugar-pair-key p q)))
-
-(defun sugar-order (x y)
-  "Pair order based on sugar, ties broken by normal strategy."
-  (declare (type cons x y))
-  (or (< (car x) (car y))
-      (and (= (car x) (car y))
-           (< (total-degree (cdr x))
-              (total-degree (cdr y))))))
-
-(defvar *pair-key-function* #'sugar-pair-key
+(defvar *pair-key-function* nil
   "Function that, given two polynomials as argument, computed the key
 in the pair queue.")
 
-(defvar *pair-order* #'sugar-order
+(defvar *pair-order* nil
   "Function that orders the keys of pairs.")
 
@@ -125 +97 @@
 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)