mmarco/kenzo
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

Added CCN test from Kenzo handbook.

Browse Source
This commit is contained in:
gheber 2014-12-31 17:03:16 -06:00
parent e8d0011910
commit 8043c1edfd
3 changed files with 98 additions and 1 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

3
kenzo-test.asd
View File

@ -11,4 +11,5 @@
(:file "chain-complexes-test")
(:file "chcm-elementary-op-test")
(:file "diabolo")
(:file "circle")))
(:file "circle")
(:file "ccn")))

4
package.lisp
View File

@ -31,9 +31,12 @@
CHAIN-COMPLEX
CMBN-CMBN
CMBN-DEGR
DEGR
DFFR1
CMBN-LIST
MAKE-CMBN
MAKE-RESULT
MORPHISM
;; combinations.lisp
@ -63,6 +66,7 @@
;; macros.lisp
?
BASIS
BINOMIAL-P-Q
CFFC

92
test/ccn.lisp Normal file
View File

@ -0,0 +1,92 @@
(in-package :kenzo-test)
(in-suite :kenzo)
(defun ccn ()
(the cat:chain-complex
(cat:build-chcm
:cmpr #'cat:f-cmpr
:basis #'(lambda (n)
(cat:<a-b< (* 10 n) (* 10 (1+ n))))
:bsgn 0
:intr-dffr #'(lambda (dgr gnr)
(if (evenp (+ dgr gnr))
(cat:cmbn (1- dgr) 1 (- gnr 10))
(cat:cmbn (1- dgr))))
:strt :gnrt
:orgn '(ccn))))
(test ccn
(progn
(cat:cat-init)
(let* ((ccn (ccn))
(upper-shift (cat:build-mrph
:sorc ccn :trgt ccn :strt :gnrt :degr 1
:intr #'(lambda (d gn) (cat:cmbn (1+ d)
1 (+ gn 10)))
:orgn '(ccn shift +10)))
(lower-shift (cat:build-mrph
:sorc ccn :trgt ccn :strt :gnrt :degr -1
:intr #'(lambda (d gn) (cat:cmbn (1- d)
1 (- gn 10)))
:orgn '(ccn shift -10)))
(comb1 (cat:? ccn 2 22))
(combn (cat:cmbn 5 1 50 5 55 9 59))
(d-combn (cat:? ccn combn))
(dd-combn (cat:? ccn d-combn))
(comb2 (cat:? upper-shift 0 6))
(comb3 (cat:? lower-shift 5 51))
(comb4 (cat:? lower-shift comb3))
(identity? (cat:cmps upper-shift lower-shift))
(comb5 (cat:cmbn 1 1 10 2 11 3 12 4 13))
(comb6 (cat:? identity? comb5))
(comb7 (cat:2cmbn-sbtr (cat:cmpr ccn) comb5 comb6))
(upper2-shift (cat:cmps upper-shift upper-shift))
(comb8 (cat:? upper2-shift comb5))
(twice-up-shift (cat:add upper-shift upper-shift))
(comb9 (cat:? twice-up-shift comb5))
(up-d (cat:cmps upper-shift (cat:dffr1 ccn)))
(d-up (cat:cmps (cat:dffr1 ccn) upper-shift))
(comb10 (cat:? up-d 1 11))
(comb11 (cat:? d-up 1 11))
(comb12 (cat:cmbn 1 1 10 2 11 3 12 4 13 5 14 6 15))
(comb13 (cat:? up-d comb12))
(comb14 (cat:? d-up comb12))
)
(is (equal (cat:cmbn-degr comb1) 1))
(is (equal (cat:cmbn-list comb1) '((1 . 12))))
(is (null (cat:cmbn-non-zero-p (cat:? ccn comb1))))
(is (equal (cat:cmbn-degr d-combn) 4))
(is (equal (cat:cmbn-list d-combn) '((5 . 45) (9 . 49))))
(is (equal (cat:cmbn-degr dd-combn) 3))
(is (equal (cat:cmbn-list dd-combn) nil))
(is (equal (cat:cmbn-degr comb2) 1))
(is (equal (cat:cmbn-list comb2) '((1 . 16))))
(is (equal (cat:cmbn-degr comb3) 4))
(is (equal (cat:cmbn-list comb3) '((1 . 41))))
(is (equal (cat:cmbn-degr comb4) 3))
(is (equal (cat:cmbn-list comb4) '((1 . 31))))
(is (equal (cat:degr identity?) 0))
(is (equal (cat:cmbn-degr comb6) 1))
(is (equal (cat:cmbn-list comb6) '((1 . 10) (2 . 11) (3 . 12)
(4 . 13))))
(is (equal (cat:cmbn-degr comb7) 1))
(is (equal (cat:cmbn-list comb7) nil))
(is (equal (cat:degr upper2-shift) 2))
(is (equal (cat:cmbn-degr comb8) 3))
(is (equal (cat:cmbn-list comb8) '((1 . 30) (2 . 31) (3 . 32)
(4 . 33))))
(is (equal (cat:degr twice-up-shift) 1))
(is (equal (cat:cmbn-degr comb9) 2))
(is (equal (cat:cmbn-list comb9) '((2 . 20) (4 . 21) (6 . 22)
(8 . 23))))
(is (equal (cat:cmbn-degr comb10) 1))
(is (equal (cat:cmbn-list comb10) '((1 . 11))))
(is (equal (cat:cmbn-degr comb11) 1))
(is (equal (cat:cmbn-list comb11) nil))
(is (equal (cat:cmbn-degr comb13) 1))
(is (equal (cat:cmbn-list comb13) '((2 . 11) (4 . 13) (6 . 15))))
(is (equal (cat:cmbn-degr comb14) 1))
(is (equal (cat:cmbn-list comb14) '((1 . 10) (3 . 12) (5 . 14)))))))