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 2638 for branches/f4grobner


Ignore:
Timestamp:
2015-06-20T14:44:45-07:00 (9 years ago)
Author:
Marek Rychlik
Message:

* empty log message *

File:
1 edited

Legend:

Unmodified
Added
Removed

  • branches/f4grobner/5am-poly.lisp

    r2637 r2638  
    4949(in-package :5am-poly)
    5050
    51 (def-suite monom-suite
     51(def-suite poly-suite
    5252    :description "Monom package suite")
    5353
    54 (in-suite monom-suite)
    55 
    56 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
    57 ;;
    58 ;;        MONOM class tests
    59 ;;
    60 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
    61 
    62 (def-fixture monom-context ()
    63   (let ((z (make-instance 'monom  :dimension 3))
    64         (m (make-instance 'monom  :dimension 3 :exponents '(1 2 3)))
    65         (n (make-instance 'monom  :dimension 3 :exponents '(4 5 6)))
    66         (m*n (make-instance 'monom  :dimension 3 :exponents '(5 7 9)))
    67         (n/m (make-instance 'monom  :dimension 3 :exponents '(3 3 3)))
    68         (m-tensor-n (make-instance 'monom  :exponents '(1 2 3 4 5 6))))
    69     (&body)))
    70 
    71 (test monom-basics
    72   "Monom basics"
    73   (with-fixture monom-context ()
    74     (is (= (r-dimension m) 3))
    75     (is (= (r-elt m 2) 3))
    76     (is (= (r-total-degree m) 6))
    77     (is (= (r-sugar m) 6))
    78     (is (equalp  (r->list z) '(0 0 0)) "Trivial monomial is a vector of 0's")
    79     (is (r-equalp (r* m n) m*n))
    80     (is (r-equalp (r/ n m) n/m))
    81     (is (r-equalp (r-tensor-product m n) m-tensor-n))
    82     (signals
    83         (error "EXPONENTS must have length DIMENSION")
    84       (make-instance 'monom  :dimension 3 :exponents '(1 2 3 4 5 6)))
    85     (is-true (r-divides-p m n))
    86     (is-false (r-divides-p n m))
    87     (is (r-equalp (r-gcd m n) m))
    88     (is (r-equalp (r-lcm m n) n))
    89     (is-true (r-depends-p m 0))
    90     (signals
    91         (error "Index out of bounds")
    92       (r-depends-p m 3))))
    93  
    94 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
    95 ;;
    96 ;;        TERM class tests
    97 ;;
    98 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
    99 
    100 (def-fixture term-context ()
    101   (let ((z (make-instance 'term  :dimension 3 :coeff 5))
    102         (m (make-instance 'term  :dimension 3 :exponents '(1 2 3) :coeff 6))
    103         (n (make-instance 'term  :dimension 3 :exponents '(4 5 6) :coeff 12))
    104         (m*n (make-instance 'term  :dimension 3 :exponents '(5 7 9) :coeff 72))
    105         (n/m (make-instance 'term  :dimension 3 :exponents '(3 3 3) :coeff 2))
    106         (m-tensor-n (make-instance 'term  :exponents '(1 2 3 4 5 6) :coeff 72)))
    107     (&body)))
    108 
    109 (test term-basics
    110   "Term basics"
    111   (with-fixture term-context ()
    112     (is (= (r-dimension m) 3))
    113     (is (= (r-elt m 2) 3))
    114     (is (= (r-total-degree m) 6))
    115     (is (= (r-sugar m) 6))
    116     (is (equalp  (r->list z) '(0 0 0)) "Trivial term is a vector of 0's")
    117     (is (r-equalp (r* m n) m*n))
    118     (is (r-equalp (r/ n m) n/m))
    119     (is (r-equalp (r-tensor-product m n) m-tensor-n))
    120     (signals
    121         (error "EXPONENTS must have length DIMENSION")
    122       (make-instance 'term  :dimension 3 :exponents '(1 2 3 4 5 6) :coeff 77))
    123     (is-true (r-divides-p m n))
    124     (is-false (r-divides-p n m))
    125     (is (r-equalp (r-gcd m n) m))
    126     (is (r-equalp (r-lcm m n) n))
    127     (is-true (r-depends-p m 0))
    128     (signals
    129         (error "Index out of bounds")
    130       (r-depends-p m 3))
    131     )
    132 
    133   )
    134 
    135 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
    136 ;;
    137 ;;        Order generics (LEX>, GRLEX>,...) tests
    138 ;;
    139 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
    140 
    141 
    142 (def-fixture order-context ()
    143   (let ((p (make-instance 'monom :exponents '(1 3 2)))
    144         (q (make-instance 'monom :exponents '(1 2 3))))
    145     (&body)))
    146 
    147 (test order
    148   "order"
    149   (with-fixture order-context ()
    150     (is-true (lex>  p q))
    151     (is-true (grlex>  p q))
    152     (is-true (revlex>  p q))
    153     (is-true (grevlex>  p q))
    154     (is-false (invlex>  p q))))
    155 
    156 (def-fixture elim-order-context ()
    157   (let* ((p (make-instance 'monom :exponents '(1 2 3)))
    158          (q (make-instance 'monom :exponents '(4 5 6)))
    159          (elim-order-factory (make-elimination-order-factory))
    160          (elim-order-1 (funcall elim-order-factory 1))
    161          (elim-order-2 (funcall elim-order-factory 2)))
    162     (&body)))
    163 
    164 
    165 (test elim-order
    166   "Elimination order"
    167   (with-fixture elim-order-context ()
    168     (is-false (funcall elim-order-1 p q))
    169     (is-false (funcall elim-order-2 p q))))
     54(in-suite poly-suite)
    17055
    17156;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
    … …  
    20186  ))
    20287
    203 (run! 'monom-suite)
     88(run! 'poly-suite)
    20489(format t "All tests done!~%")
    20590
Note: See TracChangeset for help on using the changeset viewer.