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

Converted a few more chain-complexes tests.

Browse Source
This commit is contained in:
gheber 2014-12-25 19:57:57 -06:00
parent 6851846a71
commit 5ed7133fff
2 changed files with 59 additions and 58 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

5
package.lisp
View File

@ -7,9 +7,13 @@
;; chain-complexes.lisp
+TOO-MUCH-TIME+
BUILD-CHCM
BUILD-MRPH
CAT-INIT
CMBN-?
DO-CONTROL
GNRT-?
;; chcm-elementary-op.lisp
@ -19,6 +23,7 @@
CMBN-CMBN
CMBN-DEGR
CMBN-LIST
MAKE-CMBN
MAKE-RESULT
;; combinations.lisp

112
test/chain-complexes-test.lisp
View File

@ -24,6 +24,7 @@
(control #'s-cmpr (cmbn 0 1 'a 1 'b -1 'b))
|#
(test do-control
(let ((comb (cat:do-control #'cat:s-cmpr (cat:cmbn 0 1 'a 1 'b -1 'c))))
(is (equal (cat:cmbn-degr comb) 0))
@ -37,54 +38,36 @@
(setf cat:*cmbn-control* nil))
#|
()
(cat-init)
(setf cc (build-chcm :cmpr #'f-cmpr
:basis :locally-effective
:bsgn 0
:intr-dffr #'(lambda (cmbn)
(cmbn (1- (cmbn-degr cmbn))))
:strt :cmbn
:orgn '(Z of Z)))
(setf cc (build-chcm :cmpr #'f-cmpr
:basis :locally-effective
:bsgn 0
:intr-dffr #'(lambda (cmbn)
(cmbn (1- (cmbn-degr cmbn))))
:strt :cmbn
:orgn '(Z of Z)))
(setf ff (build-mrph :sorc cc :trgt cc :degr 0
:intr #'(lambda (degr n) (cmbn degr 1 n))
:strt :gnrt :orgn '(test)))
(setf ff (build-mrph :sorc cc :trgt cc :degr 0
:intr #'(lambda (degr n) (cmbn degr 1 n))
:strt :gnrt :orgn '(test)))
(dotimes (i 20)
(let ((n (- (random 50) 50)))
(format t "~%~D ~D" n (gnrt-? ff 0 n))))
(setf +too-much-time+ -1)
(dotimes (i 20)
(let ((n (- (random 50) 50)))
(format t "~%~D ~D" n (gnrt-? ff 0 n))))
(setf +too-much-time+ 50)
|#
(test gnrt-?
(progn
(cat:cat-init)
(let* ((cc (cat:build-chcm :cmpr #'cat:f-cmpr
:basis :locally-effective
:bsgn 0
:intr-dffr #'(lambda (cmbn)
(cat:cmbn
(1- (cat:cmbn-degr cmbn))))
:strt :cmbn
:orgn '(Z of Z)))
(ff (cat:build-mrph :sorc cc :trgt cc :degr 0
:intr #'(lambda (degr n)
(cat:cmbn degr 1 n))
:strt :gnrt :orgn '(test))))
;; setting this to a small value (-1) triggers some kind
;; of caching which appears to be broken (???)
(setf cat:+too-much-time+ 50)
(dotimes (i 20)
(let* ((n (- (random 50) 50))
(comb (cat:gnrt-? ff 0 n)))
(is (equal (cat:cmbn-degr comb) 0))
(is (equal (cat:cmbn-list comb) (cons (cons 1 n) nil))))))))
#|
()
(cat-init)
(setf cc (build-chcm :cmpr #'f-cmpr
:basis :locally-effective
:bsgn 0
:intr-dffr #'(lambda (cmbn)
(cmbn (1- (cmbn-degr cmbn))))
:strt :cmbn
:orgn '(Z of Z)))
(setf *n* 10)
(defparameter *n* 10)
(defun ff (degr i)
(do ((*2n* (ash *n* 1))
(rslt +empty-list+
(rslt cat:+empty-list+
(cons (cons (let ((cffc (- (random *2n*) *n*)))
(if (minusp cffc) cffc (1+ cffc)))
(decf gnrt (1+ (random *n*))))
@ -92,19 +75,32 @@
(gnrt i)
(k 0 (1+ k)))
((= k *n*)
(make-cmbn
(cat:make-cmbn
:degr 0
:list rslt))))
(ff 0 20)
(compile 'ff)
(setf mrph (build-mrph :sorc cc :trgt cc :degr 0
:intr #'ff :strt :gnrt :orgn '(test)))
(cmbn-? mrph (cmbn 0 1 100))
(cmbn-? mrph *)
(cmbn-? mrph *)
(cmbn-? mrph *)
(cmbn-? mrph *)
(cmbn-? mrph *)
(time (cmbn-? mrph *))
(inspect mrph)
|#
(test cmbn-?
(progn
(compile 'ff)
(cat:cat-init)
(let* ((cc (cat:build-chcm :cmpr #'cat:f-cmpr
:basis :locally-effective
:bsgn 0
:intr-dffr #'(lambda (cmbn)
(cat:cmbn
(1- (cat:cmbn-degr cmbn))))
:strt :cmbn
:orgn '(Z of Z)))
(mrph (cat:build-mrph :sorc cc :trgt cc :degr 0
:intr #'ff :strt :gnrt :orgn '(test))))
(let ((comb (cat:cmbn-? mrph (cat:cmbn 0 1 100))))
(is (equal (cat:cmbn-degr comb) 0))
(setq comb (cat:cmbn-? mrph comb))
(setq comb (cat:cmbn-? mrph comb))
(setq comb (cat:cmbn-? mrph comb))
(setq comb (cat:cmbn-? mrph comb))
(setq comb (cat:cmbn-? mrph comb))
;; (time (cat:cmbn-? mrph *))
;; (inspect mrph)
))))