Formatting updates.
This commit is contained in:
Gerd Heber
parent
2672709129
commit
9fba07a1c0
@ -17,6 +17,7 @@
|
||||
(the chain-complex
|
||||
(tnsr-prdc clsp-tnsr-smgr bar)))
|
||||
|
||||
|
||||
(DEFUN CS-HAT-RIGHT-PERTURBATION-INTR (smgr)
|
||||
(declare (type simplicial-group smgr))
|
||||
(let ((aprd (aprd smgr)))
|
||||
@ -24,56 +25,44 @@
|
||||
(declare
|
||||
(fixnum degr)
|
||||
(type tnpr tnpr))
|
||||
(with-tnpr (degr1 tnpr1 degr2 abar2) tnpr
|
||||
(when (zerop degr2)
|
||||
(return-from rslt (zero-cmbn (1- degr))))
|
||||
(with-tnpr (degr11 gbar11 degr12 gmsm12) tnpr1
|
||||
(let ((sign (-1-expt-n degr1))
|
||||
(brgn21 (first (abar-list abar2)))
|
||||
(bar22 (make-abar
|
||||
:list (rest (abar-list
|
||||
abar2)))))
|
||||
(declare
|
||||
(fixnum sign)
|
||||
(type brgn brgn21)
|
||||
(type abar bar22))
|
||||
(with-brgn (degr21 gmsm21) brgn21
|
||||
(let ((degr22 (- degr2 degr21)))
|
||||
(declare (fixnum degr22))
|
||||
(decf degr21) ;; = dmns(gmsm21)
|
||||
(let ((aprd
|
||||
(gnrt-? aprd
|
||||
(+ degr12
|
||||
degr21)
|
||||
(tnpr degr12
|
||||
gmsm12
|
||||
degr21
|
||||
gmsm21))))
|
||||
(declare (type cmbn aprd))
|
||||
(with-cmbn (degr12+21 list)
|
||||
aprd
|
||||
(make-cmbn
|
||||
:degr (1- degr)
|
||||
:list
|
||||
(mapcar
|
||||
#'(lambda (term)
|
||||
(declare
|
||||
(type term term))
|
||||
(with-term
|
||||
(cffc gmsm) term
|
||||
(term (* sign
|
||||
cffc)
|
||||
(tnpr
|
||||
(+ degr1
|
||||
degr21)
|
||||
(tnpr
|
||||
degr11
|
||||
gbar11
|
||||
degr12+21
|
||||
gmsm)
|
||||
degr22
|
||||
bar22))))
|
||||
list)))))))))))
|
||||
(with-tnpr
|
||||
(degr1 tnpr1 degr2 abar2) tnpr
|
||||
(when (zerop degr2)
|
||||
(return-from rslt (zero-cmbn (1- degr))))
|
||||
(with-tnpr
|
||||
(degr11 gbar11 degr12 gmsm12) tnpr1
|
||||
(let ((sign (-1-expt-n degr1))
|
||||
(brgn21 (first (abar-list abar2)))
|
||||
(bar22 (make-abar :list (rest (abar-list abar2)))))
|
||||
(declare
|
||||
(fixnum sign)
|
||||
(type brgn brgn21)
|
||||
(type abar bar22))
|
||||
(with-brgn
|
||||
(degr21 gmsm21) brgn21
|
||||
(let ((degr22 (- degr2 degr21)))
|
||||
(declare (fixnum degr22))
|
||||
(decf degr21) ;; = dmns(gmsm21)
|
||||
(let ((aprd (gnrt-? aprd (+ degr12 degr21)
|
||||
(tnpr degr12 gmsm12
|
||||
degr21 gmsm21))))
|
||||
(declare (type cmbn aprd))
|
||||
(with-cmbn
|
||||
(degr12+21 list) aprd
|
||||
(make-cmbn
|
||||
:degr (1- degr)
|
||||
:list
|
||||
(mapcar
|
||||
#'(lambda (term)
|
||||
(declare (type term term))
|
||||
(with-term
|
||||
(cffc gmsm) term
|
||||
(term (* sign cffc)
|
||||
(tnpr (+ degr1 degr21)
|
||||
(tnpr degr11 gbar11
|
||||
degr12+21 gmsm)
|
||||
degr22 bar22))))
|
||||
list)))))))))))
|
||||
(the intr-mrph #'rslt))))
|
||||
|
||||
|
||||
|
||||
@ -3,26 +3,11 @@
|
||||
|
||||
(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
|
||||
(progn
|
||||
(cat:cat-init)
|
||||
(let ((circle (circle)))
|
||||
(let ((circle (cat:circle)))
|
||||
(is (equal (cat:basis circle 0) '(*)))
|
||||
(is (equal (cat:basis circle 1) '(s1)))
|
||||
(is (equal (cat:basis circle 2) cat:+empty-list+)))))
|
||||
|
||||
@ -5,49 +5,96 @@
|
||||
|
||||
|
||||
(test cs-hat-u-t
|
||||
(progn
|
||||
(cat:cat-init)
|
||||
(let* ((c (cat:cs-hat-u-t (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)))
|
||||
(dotimes (i 5) (print (random-abar 8 4)))
|
||||
(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)))))))))
|
||||
(cat:cat-init)
|
||||
(let* ((c (cat:cs-hat-u-t (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))))))))
|
||||
|
||||
|
||||
(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))))))))
|
||||
|
||||
Loading…
Reference in New Issue
Block a user