Changeset 4170
- Timestamp:
- 2016-06-03T02:03:26-07:00 (9 years ago)
- Location:
- branches/f4grobner
- Files:
-
- 1 added
- 2 edited
- 2 moved
Legend:
- Unmodified
- Added
- Removed
-
branches/f4grobner/buchberger.lisp
r4132 r4170 75 75 nil) 76 76 (t 77 (setf sp (poly-primitive-part ringsp)77 (setf sp (poly-primitive-part sp) 78 78 f (nconc f (list sp))) 79 79 ;; Add new critical pairs … … 86 86 t))))) 87 87 88 (defun parallel-buchberger ( ring-and-orderf88 (defun parallel-buchberger (f 89 89 &optional 90 90 (start 0) 91 (top-reduction-only $poly_top_reduction_only) 92 &aux 93 (ring (ro-ring ring-and-order))) 91 (top-reduction-only $poly_top_reduction_only)) 94 92 "An implementation of the Buchberger algorithm. Return Grobner basis 95 93 of the ideal generated by the polynomial list F. Polynomials 0 to … … 97 95 critical pairs will not be examined. If TOP-REDUCTION-ONLY set, top 98 96 reduction will be preformed." 99 (declare (type ring-and-order ring-and-order) 100 (ignore top-reduction-only) 97 (declare (ignore top-reduction-only) 101 98 (type fixnum start)) 102 99 (when (endp f) (return-from parallel-buchberger f)) ;cut startup costs … … 104 101 (when (plusp start) (debug-cgb "~&INCREMENTAL:~d done" start)) 105 102 #+grobner-check (when (plusp start) 106 (grobner-test ring-and-order(subseq f 0 start) (subseq f 0 start)))103 (grobner-test (subseq f 0 start) (subseq f 0 start))) 107 104 ;;Initialize critical pairs 108 105 (let ((b (pair-queue-initialize (make-pair-queue) f start)) … … 116 113 (do () 117 114 ((pair-queue-empty-p b) 118 #+grobner-check(grobner-test ring-and-orderf f)115 #+grobner-check(grobner-test f f) 119 116 (debug-cgb "~&GROBNER END") 120 117 f) 121 118 (let ((pair (pair-queue-remove b))) 122 119 (when (null (pair-division-data pair)) 123 (setf (pair-division-data pair) (list (s poly ring-and-order120 (setf (pair-division-data pair) (list (s-polynomial 124 121 (pair-first pair) 125 122 (pair-second pair)) -
branches/f4grobner/pair-queue.lisp
r4162 r4170 125 125 (i start (1- s)) (j (1+ i) s)))) 126 126 127 (defgeneric enqueue-critical-pairs (self pair-lst) 127 (defgeneric enqueue-critical-pairs (self pair-lst) 128 (:documentation "Place pairs in PAIR-LST on the queue SELF.") 128 129 (:method ((self critical-pair-queue) pair-lst) 130 "Enqueue into queue QUEUE the elements of the list PAIR-LST." 129 131 (dolist (pair pair-lst self) 130 132 (enqueue self pair)))) 131 132 133 133 134 (defgeneric make-critical-pair-queue (object &optional poly-lst start) … … 136 137 (with-slots (pair-key-fn pair-order-fn) 137 138 object 138 (make-instance 'critical-pair-queue 139 :element-key #'(lambda (pair) 140 (funcall pair-key-fn 141 (critical-pair-first pair) 142 (critical-pair-second pair))) 143 :test pair-order-fn)))) 139 (let ((queue (make-instance 'critical-pair-queue 140 :element-key #'(lambda (pair) 141 (funcall pair-key-fn 142 (critical-pair-first pair) 143 (critical-pair-second pair))) 144 :test pair-order-fn))) 145 (enqueue-critical-pairs queue (make-critical-pairs poly-lst start)))))) 144 146
Note:
See TracChangeset
for help on using the changeset viewer.