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 ;; chain-complexes.lisp
+TOO-MUCH-TIME+
BUILD-CHCM BUILD-CHCM
BUILD-MRPH
CAT-INIT CAT-INIT
CMBN-?
DO-CONTROL DO-CONTROL
GNRT-?
;; chcm-elementary-op.lisp ;; chcm-elementary-op.lisp
@ -19,6 +23,7 @@
CMBN-CMBN CMBN-CMBN
CMBN-DEGR CMBN-DEGR
CMBN-LIST CMBN-LIST
MAKE-CMBN
MAKE-RESULT MAKE-RESULT
;; combinations.lisp ;; 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)) (control #'s-cmpr (cmbn 0 1 'a 1 'b -1 'b))
|# |#
(test do-control (test do-control
(let ((comb (cat:do-control #'cat:s-cmpr (cat:cmbn 0 1 'a 1 'b -1 'c)))) (let ((comb (cat:do-control #'cat:s-cmpr (cat:cmbn 0 1 'a 1 'b -1 'c))))
(is (equal (cat:cmbn-degr comb) 0)) (is (equal (cat:cmbn-degr comb) 0))
@ -37,54 +38,36 @@
(setf cat:*cmbn-control* nil)) (setf cat:*cmbn-control* nil))
#|
() (test gnrt-?
(cat-init) (progn
(setf cc (build-chcm :cmpr #'f-cmpr (cat:cat-init)
:basis :locally-effective (let* ((cc (cat:build-chcm :cmpr #'cat:f-cmpr
:bsgn 0 :basis :locally-effective
:intr-dffr #'(lambda (cmbn) :bsgn 0
(cmbn (1- (cmbn-degr cmbn)))) :intr-dffr #'(lambda (cmbn)
:strt :cmbn (cat:cmbn
:orgn '(Z of Z))) (1- (cat:cmbn-degr cmbn))))
(setf cc (build-chcm :cmpr #'f-cmpr :strt :cmbn
:basis :locally-effective :orgn '(Z of Z)))
:bsgn 0 (ff (cat:build-mrph :sorc cc :trgt cc :degr 0
:intr-dffr #'(lambda (cmbn) :intr #'(lambda (degr n)
(cmbn (1- (cmbn-degr cmbn)))) (cat:cmbn degr 1 n))
:strt :cmbn :strt :gnrt :orgn '(test))))
:orgn '(Z of Z))) ;; setting this to a small value (-1) triggers some kind
(setf ff (build-mrph :sorc cc :trgt cc :degr 0 ;; of caching which appears to be broken (???)
:intr #'(lambda (degr n) (cmbn degr 1 n)) (setf cat:+too-much-time+ 50)
:strt :gnrt :orgn '(test))) (dotimes (i 20)
(setf ff (build-mrph :sorc cc :trgt cc :degr 0 (let* ((n (- (random 50) 50))
:intr #'(lambda (degr n) (cmbn degr 1 n)) (comb (cat:gnrt-? ff 0 n)))
:strt :gnrt :orgn '(test))) (is (equal (cat:cmbn-degr comb) 0))
(dotimes (i 20) (is (equal (cat:cmbn-list comb) (cons (cons 1 n) nil))))))))
(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)
|#
#| (defparameter *n* 10)
()
(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)
(defun ff (degr i) (defun ff (degr i)
(do ((*2n* (ash *n* 1)) (do ((*2n* (ash *n* 1))
(rslt +empty-list+ (rslt cat:+empty-list+
(cons (cons (let ((cffc (- (random *2n*) *n*))) (cons (cons (let ((cffc (- (random *2n*) *n*)))
(if (minusp cffc) cffc (1+ cffc))) (if (minusp cffc) cffc (1+ cffc)))
(decf gnrt (1+ (random *n*)))) (decf gnrt (1+ (random *n*))))
@ -92,19 +75,32 @@
(gnrt i) (gnrt i)
(k 0 (1+ k))) (k 0 (1+ k)))
((= k *n*) ((= k *n*)
(make-cmbn (cat:make-cmbn
:degr 0 :degr 0
:list rslt)))) :list rslt))))
(ff 0 20)
(compile 'ff) (test cmbn-?
(setf mrph (build-mrph :sorc cc :trgt cc :degr 0 (progn
:intr #'ff :strt :gnrt :orgn '(test))) (compile 'ff)
(cmbn-? mrph (cmbn 0 1 100)) (cat:cat-init)
(cmbn-? mrph *) (let* ((cc (cat:build-chcm :cmpr #'cat:f-cmpr
(cmbn-? mrph *) :basis :locally-effective
(cmbn-? mrph *) :bsgn 0
(cmbn-? mrph *) :intr-dffr #'(lambda (cmbn)
(cmbn-? mrph *) (cat:cmbn
(time (cmbn-? mrph *)) (1- (cat:cmbn-degr cmbn))))
(inspect mrph) :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)
))))