Extracted suspensions tests.
This commit is contained in:
Gerd Heber
parent
bbffb8fb87
commit
f1ab0d41e8
@ -38,6 +38,7 @@
|
||||
(:file "simplicial-groups-test")
|
||||
(:file "simplicial-mrphs-test")
|
||||
(:file "simplicial-sets-test")
|
||||
(:file "suspensions-test")
|
||||
(:file "tensor-products-test")
|
||||
(:file "various-test")
|
||||
))
|
||||
|
||||
11
package.lisp
11
package.lisp
@ -121,6 +121,7 @@
|
||||
APOWR
|
||||
BCC
|
||||
BRGN
|
||||
BSGN
|
||||
BSPN
|
||||
CBGN
|
||||
CHAIN-COMPLEX
|
||||
@ -446,6 +447,16 @@
|
||||
SPHERE
|
||||
SPHERE-FACE
|
||||
|
||||
;; suspensions.lisp
|
||||
|
||||
SUSPENSION
|
||||
SUSPENSION-BASIS
|
||||
SUSPENSION-CMPR
|
||||
SUSPENSION-FACE
|
||||
SUSPENSION-INTR
|
||||
SUSPENSION-INTR-CPRD
|
||||
SUSPENSION-INTR-DFFR
|
||||
|
||||
;; tensor-products.lisp
|
||||
|
||||
2CMBN-TNPR
|
||||
|
||||
@ -12,15 +12,9 @@
|
||||
(declare (type gnrt gnrt1 gnrt2))
|
||||
(if (eq gnrt1 :s-bsgn)
|
||||
:equal
|
||||
(funcall cmpr gnrt1 gnrt2))))
|
||||
(funcall cmpr gnrt1 gnrt2))))
|
||||
(the cmprf #'rslt)))
|
||||
|
||||
#|
|
||||
(setf cc (deltab))
|
||||
(setf cmpr (suspension-cmpr (cmpr cc)))
|
||||
(funcall cmpr :s-bsgn :s-bsgn)
|
||||
(funcall cmpr 6 5)
|
||||
|#
|
||||
|
||||
(DEFUN SUSPENSION-BASIS (basis)
|
||||
(declare (type basis basis))
|
||||
@ -34,35 +28,23 @@
|
||||
(otherwise (funcall basis (1- degr))))))
|
||||
(the basis #'rslt)))
|
||||
|
||||
#|
|
||||
(setf cc (sphere 2))
|
||||
(setf basis (suspension-basis (basis cc)))
|
||||
(dotimes (i 6)
|
||||
(print (funcall basis i)))
|
||||
(suspension-basis :locally-effective)
|
||||
|#
|
||||
|
||||
(DEFUN SUSPENSION-INTR-DFFR (dffr)
|
||||
(declare (type morphism dffr))
|
||||
(flet ((rslt (cmbn)
|
||||
(declare (type cmbn cmbn))
|
||||
(with-cmbn (degr list) cmbn
|
||||
(decf degr)
|
||||
(if (<= degr 0)
|
||||
(zero-cmbn degr)
|
||||
(make-cmbn :degr degr
|
||||
:list (cmbn-list
|
||||
(cmbn-? dffr
|
||||
(make-cmbn :degr degr
|
||||
:list list))))))))
|
||||
(with-cmbn
|
||||
(degr list) cmbn
|
||||
(decf degr)
|
||||
(if (<= degr 0)
|
||||
(zero-cmbn degr)
|
||||
(make-cmbn :degr degr
|
||||
:list (cmbn-list
|
||||
(cmbn-? dffr
|
||||
(make-cmbn :degr degr
|
||||
:list list))))))))
|
||||
(the intr-mrph #'rslt)))
|
||||
|
||||
#|
|
||||
(setf cc (deltab))
|
||||
(setf intr (suspension-intr-dffr (dffr cc)))
|
||||
(funcall intr (cmbn 0 3 :s-bsgn))
|
||||
(funcall intr (cmbn 3 66 7))
|
||||
|#
|
||||
|
||||
(DEFUN SUSPENSION (obj &optional (n 1))
|
||||
(declare (type (or chain-complex morphism reduction
|
||||
@ -70,153 +52,101 @@
|
||||
(fixnum n))
|
||||
(if (= n 0)
|
||||
obj
|
||||
(suspension-1 (suspension obj (1- n)))))
|
||||
(suspension-1 (suspension obj (1- n)))))
|
||||
|
||||
|
||||
(DEFGENERIC SUSPENSION-1 (x))
|
||||
|
||||
|
||||
(DEFMETHOD SUSPENSION-1 ((chcm chain-complex))
|
||||
(the chain-complex
|
||||
(with-slots (cmpr basis dffr) chcm
|
||||
(build-chcm
|
||||
:cmpr (suspension-cmpr cmpr)
|
||||
:basis (suspension-basis basis)
|
||||
:bsgn :s-bsgn
|
||||
:intr-dffr (suspension-intr-dffr dffr)
|
||||
:strt :cmbn
|
||||
:orgn `(suspension ,chcm)))))
|
||||
(with-slots (cmpr basis dffr) chcm
|
||||
(build-chcm
|
||||
:cmpr (suspension-cmpr cmpr)
|
||||
:basis (suspension-basis basis)
|
||||
:bsgn :s-bsgn
|
||||
:intr-dffr (suspension-intr-dffr dffr)
|
||||
:strt :cmbn
|
||||
:orgn `(suspension ,chcm)))))
|
||||
|
||||
#|
|
||||
(cat-init)
|
||||
(setf cc (deltab))
|
||||
(setf scc (suspension cc))
|
||||
(cmpr scc 7 11)
|
||||
(basis scc 3) ;; error
|
||||
(bsgn scc)
|
||||
(? scc 3 11)
|
||||
(setf scc (suspension cc 2))
|
||||
(? scc 4 11)
|
||||
|#
|
||||
|
||||
(DEFUN SUSPENSION-INTR-CPRD (cmbn)
|
||||
(declare (type cmbn cmbn))
|
||||
(the cmbn
|
||||
(with-cmbn (degr list) cmbn
|
||||
(if (zerop degr)
|
||||
(make-cmbn :degr 0
|
||||
:list (if list
|
||||
(list (term (-cffc list)
|
||||
(tnpr 0 :s-bsgn
|
||||
0 :s-bsgn)))
|
||||
+empty-list+))
|
||||
(make-cmbn :degr degr
|
||||
:list (let ((list1 +empty-list+)
|
||||
(list2 +empty-list+))
|
||||
(declare (list list1 list2))
|
||||
(mapc
|
||||
#'(lambda (term)
|
||||
(declare (type term term))
|
||||
(with-term (cffc gnrt) term
|
||||
(push (term cffc
|
||||
(tnpr 0 :s-bsgn
|
||||
degr gnrt))
|
||||
list1)
|
||||
(push (term cffc
|
||||
(tnpr degr gnrt
|
||||
0 :s-bsgn))
|
||||
list2)))
|
||||
list)
|
||||
(nreconc list1 (nreverse list2))))))))
|
||||
(with-cmbn
|
||||
(degr list) cmbn
|
||||
(if (zerop degr)
|
||||
(make-cmbn :degr 0
|
||||
:list (if list
|
||||
(list (term (-cffc list)
|
||||
(tnpr 0 :s-bsgn
|
||||
0 :s-bsgn)))
|
||||
+empty-list+))
|
||||
(make-cmbn :degr degr
|
||||
:list (let ((list1 +empty-list+)
|
||||
(list2 +empty-list+))
|
||||
(declare (list list1 list2))
|
||||
(mapc
|
||||
#'(lambda (term)
|
||||
(declare (type term term))
|
||||
(with-term
|
||||
(cffc gnrt) term
|
||||
(push (term cffc
|
||||
(tnpr 0 :s-bsgn
|
||||
degr gnrt))
|
||||
list1)
|
||||
(push (term cffc
|
||||
(tnpr degr gnrt
|
||||
0 :s-bsgn))
|
||||
list2)))
|
||||
list)
|
||||
(nreconc list1 (nreverse list2))))))))
|
||||
|
||||
#|
|
||||
(suspension-intr-cprd (cmbn 0))
|
||||
(suspension-intr-cprd (cmbn 0 5 :s-bsgn))
|
||||
(suspension-intr-cprd (cmbn 3 4 7 5 11))
|
||||
|#
|
||||
|
||||
(DEFMETHOD SUSPENSION-1 ((clgb coalgebra))
|
||||
(the coalgebra
|
||||
(let ((irslt (call-next-method)))
|
||||
(declare (type (or chain-complex coalgebra) irslt))
|
||||
(when (typep irslt 'coalgebra)
|
||||
(return-from suspension-1 irslt))
|
||||
(change-chcm-to-clgb irslt :intr-cprd #'suspension-intr-cprd
|
||||
:cprd-strt :cmbn)
|
||||
(setf (slot-value irslt 'orgn) `(suspension ,clgb))
|
||||
(setf (slot-value (slot-value irslt 'cprd) 'orgn)
|
||||
`(coproduct ,irslt))
|
||||
irslt)))
|
||||
(let ((irslt (call-next-method)))
|
||||
(declare (type (or chain-complex coalgebra) irslt))
|
||||
(when (typep irslt 'coalgebra)
|
||||
(return-from suspension-1 irslt))
|
||||
(change-chcm-to-clgb irslt :intr-cprd #'suspension-intr-cprd
|
||||
:cprd-strt :cmbn)
|
||||
(setf (slot-value irslt 'orgn) `(suspension ,clgb))
|
||||
(setf (slot-value (slot-value irslt 'cprd) 'orgn)
|
||||
`(coproduct ,irslt))
|
||||
irslt)))
|
||||
|
||||
#|
|
||||
(cat-init)
|
||||
(setf coal (deltab))
|
||||
(setf scoal (suspension coal))
|
||||
(setf scoal (suspension coal))
|
||||
(? scoal 3 7)
|
||||
(cprd scoal 3 7)
|
||||
|#
|
||||
|
||||
(DEFUN SUSPENSION-FACE (face)
|
||||
(declare (type face face))
|
||||
(flet ((rslt (indx dmns gmsm)
|
||||
(declare
|
||||
(fixnum indx dmns)
|
||||
(type gmsm gmsm))
|
||||
(fixnum indx dmns)
|
||||
(type gmsm gmsm))
|
||||
(assert (> dmns 1))
|
||||
(if (= indx dmns)
|
||||
(absm (mask (1- dmns)) :s-bsgn)
|
||||
(let ((irslt (funcall face indx (1- dmns) gmsm)))
|
||||
(declare (type absm irslt))
|
||||
(if (= (dgop irslt) (mask (- dmns 2)))
|
||||
(absm (mask (1- dmns)) :s-bsgn)
|
||||
irslt)))))
|
||||
(the face #'rslt)))
|
||||
(let ((irslt (funcall face indx (1- dmns) gmsm)))
|
||||
(declare (type absm irslt))
|
||||
(if (= (dgop irslt) (mask (- dmns 2)))
|
||||
(absm (mask (1- dmns)) :s-bsgn)
|
||||
irslt)))))
|
||||
(the face #'rslt)))
|
||||
|
||||
#|
|
||||
(setf ss (deltab))
|
||||
(setf face (suspension-face (face ss)))
|
||||
(funcall face 4 4 15)
|
||||
(funcall face 0 4 15)
|
||||
(check-faces #'f-cmpr face 4 15)
|
||||
(check-faces #'f-cmpr face 3 7)
|
||||
(check-faces #'f-cmpr face 2 3)
|
||||
(setf m (moore 2 3))
|
||||
(setf face (suspension-face (face m)))
|
||||
(dotimes (i 5) (print (funcall face i 4 'm3)))
|
||||
(dotimes (i 6) (print (funcall face i 5 'mm4)))
|
||||
(check-faces #'s-cmpr face 4 'm3)
|
||||
(check-faces #'s-cmpr face 5 'mm4)
|
||||
|#
|
||||
|
||||
(DEFMETHOD SUSPENSION-1 ((smst simplicial-set))
|
||||
(the simplicial-set
|
||||
(let ((irslt (call-next-method)))
|
||||
(declare (type coalgebra irslt))
|
||||
(when (typep irslt 'simplicial-set)
|
||||
(return-from suspension-1 irslt))
|
||||
(change-class irslt 'simplicial-set)
|
||||
(setf (slot-value irslt 'face)
|
||||
(suspension-face (face smst)))
|
||||
(setf (slot-value (slot-value irslt 'cprd) 'orgn)
|
||||
`(diagonal ,irslt))
|
||||
irslt)))
|
||||
(let ((irslt (call-next-method)))
|
||||
(declare (type coalgebra irslt))
|
||||
(when (typep irslt 'simplicial-set)
|
||||
(return-from suspension-1 irslt))
|
||||
(change-class irslt 'simplicial-set)
|
||||
(setf (slot-value irslt 'face)
|
||||
(suspension-face (face smst)))
|
||||
(setf (slot-value (slot-value irslt 'cprd) 'orgn)
|
||||
`(diagonal ,irslt))
|
||||
irslt)))
|
||||
|
||||
#|
|
||||
(cat-init)
|
||||
(setf d (deltab))
|
||||
(setf sd (suspension d))
|
||||
(setf sd (suspension d))
|
||||
(inspect sd)
|
||||
(? sd 3 7)
|
||||
(cprd sd 3 7)
|
||||
(face sd 3 3 7)
|
||||
(face sd 2 3 7)
|
||||
(setf m (moore 2 1))
|
||||
(setf sm (suspension m))
|
||||
(homology sm 0 5)
|
||||
(setf ssm (suspension sm))
|
||||
(homology ssm 0 6)
|
||||
|#
|
||||
|
||||
(DEFUN SUSPENSION-INTR (mrph)
|
||||
(declare (type morphism mrph))
|
||||
@ -224,101 +154,65 @@
|
||||
(declare (fixnum mdegr))
|
||||
(flet ((rslt (cmbn)
|
||||
(declare (type cmbn cmbn))
|
||||
(with-cmbn (cdegr list) cmbn
|
||||
(when (zerop cdegr)
|
||||
(return-from rslt
|
||||
(if (zerop mdegr)
|
||||
cmbn
|
||||
(zero-cmbn (+ mdegr cdegr)))))
|
||||
(make-cmbn :degr (+ mdegr cdegr)
|
||||
:list (cmbn-list
|
||||
(cmbn-? mrph (make-cmbn :degr (1- cdegr)
|
||||
:list list)))))))
|
||||
(the intr-mrph #'rslt))))
|
||||
(with-cmbn
|
||||
(cdegr list) cmbn
|
||||
(when (zerop cdegr)
|
||||
(return-from rslt
|
||||
(if (zerop mdegr)
|
||||
cmbn
|
||||
(zero-cmbn (+ mdegr cdegr)))))
|
||||
(make-cmbn :degr (+ mdegr cdegr)
|
||||
:list (cmbn-list
|
||||
(cmbn-? mrph (make-cmbn :degr (1- cdegr)
|
||||
:list list)))))))
|
||||
(the intr-mrph #'rslt))))
|
||||
|
||||
#|
|
||||
(setf f (idnt-mrph (deltab)))
|
||||
(setf sf (suspension-intr f))
|
||||
(funcall sf (cmbn 0 3 :s-bsgn))
|
||||
(funcall sf (cmbn 2 4 3))
|
||||
(setf d (dffr (deltab)))
|
||||
(setf sd (suspension-intr d))
|
||||
(funcall sd (cmbn 0 3 :s-bsgn))
|
||||
(funcall sd (cmbn 2 4 3))
|
||||
(funcall sd (cmbn 3 4 7))
|
||||
|#
|
||||
|
||||
(DEFMETHOD SUSPENSION-1 ((mrph morphism))
|
||||
(the morphism
|
||||
(let ((orgn (orgn mrph)))
|
||||
(declare (list orgn))
|
||||
(when (eq (first orgn) 'zero-mrph)
|
||||
(return-from suspension-1
|
||||
(zero-mrph (suspension (sorc mrph))
|
||||
(suspension (trgt mrph))
|
||||
(degr mrph))))
|
||||
(when (eq (first orgn) 'idnt-mrph)
|
||||
(return-from suspension-1
|
||||
(idnt-mrph (suspension (sorc mrph)))))
|
||||
(build-mrph
|
||||
:sorc (suspension (sorc mrph))
|
||||
:trgt (suspension (trgt mrph))
|
||||
:degr (degr mrph)
|
||||
:intr (suspension-intr mrph)
|
||||
:strt :cmbn
|
||||
:orgn `(suspension ,mrph)))))
|
||||
(let ((orgn (orgn mrph)))
|
||||
(declare (list orgn))
|
||||
(when (eq (first orgn) 'zero-mrph)
|
||||
(return-from suspension-1
|
||||
(zero-mrph (suspension (sorc mrph))
|
||||
(suspension (trgt mrph))
|
||||
(degr mrph))))
|
||||
(when (eq (first orgn) 'idnt-mrph)
|
||||
(return-from suspension-1
|
||||
(idnt-mrph (suspension (sorc mrph)))))
|
||||
(build-mrph
|
||||
:sorc (suspension (sorc mrph))
|
||||
:trgt (suspension (trgt mrph))
|
||||
:degr (degr mrph)
|
||||
:intr (suspension-intr mrph)
|
||||
:strt :cmbn
|
||||
:orgn `(suspension ,mrph)))))
|
||||
|
||||
#|
|
||||
(setf f (idnt-mrph (deltab)))
|
||||
(setf sf (suspension f))
|
||||
(? sf (cmbn 0 3 :s-bsgn))
|
||||
(? sf (cmbn 2 4 3))
|
||||
(setf d (dffr (deltab)))
|
||||
(setf sd (suspension d))
|
||||
(? sd (cmbn 0 3 :s-bsgn))
|
||||
(? sd (cmbn 2 4 3))
|
||||
(? sd (cmbn 3 4 7))
|
||||
|#
|
||||
|
||||
(DEFMETHOD SUSPENSION-1 ((rdct reduction))
|
||||
(the reduction (progn
|
||||
(when (eq (first (orgn rdct)) 'trivial-rdct)
|
||||
(return-from suspension-1
|
||||
(trivial-rdct (suspension (second (orgn rdct))))))
|
||||
(build-rdct
|
||||
:f (suspension (f rdct))
|
||||
:g (suspension (g rdct))
|
||||
:h (suspension (h rdct))
|
||||
:orgn `(suspension ,rdct)))))
|
||||
(when (eq (first (orgn rdct)) 'trivial-rdct)
|
||||
(return-from suspension-1
|
||||
(trivial-rdct (suspension (second (orgn rdct))))))
|
||||
(build-rdct
|
||||
:f (suspension (f rdct))
|
||||
:g (suspension (g rdct))
|
||||
:h (suspension (h rdct))
|
||||
:orgn `(suspension ,rdct)))))
|
||||
|
||||
#|
|
||||
(setf rdct (ez (deltab) (deltab)))
|
||||
(setf srdct (suspension rdct))
|
||||
(pre-check-rdct srdct)
|
||||
(setf *tc* (cmbn 4 1 (crpr 0 15 0 15)))
|
||||
(setf *bc* (cmbn 4 1 (tnpr 0 1 3 15)
|
||||
5 (tnpr 1 3 2 7)
|
||||
10 (tnpr 2 7 1 3)
|
||||
100 (tnpr 3 15 0 1)))
|
||||
(check-rdct)
|
||||
|#
|
||||
|
||||
(DEFMETHOD SUSPENSION-1 ((hmeq homotopy-equivalence))
|
||||
(the homotopy-equivalence (progn
|
||||
(when (eq (first (orgn hmeq)) 'trivial-hmeq)
|
||||
(return-from suspension-1
|
||||
(trivial-hmeq (suspension (second (orgn hmeq))))))
|
||||
(build-hmeq
|
||||
:lrdct (suspension (lrdct hmeq))
|
||||
:rrdct (suspension (rrdct hmeq))
|
||||
:orgn `(suspension ,hmeq)))))
|
||||
(when (eq (first (orgn hmeq)) 'trivial-hmeq)
|
||||
(return-from suspension-1
|
||||
(trivial-hmeq (suspension
|
||||
(second (orgn hmeq))))))
|
||||
(build-hmeq
|
||||
:lrdct (suspension (lrdct hmeq))
|
||||
:rrdct (suspension (rrdct hmeq))
|
||||
:orgn `(suspension ,hmeq)))))
|
||||
|
||||
|
||||
(DEFMETHOD SEARCH-EFHM (suspension (orgn (eql 'suspension)))
|
||||
(declare (type chain-complex suspension))
|
||||
(suspension (efhm (second (orgn suspension)))))
|
||||
|
||||
#|
|
||||
(setf sk (suspension (k-z 2)))
|
||||
(homology sk 0 10)
|
||||
|#
|
||||
|
||||
|
||||
@ -224,6 +224,7 @@
|
||||
(defun random-cmbn (cmpr degr max-cffc max-expn loop-length cmbn-length)
|
||||
(apply #'cat:nterm-add cmpr degr
|
||||
(mapcar #'(lambda (dummy)
|
||||
(declare (ignore dummy))
|
||||
(cat:term (cat:srandom max-cffc)
|
||||
(random-crpr degr max-expn loop-length)))
|
||||
(make-list cmbn-length))))
|
||||
@ -255,5 +256,6 @@
|
||||
|
||||
(defun random-niloop (dmns max-expn length)
|
||||
(mapcar #'(lambda (dummy)
|
||||
(declare (ignore dummy))
|
||||
(random-apowr (1+ dmns) max-expn))
|
||||
(make-list length)))
|
||||
|
||||
133
test/suspensions-test.lisp
Normal file
133
test/suspensions-test.lisp
Normal file
@ -0,0 +1,133 @@
|
||||
|
||||
(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 suspension-intr-cprd
|
||||
(cat:suspension-intr-cprd (cat:cmbn 0))
|
||||
(cat:suspension-intr-cprd (cat:cmbn 0 5 :s-bsgn))
|
||||
(cat:suspension-intr-cprd (cat:cmbn 3 4 7 5 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)
|
||||
(cat:check-faces #'cat:f-cmpr face 4 15)
|
||||
(cat:check-faces #'cat:f-cmpr face 3 7)
|
||||
(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 suspension-intr
|
||||
(cat:cat-init)
|
||||
(let* ((f (cat:idnt-mrph (cat:deltab)))
|
||||
(sf (cat:suspension-intr f))
|
||||
(d (cat:dffr (cat:deltab)))
|
||||
(sd (cat:suspension-intr d)))
|
||||
(funcall sf (cat:cmbn 0 3 :s-bsgn))
|
||||
(funcall sf (cat:cmbn 2 4 3))
|
||||
(funcall sd (cat:cmbn 0 3 :s-bsgn))
|
||||
(funcall sd (cat:cmbn 2 4 3))
|
||||
(funcall sd (cat:cmbn 3 4 7))))
|
||||
|
||||
|
||||
(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)))
|
||||
Loading…
Reference in New Issue
Block a user