Changeset 3225 for branches

Timestamp:

2015-06-22T19:56:53-07:00 (10 years ago)

Author:

Marek Rychlik

Message:

* empty log message *

File:

• branches/f4grobner/5am-symbolic-poly.lisp (modified) (1 diff)

branches/f4grobner/5am-symbolic-poly.lisp

@@ -51 +51 @@
 (in-package :5am-symbolic-poly)
 
-(def-suite poly-suite 
-    :description "Monom package suite")
+(def-suite symbolic-poly-suite 
+    :description "Symbolic polynomial package suite")
 
 (in-suite poly-suite)
 
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;;
-;;        POLY class tests
-;;
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
-(def-fixture poly-add-context ()
-  (let ((p (make-instance 'poly))
-        (q (make-instance 'poly :order nil))
-        (p+q (make-instance 'poly))
-        (p-q (make-instance 'poly))
-        (p-uminus (make-instance 'poly)))
-    ;; Populate the polynomials; the lists of (exponents . coefficient) pairs
-    ;; must be in increasing order in Q, but Q is unordered (:ORDER NIL)
-    ;; so it will be automatically sorted.
-    (dolist (x '( ((2) . 22)  ((4) . 44) ((5) . 55) ((8) . 88) ((9) . 99) ))
-      (insert-item p (make-instance 'term :exponents (car x) :coeff (cdr x))))
-    (dolist (x '( ((9) . 90) ((0) . 11)  ((2) . 20) ((3) . 33) ((4) . -44)  ((7) . 77) ((8) . 88) ))
-      (insert-item q (make-instance 'term :exponents (car x) :coeff (cdr x))))
-    ;; P+Q
-    (dolist (x '(((0) . 11) ((2) . 42)  ((3) . 33) ((5) . 55) ((7) . 77) ((8) . 176) ((9) . 189) ))
-      (insert-item p+q (make-instance 'term :exponents (car x) :coeff (cdr x))))
-    ;; P-Q
-    (dolist (x '(((0) . -11) ((2) . 2)  ((3) . -33) ((4) . 88) ((5) . 55) ((7) . -77) ((9) . 9)))
-      (insert-item p-q (make-instance 'term :exponents (car x) :coeff (cdr x))))
-    ;; -P
-    (dolist (x '( ((2) . -22)  ((4) . -44) ((5) . -55) ((8) . -88) ((9) . -99) ))
-      (insert-item p-uminus (make-instance 'term :exponents (car x) :coeff (cdr x))))
-    ;;(print p) (print q) (print p+q) (print p-q)
-    (&body)))
-
-(test poly-add
-  "Polynomial addition"
-  (with-fixture poly-add-context () (is (r-equalp (add-to p q) p+q)))
-  (with-fixture poly-add-context () (is (r-equalp (subtract-from p q) p-q)))
-  (with-fixture poly-add-context () (is (r-equalp (unary-minus p) p-uminus)))
-  )
-
-(def-fixture poly-multiply-context ()
-  (let ((p (make-instance 'poly))
-        (q (make-instance 'poly :order nil))
-        (p*q (make-instance 'poly)))
-    ;; Populate the polynomials; the lists of (exponents . coefficient) pairs
-    ;; must be in increasing order in Q, but Q is unordered (:ORDER NIL)
-    ;; so it will be automatically sorted.
-    (dolist (x '( ((0) . 1)  ((1) . 2) ))
-      (insert-item p (make-instance 'term :exponents (car x) :coeff (cdr x))))
-    (dolist (x '( ((0) . 1)  ((1) . 3) ))
-      (insert-item q (make-instance 'term :exponents (car x) :coeff (cdr x))))
-    ;; P*Q
-    (dolist (x '( ((0) . 1) ((1) . 5) ((2) . 6)))
-      (insert-item p*q (make-instance 'term :exponents (car x) :coeff (cdr x))))
-    (&body)))
-
-
-(test poly-multiply
-  "Polynomial multiplication"
-  (with-fixture poly-multiply-context () (is (r-equalp (r* p q) p*q)))
-  )
-
-(test poly-standard-extension
-  "Standard extension"
-  (let* ((p (alist->poly '( ((0) . 1) ((1) . 2))))
-         (q (alist->poly '( ((0) . 1) ((2) . 3))))
-         (plist (list p q))
-         (p-ext (alist->poly '( ((1 0 0) . 1) ((1 0 1) . 2))))
-         (q-ext (alist->poly '( ((0 1 0) . 1) ((0 1 2) . 3))))
-         (plist-st-ext (list p-ext q-ext)))
-    (is (r-equalp (standard-extension plist) plist-st-ext))))
-
-(test poly-standard-extension-1
-  "Standard extension 1"
-  (let* ((p (alist->poly '( ((0) . 1) ((1) . 2))))
-         (q (alist->poly '( ((0) . 1) ((2) . 3))))
-         (plist (list p q))
-         (p-ext (alist->poly '( ((0 0 0) . -1) ((1 0 0) . 1) ((1 0 1) . 2))))
-         (q-ext (alist->poly '( ((0 0 0) . -1) ((0 1 0) . 1) ((0 1 2) . 3))))
-         (plist-st-ext (list p-ext q-ext)))
-    (is (r-equalp (standard-extension-1 plist) plist-st-ext))))
-
-(test poly-standard-sum
-  "Standard sum"
-  (let* ((p (alist->poly '( ((0) . 1) ((1) . 2))))
-         (q (alist->poly '( ((0) . 1) ((2) . 3))))
-         (plist (list p q))
-         (std-sum (alist->poly '(((0 0 0) . -1) ((0 1 0) . 1) ((0 1 2) . 3)
-                                 ((1 0 0) . 1) ((1 0 1) . 2)))))
-    (is (r-equalp (standard-sum plist) std-sum))))
-
-(run! 'poly-suite)
+(run! 'symbolic-poly-suite)
 (format t "All tests done!~%")