Changeset 4312
- Timestamp:
- 2016-06-04T22:56:30-07:00 (9 years ago)
- Location:
- branches/f4grobner
- Files:
-
- 7 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/f4grobner/5am-buchberger.lisp
r4201 r4312 78 78 (is-true (grobner-test gb fl)) 79 79 (is (every #'universal-equalp (buchberger fl) gb)) 80 (is (every #'universal-equalp (parallel-buchberger fl) gb))80 ;;(is (every #'universal-equalp (parallel-buchberger fl) gb)) 81 81 ) 82 82 ) … … 121 121 (with-fixture buchberger-advanced-context () 122 122 (is-true (grobner-test gb fl)) 123 ;;(is (every #'universal-equalp (buchberger fl) gb))123 (is (every #'universal-equalp (buchberger fl) gb)) 124 124 ;;(is (every #'universal-equalp (parallel-buchberger fl) gb)) 125 125 )) -
branches/f4grobner/5am-criterion.lisp
r4179 r4312 103 103 (pair (make-instance 'critical-pair :first f :second g)) 104 104 (b-done (make-hash-table :test #'equal)) 105 (partial-basis (list h)))105 (partial-basis (list f g h))) 106 106 ;; Initialize the lookup table of done pairs 107 (setf (gethash (list h f) b-done) t 108 (gethash (list h g) b-done) t) 107 (setf ;;(gethash (list h f) b-done) t 108 (gethash (list f h) b-done) t 109 ;;(gethash (list h g) b-done) t 110 (gethash (list g h) b-done) t 111 ) 109 112 (&body))) 110 113 -
branches/f4grobner/5am-division.lisp
r4213 r4312 44 44 (require :utils "utils") 45 45 (require :copy "copy") 46 (require :ring "ring") 47 (require :integer-ring "integer-ring") 46 48 (require :monom "monom") 47 49 (require :polynomial "polynomial") … … 51 53 52 54 (defpackage #:5am-division 53 (:use :cl :it.bese.fiveam :monom :polynomial :infix :symbolic-polynomial :division ))55 (:use :cl :it.bese.fiveam :monom :polynomial :infix :symbolic-polynomial :division :integer-ring)) 54 56 55 57 (in-package :5am-division) … … 73 75 (y-sq (string->poly "y^2" '(x y))) 74 76 (fl (cdr (string->poly "[x+y,x-2*y]" '(x y)))) 75 (quotients (cdr (string->poly "[x-y,0]" '(x y))))) 77 (quotients (cdr (string->poly "[x-y,0]" '(x y)))) 78 (one (make-instance 'integer-ring :value 1))) 76 79 (&body))) 77 80 … … 79 82 "Normal form" 80 83 (with-fixture division-context () 81 (is (universal-equalp (multiple-value-list (normal-form f fl)) (list y-sq 1 2))) 82 (is (universal-equalp (multiple-value-list (poly-pseudo-divide f fl)) 83 (list quotients y-sq 1 2))) 84 (is-false (buchberger-criterion fl)))) 84 (is (universal-equalp (multiple-value-list (normal-form f fl)) (list y-sq one 2))) 85 (is (universal-equalp (multiple-value-list (poly-pseudo-divide f fl)) (list quotients y-sq one 2))) 86 (is-false (buchberger-criterion fl)) 87 ) 88 ) 85 89 86 90 (test normal-form-easy -
branches/f4grobner/copy.lisp
r4223 r4312 38 38 ;; NOTE: This is a shallow copy. Add an around method for classes which need deep copy of the slots. 39 39 (defgeneric copy-instance (object &rest initargs &key &allow-other-keys) 40 (:method ((object number) &rest initargs &key &allow-other-keys)41 (declare (ignore initargs))42 object)43 (:method ((object cons) &rest initargs &key &allow-other-keys)44 (declare (ignore initargs))45 (copy-seq object))46 40 (:documentation "Makes and returns a shallow copy of OBJECT. 47 48 41 An uninitialized object of the same class as OBJECT is allocated by 49 42 calling ALLOCATE-INSTANCE. For all slots returned by -
branches/f4grobner/criterion.lisp
r4180 r4312 30 30 (in-package :criterion) 31 31 32 (proclaim '(optimize (speed 3) (space 0) (safety 0) (debug 0)))32 ;;(proclaim '(optimize (speed 3) (space 0) (safety 0) (debug 0))) 33 33 34 34 (defgeneric criterion-1 (pair) … … 61 61 ;; appear in the hash table B-done 62 62 (dolist (h partial-basis nil) 63 (format t "Considering H:~S~%" h)64 63 (cond 65 64 ((eq h f) … … 79 78 ((:before :in-the-middle) (list h g)) 80 79 (:after (list g h))) 81 b-done)) 80 b-done) 81 ) 82 82 (debug-cgb ":2") 83 83 (return-from criterion-2 t)))))) -
branches/f4grobner/integer-ring.lisp
r4304 r4312 57 57 (1 self) 58 58 (-1 self) 59 ( otherwise59 (t 60 60 (unary-inverse (change-class self 'rational-field)))))) 61 61 -
branches/f4grobner/pair-queue.lisp
r4190 r4312 25 25 "CRITICAL-PAIR-FIRST" 26 26 "CRITICAL-PAIR-SECOND" 27 "CRITICAL-PAIR-DATA" 27 28 "CRITICAL-PAIR-QUEUE" 28 29 "SELECTION-STRATEGY" … … 42 43 ((first :initform nil :initarg :first :accessor critical-pair-first :type poly) 43 44 (second :initform nil :initarg :second :accessor critical-pair-second :type poly) 44 (data :initform nil :accessor critical-pair-d ivision-data))45 (data :initform nil :accessor critical-pair-data)) 45 46 (:documentation "Represents a critical pair, i.e. a pair of two 46 47 polynomials. The derived classes may add extra data used in computing
Note:
See TracChangeset
for help on using the changeset viewer.