Extracted last batch of classifying spaces tests.

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")

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

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,11 +262,6 @@
 			 (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
@@ -304,7 +269,8 @@
 	(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)
-|#

test/classifying-spaces-test.lisp

@@ -67,13 +67,12 @@
 
 (test gbar
       (cat:gbar 0)
-      (signals #-ecl simple-error
+      (signals simple-error (cat:gbar 1))
-	       #+ecl simple-type-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)))))
-#|
+
-()
+(test classifying-space-face
-(cat-init)
+      (let* ((om (cat:loop-space (cat:moore 2 2)))
-(setf k (k-z2-1))
+	     (face (cat:classifying-space-face (cat:face om)
-(setf b (classifying-space-basis (basis k)))
+					       (cat:sintr (cat:grml om))))
-(funcall b 0)
+	     (gbar (cat:gbar 4 0 (cat:loop3 3 'm2 1 4 'n3 1)
-(funcall b 1)
+			     0 (cat:loop3 0 'n3 1)
-(dotimes (i 5) (print (funcall b i)))
+			     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)))