Changeset 3461 for branches/f4grobner/5am-monom.lisp
- Timestamp:
- 2015-09-05T09:48:11-07:00 (9 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/f4grobner/5am-monom.lisp
r3320 r3461 38 38 (ql:quickload :fiveam) 39 39 40 (require :ring "ring")41 40 (require :monom "monom") 42 (require :term "term") 43 (require :order "order") 41 (require :term "copy") 44 42 45 43 (defpackage #:5am-monom … … 98 96 (is (r-equalp (divide-by n m) n/m)))) 99 97 100 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;101 ;;102 ;; TERM class tests103 ;;104 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;105 106 (def-fixture term-context ()107 (symbol-macrolet108 ((z (make-instance 'term :dimension 3 :coeff 5))109 (m (make-instance 'term :dimension 3 :exponents '(1 2 3) :coeff 6))110 (n (make-instance 'term :dimension 3 :exponents '(4 5 6) :coeff 12))111 (m*n (make-instance 'term :dimension 3 :exponents '(5 7 9) :coeff 72))112 (n/m (make-instance 'term :dimension 3 :exponents '(3 3 3) :coeff 2))113 (m-tensor-n (make-instance 'term :exponents '(1 2 3 4 5 6) :coeff 72))114 (m-uminus (make-instance 'term :dimension 3 :exponents '(1 2 3) :coeff -6)))115 (&body)))116 117 (test term-basics118 "Term basics"119 (with-fixture term-context ()120 (is (= (r-dimension m) 3))121 (is (= (r-elt m 2) 3))122 (is (= (r-total-degree m) 6))123 (is (= (r-sugar m) 6))124 (is (equalp (r->list z) '(0 0 0)) "Trivial term is a vector of 0's")125 (is (r-equalp (r* m n) m*n))126 (is (r-equalp (r/ n m) n/m))127 (is (r-equalp (right-tensor-product-by m n) m-tensor-n))128 (signals129 (error "EXPONENTS must have length DIMENSION")130 (make-instance 'term :dimension 3 :exponents '(1 2 3 4 5 6) :coeff 77))131 (is-true (r-divides-p m n))132 (is-false (r-divides-p n m))133 (is (r-equalp (r-gcd m n) m))134 (is (r-equalp (r-lcm m n) n))135 (is-true (r-depends-p m 0))136 (signals137 (error "Index out of bounds")138 (r-depends-p m 3))139 )140 (with-fixture term-context ()141 (is (r-equalp (multiply-by m n) m*n)))142 (with-fixture term-context ()143 (is (r-equalp (divide-by n m) n/m)))144 (with-fixture term-context ()145 (is (r-equalp (unary-minus m) m-uminus))))146 147 148 (def-fixture monom/term-conversion-context ()149 (symbol-macrolet150 ((term (make-instance 'term :exponents '(1 2 3) :coeff 4))151 (monom (make-instance 'monom :exponents '(1 2 3)))152 (promoted-monom (make-instance 'term :exponents '(1 2 3) :coeff 1)))153 (&body)))154 155 (test monom/term-conversion156 "Monom/term conversion"157 (with-fixture monom/term-conversion-context ()158 (is (r-equalp (change-class term 'monom) monom)))159 (with-fixture monom/term-conversion-context ()160 (is (r-equalp (change-class monom 'term) promoted-monom))))161 162 (test monom/term-copy163 "Monom/term copy"164 (with-fixture monom/term-conversion-context ()165 (is (r-equalp (copy-instance monom) monom))166 (is (r-equalp (copy-instance term) term)))167 )168 169 (test term-tensor-product170 "Term tensor product"171 (let ((term1 (make-instance 'term :exponents '(1 2 3) :coeff 4))172 (term2 (make-instance 'term :exponents '(4 5) :coeff 3))173 (term1-left-tensor-by-term2 (make-instance 'term :exponents '(4 5 1 2 3) :coeff 12)))174 (is (r-equalp (left-tensor-product-by term1 term2) term1-left-tensor-by-term2))))175 176 (test term-contract177 "Term contract"178 (let ((term (make-instance 'term :exponents '(1 2 3) :coeff 4))179 (term-contracted (make-instance 'term :exponents '(2 3) :coeff 4)))180 (is (r-equalp (left-contract term 1) term-contracted))))181 182 183 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;184 ;;185 ;; Order generics (LEX>, GRLEX>,...) tests186 ;;187 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;188 189 190 (def-fixture order-context ()191 (symbol-macrolet192 ((p (make-instance 'monom :exponents '(1 3 2)))193 (q (make-instance 'monom :exponents '(1 2 3))))194 (&body)))195 196 (test order197 "order"198 (with-fixture order-context ()199 (is-true (lex> p q))200 (is-true (grlex> p q))201 (is-true (revlex> p q))202 (is-true (grevlex> p q))203 (is-false (invlex> p q))))204 205 (def-fixture elim-order-context ()206 (let* ((p (make-instance 'monom :exponents '(1 2 3)))207 (q (make-instance 'monom :exponents '(4 5 6)))208 (elim-order-factory (make-elimination-order-factory))209 (elim-order-1 (funcall elim-order-factory 1))210 (elim-order-2 (funcall elim-order-factory 2)))211 (&body)))212 213 214 (test elim-order215 "Elimination order"216 (with-fixture elim-order-context ()217 (is-false (funcall elim-order-1 p q))218 (is-false (funcall elim-order-2 p q))))219 220 98 (run! 'monom-suite) 221 99 (format t "All tests done!~%")
Note:
See TracChangeset
for help on using the changeset viewer.