Changeset 4135 for branches/f4grobner
- Timestamp:
- 2016-06-01T19:50:56-07:00 (9 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/f4grobner/pair-queue.lisp
r4002 r4135 27 27 "CRITICAL-PAIR-QUEUE" 28 28 "SELECTION-STRATEGY" 29 "MIN-TOTAL-DEGREE-STRATEGY" 30 "MIN-COMBINED-LENGTH-STRATEGY" 29 "+NORMAL-STRATEGY+" 30 "+MIN-TOTAL-DEGREE-STRATEGY+" 31 "+MIN-COMBINED-LENGTH-STRATEGY+" 31 32 "MAKE-CRITICAL-PAIR-QUEUE" 32 33 ) … … 58 59 :initarg :pair-order-fn 59 60 :accessor pair-order-fn)) 60 (:documentation "Represents the normal critical pair selection 61 strategy. The two ingredients of a strategy is a function 61 (:documentation "The two ingredients of a strategy is a function 62 62 PAIR-KEY-FUNCTION which computes a key from the critical pair, which 63 63 can be any type of data, and a function PAIR-ORDER-FN used to compaire … … 75 75 pair-key-fn pair-order-fn)))) 76 76 77 (defclass min-total-degree-strategy (selection-strategy) 78 ((pair-key-fn :initform #'(lambda (p q) (total-degree (universal-lcm (leading-monomial p) (leading-monomial q))))) 79 (pair-order-fn :initform #'<)) 80 (:documentation "Make a selection strategy where a pair with a 81 minimum total degree of LCM of leading monomials is selected.")) 77 (defparameter +normal-strategy+ 78 (make-instance 79 'selection-strategy 80 :pair-key-fn #'(lambda (p q) (universal-lcm (leading-monomial p) (leading-monomial q))) 81 :pair-order-fn #'lex>) 82 "The normal selection strategy where a pair with the largest LCM of 83 leading monomials is selected.") 82 84 83 (defclass min-combined-length-strategy (selection-strategy) 84 ((pair-key-fn :initform #'(lambda (p q) (+ (poly-length p) (poly-length q)))) 85 (pair-order-fn :initform #'<)) 86 (:documentation "Make a selection strategy where a pair with the minimum combined length of both 87 polynomials is selected.")) 85 (defparameter +min-total-degree-strategy+ 86 (make-instance 87 'selection-strategy 88 :pair-key-fn #'(lambda (p q) (total-degree (universal-lcm (leading-monomial p) (leading-monomial q)))) 89 :pair-order-fn #'<) 90 "A selection strategy where a pair with a minimum total degree of 91 LCM of leading monomials is selected.") 88 92 89 (defun make-critical-pair-queue (&key pair-key-fn pair-order-fn (poly-list nil) (start 1) 90 &aux (pq (make-instance 'priority-queue 91 :element-type 'critical-pair 92 :element-key #'(lambda (pair) (funcall pair-key-fn 93 (critical-pair-first pair) 94 (critical-pair-second pair))) 95 :test pair-order-fn))) 96 "Makes a priority queue for critical pairs. The argument POLY-LIST should the initial list of polynomials. 97 and START is the first position beyond the elements which form a 98 partial Grobner basis, i.e. satisfy the Buchberger criterion." 99 ;; Add critical pairs for polynomials in POLY-LIST 100 (let* ((s (1- (length poly-list))) 101 (b (nconc (makelist (make-instance 'critical-pair :first (elt poly-list i) :second (elt poly-list j)) 102 (i 0 (1- start)) (j start s)) 103 (makelist (make-instance 'critical-pair :first (elt poly-list i) :second (elt poly-list j)) 104 (i start (1- s)) (j (1+ i) s))))) 105 (dolist (pair b pq) 106 (enqueue pq pair)))) 93 (defparameter +min-combined-length-strategy+ 94 (make-instance 95 'selection-strategy 96 :pair-key-fn #'(lambda (p q) (+ (poly-length p) (poly-length q))) 97 :pair-order-fn #'<) 98 "A selection strategy where a pair with the minimum combined length of both 99 polynomials is selected.") 100 101 (defclass critical-pair-queue (priority-queue) 102 () 103 (:documentation "Implements critical pair priority queue.")) 104 105 (defmethod allocate-instance ((self critical-pair-queue) &key strategy poly-list start) 106 "Allocates a priority queue SELF for critical pairs from strategy SELF." 107 (declare (ignore poly-list start)) 108 (with-slots (pair-key-fn pair-order-fn) 109 strategy 110 (reinitialize-instance self 111 :element-type 'critical-pair 112 :element-key #'(lambda (pair) (funcall pair-key-fn 113 (critical-pair-first pair) 114 (critical-pair-second pair))) 115 :test pair-order-fn))) 116 117 (defgeneric enqueue-critical-pairs (self &optional poly-list start) 118 (:method ((self critical-pair-queue) &optional (poly-list nil) (start 0)) 119 "The argument POLY-LIST should the initial list of 120 polynomials. and START is the first position beyond the elements 121 which form a partial Grobner basis, i.e. satisfy the Buchberger 122 criterion." 123 (let* ((s (1- (length poly-list))) 124 (b (nconc (makelist (make-instance 'critical-pair :first (elt poly-list i) :second (elt poly-list j)) 125 (i 0 (1- start)) (j start s)) 126 (makelist (make-instance 'critical-pair :first (elt poly-list i) :second (elt poly-list j)) 127 (i start (1- s)) (j (1+ i) s))))) 128 (dolist (pair b self) 129 (enqueue self pair))))) 107 130 108 131
Note:
See TracChangeset
for help on using the changeset viewer.