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

Formatting updates.

Browse Source
This commit is contained in:
Gerd Heber 2015-07-14 20:31:52 -05:00
parent 2672709129
commit 9fba07a1c0
3 changed files with 133 additions and 112 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

89
src/cl-space-efhm.lisp
View File

@ -17,6 +17,7 @@
(the chain-complex (the chain-complex
(tnsr-prdc clsp-tnsr-smgr bar))) (tnsr-prdc clsp-tnsr-smgr bar)))
(DEFUN CS-HAT-RIGHT-PERTURBATION-INTR (smgr) (DEFUN CS-HAT-RIGHT-PERTURBATION-INTR (smgr)
(declare (type simplicial-group smgr)) (declare (type simplicial-group smgr))
(let ((aprd (aprd smgr))) (let ((aprd (aprd smgr)))
@ -24,56 +25,44 @@
(declare (declare
(fixnum degr) (fixnum degr)
(type tnpr tnpr)) (type tnpr tnpr))
(with-tnpr (degr1 tnpr1 degr2 abar2) tnpr (with-tnpr
(when (zerop degr2) (degr1 tnpr1 degr2 abar2) tnpr
(return-from rslt (zero-cmbn (1- degr)))) (when (zerop degr2)
(with-tnpr (degr11 gbar11 degr12 gmsm12) tnpr1 (return-from rslt (zero-cmbn (1- degr))))
(let ((sign (-1-expt-n degr1)) (with-tnpr
(brgn21 (first (abar-list abar2))) (degr11 gbar11 degr12 gmsm12) tnpr1
(bar22 (make-abar (let ((sign (-1-expt-n degr1))
:list (rest (abar-list (brgn21 (first (abar-list abar2)))
abar2))))) (bar22 (make-abar :list (rest (abar-list abar2)))))
(declare (declare
(fixnum sign) (fixnum sign)
(type brgn brgn21) (type brgn brgn21)
(type abar bar22)) (type abar bar22))
(with-brgn (degr21 gmsm21) brgn21 (with-brgn
(let ((degr22 (- degr2 degr21))) (degr21 gmsm21) brgn21
(declare (fixnum degr22)) (let ((degr22 (- degr2 degr21)))
(decf degr21) ;; = dmns(gmsm21) (declare (fixnum degr22))
(let ((aprd (decf degr21) ;; = dmns(gmsm21)
(gnrt-? aprd (let ((aprd (gnrt-? aprd (+ degr12 degr21)
(+ degr12 (tnpr degr12 gmsm12
degr21) degr21 gmsm21))))
(tnpr degr12 (declare (type cmbn aprd))
gmsm12 (with-cmbn
degr21 (degr12+21 list) aprd
gmsm21)))) (make-cmbn
(declare (type cmbn aprd)) :degr (1- degr)
(with-cmbn (degr12+21 list) :list
aprd (mapcar
(make-cmbn #'(lambda (term)
:degr (1- degr) (declare (type term term))
:list (with-term
(mapcar (cffc gmsm) term
#'(lambda (term) (term (* sign cffc)
(declare (tnpr (+ degr1 degr21)
(type term term)) (tnpr degr11 gbar11
(with-term degr12+21 gmsm)
(cffc gmsm) term degr22 bar22))))
(term (* sign list)))))))))))
cffc)
(tnpr
(+ degr1
degr21)
(tnpr
degr11
gbar11
degr12+21
gmsm)
degr22
bar22))))
list)))))))))))
(the intr-mrph #'rslt)))) (the intr-mrph #'rslt))))

17
test/circle.lisp
View File

@ -3,26 +3,11 @@
(in-suite :kenzo) (in-suite :kenzo)
(defun circle ()
(the cat:chain-complex
(cat:build-chcm
:cmpr #'(lambda (gnrt1 gnrt2)
(declare (ignore gnrt1 gnrt2))
(the cat:cmpr :equal))
:basis #'(lambda (dmns)
(the list
(case dmns (0 '(*)) (1 '(s1))
(otherwise cat:+empty-list+))))
:bsgn '*
:intr-dffr #'cat:zero-intr-dffr
:strt :cmbn
:orgn '(circle))))
(test circle (test circle
(progn (progn
(cat:cat-init) (cat:cat-init)
(let ((circle (circle))) (let ((circle (cat:circle)))
(is (equal (cat:basis circle 0) '(*))) (is (equal (cat:basis circle 0) '(*)))
(is (equal (cat:basis circle 1) '(s1))) (is (equal (cat:basis circle 1) '(s1)))
(is (equal (cat:basis circle 2) cat:+empty-list+))))) (is (equal (cat:basis circle 2) cat:+empty-list+)))))

139
test/cl-space-efhm-test.lisp
View File

@ -5,49 +5,96 @@
(test cs-hat-u-t (test cs-hat-u-t
(progn (cat:cat-init)
(cat:cat-init) (let* ((c (cat:cs-hat-u-t (cat:k-z-1)))
(let* ((c (cat:cs-hat-u-t (cat:k-z-1))) (abar (random-abar 8 4))
(abar (random-abar 8 4)) (abar-degr (apply #'+ (mapcar #'car (cat:abar-list abar))))
(abar-degr (apply #'+ (mapcar #'car (cat:abar-list abar)))) (gnrt (cat:tnpr 5 (cat:tnpr 3 (cat:gbar 3 0 '(1 2) 0 '(3) 0 '())
(gnrt (cat:tnpr 5 (cat:tnpr 3 (cat:gbar 3 0 '(1 2) 0 '(3) 0 '()) 2 '(4 5))
2 '(4 5)) abar-degr abar)))
abar-degr abar))) (cat:? c (+ 5 abar-degr) gnrt)
(dotimes (i 5) (print (random-abar 8 4))) (cat:? c (cat:? c (+ 5 abar-degr) gnrt))
(cat:? c (+ 5 abar-degr) gnrt) (dotimes (i 10)
(cat:? c (cat:? c (+ 5 abar-degr) gnrt)) (let ((abar (random-abar 8 4)))
(dotimes (i 10) (setf abar-degr (apply #'+ (mapcar #'car (cat:abar-list abar))))
(let ((abar (random-abar 8 4))) (setf gnrt (cat:tnpr 5 (cat:tnpr 3 (cat:gbar 3 0 '(1 2) 0 '(3)
(setf abar-degr (apply #'+ (mapcar #'car (cat:abar-list abar)))) 0 '()) 2 '(4 5))
(setf gnrt (cat:tnpr 5 (cat:tnpr 3 (cat:gbar 3 0 '(1 2) 0 '(3) abar-degr abar))
0 '()) 2 '(4 5)) (unless (>= abar-degr 10)
abar-degr abar)) (print (cat:? c (+ 5 abar-degr) gnrt))
(unless (>= abar-degr 10) (print (cat:? c (cat:? c (+ 5 abar-degr) gnrt))))))
(print (cat:? c (+ 5 abar-degr) gnrt)) (dotimes (i 10)
(print (cat:? c (cat:? c (+ 5 abar-degr) gnrt)))))) (let ((abar (random-abar 8 4)))
(dotimes (i 10) (setf abar-degr (apply #'+ (mapcar #'car (cat:abar-list abar))))
(let ((abar (random-abar 8 4))) (setf gnrt (cat:tnpr 6 (cat:tnpr 3 (cat:gbar 3 0 '(1 2) 0 '(3)
(setf abar-degr (apply #'+ (mapcar #'car (cat:abar-list abar)))) 0 '()) 3 '(4 5 6))
(setf gnrt (cat:tnpr 6 (cat:tnpr 3 (cat:gbar 3 0 '(1 2) 0 '(3) abar-degr abar))
0 '()) 3 '(4 5 6)) (unless (>= abar-degr 9)
abar-degr abar)) (print (cat:? c (+ 6 abar-degr) gnrt))
(unless (>= abar-degr 9) (print (cat:? c (cat:? c (+ 6 abar-degr) gnrt))))))
(print (cat:? c (+ 6 abar-degr) gnrt)) (dotimes (i 10)
(print (cat:? c (cat:? c (+ 6 abar-degr) gnrt)))))) (let ((abar (random-abar 8 4)))
(dotimes (i 10) (setf abar-degr (apply #'+ (mapcar #'car (cat:abar-list abar))))
(let ((abar (random-abar 8 4))) (setf gnrt (cat:tnpr 5 (cat:tnpr 2 (cat:gbar 2 0 '(3) 0 '())
(setf abar-degr (apply #'+ (mapcar #'car (cat:abar-list abar)))) 3 '(4 5 6)) abar-degr abar))
(setf gnrt (cat:tnpr 5 (cat:tnpr 2 (cat:gbar 2 0 '(3) 0 '()) (unless (>= abar-degr 10)
3 '(4 5 6)) abar-degr abar)) (print (cat:? c (+ 5 abar-degr) gnrt))
(unless (>= abar-degr 10) (print (cat:? c (cat:? c (+ 5 abar-degr) gnrt))))))
(print (cat:? c (+ 5 abar-degr) gnrt)) (dotimes (i 10)
(print (cat:? c (cat:? c (+ 5 abar-degr) gnrt)))))) (let ((abar (random-abar 8 4)))
(dotimes (i 10) (setf abar-degr (apply #'+ (mapcar #'car (cat:abar-list abar))))
(let ((abar (random-abar 8 4))) (setf gnrt (cat:tnpr 4 (cat:tnpr 2 (cat:gbar 2 0 '(3) 0 '())
(setf abar-degr (apply #'+ (mapcar #'car (cat:abar-list abar)))) 2 '(4 5))
(setf gnrt (cat:tnpr 4 (cat:tnpr 2 (cat:gbar 2 0 '(3) 0 '()) abar-degr abar))
2 '(4 5)) (unless (>= abar-degr 11)
abar-degr abar)) (print (cat:? c (+ 4 abar-degr) gnrt))
(unless (>= abar-degr 11) (print (cat:? c (cat:? c (+ 4 abar-degr) gnrt))))))))
(print (cat:? c (+ 4 abar-degr) gnrt))
(print (cat:? c (cat:? c (+ 4 abar-degr) gnrt)))))))))
(test cs-hat-t-u
(cat:cat-init)
(dotimes (i 5) (print (random-abar 8 4)))
(let* ((c (cat:cs-hat-t-u (cat:k-z-1)))
(abar (random-abar 8 4))
(abar-degr (apply #'+ (mapcar #'car (cat:abar-list abar))))
(gnrt (cat:tnpr 5 (cat:tnpr 3 (cat:gbar 3 0 '(1 2) 0 '(3) 0 '())
2 '(4 5))
abar-degr abar)))
(cat:? c (+ 5 abar-degr) gnrt)
(cat:? c (cat:? c (+ 5 abar-degr) gnrt))
(dotimes (i 10)
(let ((abar (random-abar 8 4)))
(setf abar-degr (apply #'+ (mapcar #'car (cat:abar-list abar))))
(setf gnrt (cat:tnpr 5 (cat:tnpr 3 (cat:gbar 3 0 '(1 2) 0 '(3)
0 '()) 2 '(4 5))
abar-degr abar))
(unless (>= abar-degr 10)
(print (cat:? c (+ 5 abar-degr) gnrt))
(print (cat:? c (cat:? c (+ 5 abar-degr) gnrt))))))
(dotimes (i 10)
(let ((abar (random-abar 8 4)))
(setf abar-degr (apply #'+ (mapcar #'car (cat:abar-list abar))))
(setf gnrt (cat:tnpr 6 (cat:tnpr 3 (cat:gbar 3 0 '(1 2) 0 '(3)
0 '()) 3 '(4 5 6))
abar-degr abar))
(unless (>= abar-degr 9)
(print (cat:? c (+ 6 abar-degr) gnrt))
(print (cat:? c (cat:? c (+ 6 abar-degr) gnrt))))))
(dotimes (i 10)
(let ((abar (random-abar 8 4)))
(setf abar-degr (apply #'+ (mapcar #'car (cat:abar-list abar))))
(setf gnrt (cat:tnpr 5 (cat:tnpr 2 (cat:gbar 2 0 '(3) 0 '())
3 '(4 5 6))
abar-degr abar))
(unless (>= abar-degr 10)
(print (cat:? c (+ 5 abar-degr) gnrt))
(print (cat:? c (cat:? c (+ 5 abar-degr) gnrt))))))
(dotimes (i 10)
(let ((abar (random-abar 8 4)))
(setf abar-degr (apply #'+ (mapcar #'car (cat:abar-list abar))))
(setf gnrt (cat:tnpr 4 (cat:tnpr 2 (cat:gbar 2 0 '(3) 0 '())
2 '(4 5))
abar-degr abar))
(unless (>= abar-degr 11)
(print (cat:? c (+ 4 abar-degr) gnrt))
(print (cat:? c (cat:? c (+ 4 abar-degr) gnrt))))))))