123 lines
3.7 KiB
Common Lisp
123 lines
3.7 KiB
Common Lisp
;;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Base: 10 -*
|
|
|
|
(in-package :kenzo-test)
|
|
|
|
(in-suite :kenzo)
|
|
|
|
(test suspension-cmpr
|
|
(cat:cat-init)
|
|
(let* ((cc (cat:deltab))
|
|
(cmpr (cat:suspension-cmpr (cat:cmpr cc))))
|
|
(is (equal :equal (funcall cmpr :s-bsgn :s-bsgn)))
|
|
(is (equal :greater (funcall cmpr 6 5)))))
|
|
|
|
|
|
(test suspension-basis
|
|
(cat:cat-init)
|
|
(let* ((cc (cat:sphere 2))
|
|
(basis (cat:suspension-basis (cat:basis cc))))
|
|
(dotimes (i 6)
|
|
(print (funcall basis i)))
|
|
(cat:suspension-basis :locally-effective)))
|
|
|
|
|
|
(test suspension-intr-dffr
|
|
(cat:cat-init)
|
|
(let* ((cc (cat:deltab))
|
|
(intr (cat:suspension-intr-dffr (cat:dffr cc))))
|
|
(funcall intr (cat:cmbn 0 3 :s-bsgn))
|
|
(funcall intr (cat:cmbn 3 66 7))))
|
|
|
|
|
|
(test suspension
|
|
(cat:cat-init)
|
|
(let* ((cc (cat:deltab))
|
|
(scc (cat:suspension cc)))
|
|
(cat:cmpr scc 7 11)
|
|
(signals simple-error (cat:basis scc 3))
|
|
(cat:bsgn scc)
|
|
(cat:? scc 3 11)
|
|
(setf scc (cat:suspension cc 2))
|
|
(cat:? scc 4 11)))
|
|
|
|
|
|
(test coal
|
|
(cat:cat-init)
|
|
(let* ((coal (cat:deltab))
|
|
(scoal (cat:suspension coal)))
|
|
(setf scoal (cat:suspension coal))
|
|
(cat:? scoal 3 7)
|
|
(cat:cprd scoal 3 7)))
|
|
|
|
|
|
(test suspension-face
|
|
(cat:cat-init)
|
|
(let* ((ss (cat:deltab))
|
|
(face (cat:suspension-face (cat:face ss)))
|
|
(m (cat:moore 2 3)))
|
|
(funcall face 4 4 15)
|
|
(funcall face 0 4 15)
|
|
#+(or ecl sbcl)
|
|
(signals type-error (cat:check-faces #'cat:f-cmpr face 4 15))
|
|
#+(or ecl sbcl)
|
|
(signals type-error (cat:check-faces #'cat:f-cmpr face 3 7))
|
|
#+(or ecl sbcl)
|
|
(signals type-error (cat:check-faces #'cat:f-cmpr face 2 3))
|
|
#-(or ecl sbcl) (cat:check-faces #'cat:f-cmpr face 4 15)
|
|
#-(or ecl sbcl) (cat:check-faces #'cat:f-cmpr face 3 7)
|
|
#-(or ecl sbcl) (cat:check-faces #'cat:f-cmpr face 2 3)
|
|
(setf face (cat:suspension-face (cat:face m)))
|
|
(dotimes (i 5) (print (funcall face i 4 'm3)))
|
|
(dotimes (i 6) (print (funcall face i 5 'mm4)))
|
|
(cat:check-faces #'cat:s-cmpr face 4 'm3)
|
|
(cat:check-faces #'cat:s-cmpr face 5 'mm4)
|
|
))
|
|
|
|
|
|
(test suspension1
|
|
(cat:cat-init)
|
|
(let* ((d (cat:deltab))
|
|
(sd (cat:suspension d))
|
|
(m (cat:moore 2 1))
|
|
(sm (cat:suspension m)))
|
|
(setf sd (cat:suspension d))
|
|
(cat:? sd 3 7)
|
|
(cat:cprd sd 3 7)
|
|
(cat:face sd 3 3 7)
|
|
(cat:face sd 2 3 7)
|
|
(cat:homology sm 0 5)
|
|
(setf ssm (cat:suspension sm))
|
|
(cat:homology ssm 0 6)))
|
|
|
|
|
|
(test suspension2
|
|
(cat:cat-init)
|
|
(let* ((f (cat:idnt-mrph (cat:deltab)))
|
|
(sf (cat:suspension f))
|
|
(d (cat:dffr (cat:deltab)))
|
|
(sd (cat:suspension d)))
|
|
(cat:? sf (cat:cmbn 0 3 :s-bsgn))
|
|
(cat:? sf (cat:cmbn 2 4 3))
|
|
(cat:? sd (cat:cmbn 0 3 :s-bsgn))
|
|
(cat:? sd (cat:cmbn 2 4 3))
|
|
(cat:? sd (cat:cmbn 3 4 7))))
|
|
|
|
|
|
(test suspension3
|
|
(cat:cat-init)
|
|
(let* ((rdct (cat:ez (cat:deltab) (cat:deltab)))
|
|
(srdct (cat:suspension rdct)))
|
|
(cat:pre-check-rdct srdct)
|
|
(setf cat:*tc* (cat:cmbn 4 1 (cat:crpr 0 15 0 15)))
|
|
(setf cat:*bc* (cat:cmbn 4 1 (cat:tnpr 0 1 3 15)
|
|
5 (cat:tnpr 1 3 2 7)
|
|
10 (cat:tnpr 2 7 1 3)
|
|
100 (cat:tnpr 3 15 0 1)))
|
|
(check-rdct)))
|
|
|
|
|
|
(test suspension4
|
|
(cat:cat-init)
|
|
(let ((sk (cat:suspension (cat:k-z 2))))
|
|
(cat:homology sk 0 10)))
|