mmarco/kenzo
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

Extracted last batch of classifying spaces tests.

Browse Source
This commit is contained in:
Gerd Heber 2015-07-22 06:57:19 -05:00
parent 23dd20c419
commit 3c0bf751c4
4 changed files with 67 additions and 64 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
kenzo-test.asd
View File

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

5
package.lisp
View File

@ -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

57
src/classifying-spaces.lisp
View File

@ -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)
|#

68
test/classifying-spaces-test.lisp
View File

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