99 lines
4.3 KiB
Common Lisp
99 lines
4.3 KiB
Common Lisp
;;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Base: 10 -*
|
|
|
|
(in-package :kenzo-test)
|
|
|
|
(in-suite :kenzo)
|
|
|
|
(test smgr-fibration
|
|
(cat:cat-init)
|
|
(let* ((k1 (cat:k-z-1))
|
|
(tw (cat:smgr-fibration k1))
|
|
(k2 (cat:sorc tw))
|
|
(tt (cat:fibration-total tw))
|
|
(gmsm (cat:crpr 0 (cat:gbar 4 0 '(10 11 12) 0 '(20 21)
|
|
0 '(30) 0 '())
|
|
0 '(2 4 6 8)))
|
|
(br (cat:brown-reduction tw))
|
|
(tw-pr (cat:bcc br)))
|
|
(dotimes (i 5)
|
|
(print (cat:face tt i 4 gmsm)))
|
|
(cat:? tw-pr 4 (cat:tnpr 4 (cat:gbar 4 0 '(1 10 100) 0 '(1000 10000)
|
|
0 '(100000) 0 '())
|
|
0 '()))))
|
|
|
|
#|
|
|
(test smgr-crts-contraction
|
|
(cat:cat-init)
|
|
(let* ((chi (cat:smgr-crts-contraction (cat:k-z-1)))
|
|
(rdct (cat:build-rdct :f (cat:zero-mrph (cat:sorc chi)
|
|
(cat:z-chcm))
|
|
:g (cat:zero-mrph (cat:z-chcm)
|
|
(cat:sorc chi))
|
|
:h chi)))
|
|
(cat:pre-check-rdct rdct)
|
|
(setf cat:*tc* (cat:cmbn 0 1 (cat:crpr 0 cat:+null-gbar+ 0 '())))
|
|
(setf cat:*bc* (cat:cmbn 0 1 :z-gnrt))
|
|
(check-rdct)
|
|
(setf cat:*tc* (cat:cmbn 1 1 (cat:crpr 1 cat:+null-gbar+ 0 '(1))))
|
|
(check-rdct)
|
|
(setf cat:*tc* (cat:cmbn 4 1 (cat:crpr 0 (cat:gbar 4 0 '(10 11 12)
|
|
0 '(20 21)
|
|
0 '(30) 0 '())
|
|
0 '(2 4 6 8))))
|
|
(check-rdct)
|
|
(setf cat:*tc* (cat:cmbn 3 1 (cat:crpr 0 (cat:gbar 3 0 '(10 11)
|
|
0 '(20) 0 '())
|
|
0 '(2 4 6))))
|
|
(check-rdct)))
|
|
|#
|
|
|
|
#|
|
|
(test smgr-tnpr-contraction
|
|
(cat:cat-init)
|
|
(let* ((chi (cat:smgr-tnpr-contraction (cat:k-z-1)))
|
|
(rdct (cat:build-rdct :f (cat:zero-mrph (cat:sorc chi)
|
|
(cat:z-chcm))
|
|
:g (cat:zero-mrph (cat:z-chcm)
|
|
(cat:sorc chi))
|
|
:h chi)))
|
|
(cat:pre-check-rdct rdct)
|
|
(setf cat:*tc* (cat:cmbn 0 1 (cat:tnpr 0 cat:+null-gbar+ 0 '())))
|
|
(setf cat:*bc* (cat:cmbn 0 1 :z-gnrt))
|
|
(check-rdct)
|
|
(setf cat:*tc* (cat:cmbn 1 1 (cat:tnpr 0 cat:+null-gbar+ 1 '(1))))
|
|
(check-rdct)
|
|
(setf cat:*tc* (cat:cmbn 3 1 (cat:tnpr 0 cat:+null-gbar+
|
|
3 '(1 10 100))))
|
|
(cat:? chi cat:*tc*)
|
|
(check-rdct)
|
|
(setf cat:*tc* (cat:cmbn 3 1 (cat:tnpr 2 (cat:gbar 2 0 '(1) 0 '())
|
|
1 '(10))))
|
|
(cat:? chi cat:*tc*)
|
|
(check-rdct)
|
|
(setf cat:*tc* (cat:cmbn 3 1 (cat:tnpr 3 (cat:gbar 3 0 '(1 10)
|
|
0 '(100) 0 '())
|
|
0 '())))
|
|
(cat:? chi cat:*tc*)
|
|
(check-rdct)
|
|
(setf cat:*tc* (cat:cmbn 4 1 (cat:tnpr 0 cat:+null-gbar+
|
|
4 '(1 10 100 1000))))
|
|
(cat:? chi cat:*tc*)
|
|
(check-rdct)
|
|
(setf cat:*tc* (cat:cmbn 4 1 (cat:tnpr 2 (cat:gbar 2 0 '(1) 0 '())
|
|
2 '(10 100))))
|
|
(cat:? chi cat:*tc*)
|
|
(check-rdct)
|
|
(setf cat:*tc* (cat:cmbn 4 1 (cat:tnpr 3 (cat:gbar 3 0 '(1 10)
|
|
0 '(100) 0 '())
|
|
1 '(1000))))
|
|
(cat:? chi cat:*tc*)
|
|
(check-rdct)
|
|
(setf cat:*tc* (cat:cmbn 4 1 (cat:tnpr 4 (cat:gbar 4 0 '(1 10 100)
|
|
0 '(1000 10000)
|
|
0 '(100000)
|
|
0 '())
|
|
0 '())))
|
|
(cat:? chi cat:*tc*)
|
|
(check-rdct)))
|
|
|#
|