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