diff --git a/kenzo-test.asd b/kenzo-test.asd index f3c1365..4771f90 100644 --- a/kenzo-test.asd +++ b/kenzo-test.asd @@ -18,6 +18,7 @@ (:file "chcm-elementary-op-test") (:file "circle") (:file "cl-space-efhm-test") + (:file "classifying-spaces-test") (:file "combinations-test") (:file "cones-test") (:file "delta-test") diff --git a/package.lisp b/package.lisp index 0d94ada..f17f4e7 100644 --- a/package.lisp +++ b/package.lisp @@ -141,6 +141,7 @@ REDUCTION RRDCT SIMPLICIAL-GROUP + SINTR SORC TCC TNPR @@ -151,6 +152,9 @@ CLASSIFYING-SPACE CLASSIFYING-SPACE-BASIS CLASSIFYING-SPACE-CMPR + CLASSIFYING-SPACE-FACE + CLASSIFYING-SPACE-GRIN-SINTR + CLASSIFYING-SPACE-GRML-SINTR GBAR NORMALIZE-GBAR UNNORMALIZE-GBAR @@ -302,6 +306,7 @@ DGNL GNRT GRIN + GRML I-SBTR KFLL LF diff --git a/src/classifying-spaces.lisp b/src/classifying-spaces.lisp index f482a90..85db693 100644 --- a/src/classifying-spaces.lisp +++ b/src/classifying-spaces.lisp @@ -206,20 +206,11 @@ rslt (cons (a-grml4 sintr-grml (1- indx) (second mark) - (a-face4 face indx indx (first mark))) + (a-face4 face indx indx + (first mark))) (nthcdr 2 mark)))))))))) (the face #'rslt))) -#| -(setf om (loop-space (moore 2 2))) -(setf face (classifying-space-face (face om) (sintr (grml om)))) -(setf gbar (gbar 4 0 (loop3 3 'm2 1 4 'n3 1) - 0 (loop3 0 'n3 1) - 0 (loop3 0 'm2 1) - 0 +null-loop+)) -(dotimes (i 5) - (print (funcall face i 4 gbar))) -|# (DEFGENERIC CLASSIFYING-SPACE (smgr)) @@ -231,17 +222,6 @@ :face (classifying-space-face (face smgr) (sintr (grml smgr))) :orgn `(classifying-space ,smgr)))) -#| -(cat-init) -(setf c (classifying-space (k-z2-1))) -(orgn c) -(first (basis c 4)) -(? c 4 (first (basis c 4))) -(? c *) -(cprd c 4 ***) -(dotimes (i 5) - (print (face c i 4 (first (basis c 4))))) -|# (DEFUN CLASSIFYING-SPACE-GRML-SINTR (idnt sintr-grml) (declare @@ -265,16 +245,6 @@ absm-list-1 absm-list-2))))))) (the sintr #'rslt))) -#| -(setf grml (classifying-space-grml-sintr '() (sintr (grml (k-z-1))))) -(funcall grml 3 (crpr 0 (gbar 3 0 '(1 2) 0 '(3) 0 '()) - 0 (gbar 3 0 '(-1 -2) 0 '(-3) 0 '()))) -(funcall grml 3 (crpr 0 (gbar 3 0 '(1 2) 0 '(3) 0 '()) - 4 (gbar 2 0 '(-3) 0 '()))) -(funcall grml 3 (crpr 0 (gbar 3 0 '(1 2) 0 '(3) 0 '()) - 1 (gbar 2 0 '(-3) 0 '()))) -|# - (DEFUN CLASSIFYING-SPACE-GRIN-SINTR (sintr-grin) (declare (type sintr sintr-grin)) @@ -292,19 +262,15 @@ (gbar-list gbar)))))) (the sintr #'rslt))) -#| -(setf grin (classifying-space-grin-sintr (sintr (grin (k-z-1))))) -(funcall grin 3 (gbar 3 0 '(1 2) 1 '() 0 '())) -|# - (DEFMETHOD CLASSIFYING-SPACE ((smgr ab-simplicial-group)) (the ab-simplicial-group - (change-class + (change-class (build-smgr :cmpr (classifying-space-cmpr (cmpr smgr)) :basis (classifying-space-basis (basis smgr)) :bspn +null-gbar+ - :face (classifying-space-face (face smgr) (sintr (grml smgr))) + :face (classifying-space-face (face smgr) + (sintr (grml smgr))) :sintr-grml (classifying-space-grml-sintr (bspn smgr) (sintr (grml smgr))) @@ -312,16 +278,3 @@ (sintr (grin smgr))) :orgn `(classifying-space ,smgr)) 'ab-simplicial-group))) - -#| -(setf k-z-1 (k-z-1)) -(setf k-z-2 (classifying-space k-z-1)) -(setf k-z-3 (classifying-space k-z-2)) -(homology k-z-3 0 10) -(setf k-z2-1 (k-z2-1)) -(setf k-z2-2 (classifying-space k-z2-1)) -(setf k-z2-3 (classifying-space k-z2-2)) -(setf k-z2-4 (classifying-space k-z2-3)) -(setf k-z2-5 (classifying-space k-z2-4)) -(homology k-z2-5 0 7) -|# diff --git a/test/classifying-spaces-test.lisp b/test/classifying-spaces-test.lisp index dabb8d2..bb42245 100644 --- a/test/classifying-spaces-test.lisp +++ b/test/classifying-spaces-test.lisp @@ -67,13 +67,12 @@ (test gbar (cat:gbar 0) - (signals #-ecl simple-error - #+ecl simple-type-error (cat:gbar 1)) + (signals simple-error (cat:gbar 1)) (cat:gbar 2 1 'a 2 'b)) (test classifying-space-cmpr - (let ((cmpr (cat:classifying-space-cmpr 'cat:s-cmpr))) + (let ((cmpr (cat:classifying-space-cmpr #'cat:s-cmpr))) (is (equal :less (funcall cmpr (cat:gbar 2 0 'a 0 'a) (cat:gbar 2 1 'a 0 'a)))) @@ -92,12 +91,57 @@ (funcall b 0) (funcall b 1) (dotimes (i 5) (print (funcall b i))))) -#| -() -(cat-init) -(setf k (k-z2-1)) -(setf b (classifying-space-basis (basis k))) -(funcall b 0) -(funcall b 1) -(dotimes (i 5) (print (funcall b i))) -|# + +(test classifying-space-face + (let* ((om (cat:loop-space (cat:moore 2 2))) + (face (cat:classifying-space-face (cat:face om) + (cat:sintr (cat:grml om)))) + (gbar (cat:gbar 4 0 (cat:loop3 3 'm2 1 4 'n3 1) + 0 (cat:loop3 0 'n3 1) + 0 (cat:loop3 0 'm2 1) + 0 cat:+null-loop+))) + (dotimes (i 5) + (print (funcall face i 4 gbar))))) + + +(test classifying-space + (cat:cat-init) + (let ((c (cat:classifying-space (cat:k-z2-1)))) + (cat:orgn c) + (first (cat:basis c 4)) + (cat:? c 4 (first (cat:basis c 4))) + (cat:? c (cat:? c 4 (first (cat:basis c 4)))) + (cat:cprd c 4 (first (cat:basis c 4))) + (dotimes (i 5) + (print (cat:face c i 4 (first (cat:basis c 4))))))) + + +(test classifying-space-grml-sintr + (let ((grml (cat:classifying-space-grml-sintr + '() (cat:sintr (cat:grml (cat:k-z-1)))))) + (funcall grml 3 (cat:crpr 0 (cat:gbar 3 0 '(1 2) 0 '(3) 0 '()) + 0 (cat:gbar 3 0 '(-1 -2) 0 '(-3) 0 '()))) + (funcall grml 3 (cat:crpr 0 (cat:gbar 3 0 '(1 2) 0 '(3) 0 '()) + 4 (cat:gbar 2 0 '(-3) 0 '()))) + (funcall grml 3 (cat:crpr 0 (cat:gbar 3 0 '(1 2) 0 '(3) 0 '()) + 1 (cat:gbar 2 0 '(-3) 0 '()))))) + + +(test classifying-space-grin-sintr + (let ((grin (cat:classifying-space-grin-sintr + (cat:sintr (cat:grin (cat:k-z-1)))))) + (funcall grin 3 (cat:gbar 3 0 '(1 2) 1 '() 0 '())))) + + +(test classifying-space1 + (cat:cat-init) + (let* ((k-z-1 (cat:k-z-1)) + (k-z-2 (cat:classifying-space k-z-1)) + (k-z-3 (cat:classifying-space k-z-2)) + (k-z2-1 (cat:k-z2-1)) + (k-z2-2 (cat:classifying-space k-z2-1)) + (k-z2-3 (cat:classifying-space k-z2-2)) + (k-z2-4 (cat:classifying-space k-z2-3)) + (k-z2-5 (cat:classifying-space k-z2-4))) + (cat:homology k-z-3 0 10) + (cat:homology k-z2-5 0 7)))