close Warning: Can't synchronize with repository "(default)" (The repository directory has changed, you should resynchronize the repository with: trac-admin $ENV repository resync '(default)'). Look in the Trac log for more information.

Changeset 3461


Ignore:
Timestamp:
2015-09-05T09:48:11-07:00 (9 years ago)
Author:
Marek Rychlik
Message:

* empty log message *

File:
1 edited

Legend:

Unmodified
Added
Removed
  • branches/f4grobner/5am-monom.lisp

    r3320 r3461  
    3838(ql:quickload :fiveam)
    3939
    40 (require :ring "ring")
    4140(require :monom "monom")
    42 (require :term "term")
    43 (require :order "order")
     41(require :term "copy")
    4442
    4543(defpackage #:5am-monom
     
    9896    (is (r-equalp (divide-by n m) n/m))))
    9997 
    100 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
    101 ;;
    102 ;;        TERM class tests
    103 ;;
    104 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
    105 
    106 (def-fixture term-context ()
    107   (symbol-macrolet
    108       ((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-basics
    118   "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     (signals
    129         (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     (signals
    137         (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-macrolet
    150       ((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-conversion
    156   "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-copy
    163   "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-product
    170   "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-contract
    177   "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>,...) tests
    186 ;;
    187 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
    188 
    189 
    190 (def-fixture order-context ()
    191   (symbol-macrolet
    192       ((p (make-instance 'monom :exponents '(1 3 2)))
    193        (q (make-instance 'monom :exponents '(1 2 3))))
    194     (&body)))
    195 
    196 (test order
    197   "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-order
    215   "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 
    22098(run! 'monom-suite)
    22199(format t "All tests done!~%")
Note: See TracChangeset for help on using the changeset viewer.