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

Extracted k-pi-n tests.

Browse Source
This commit is contained in:
Gerd Heber 2015-07-24 20:01:33 -05:00
parent f670848a49
commit 1ea365ec1e
3 changed files with 166 additions and 141 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

6
package.lisp
View File

@ -302,12 +302,18 @@
KZ1-RDCT KZ1-RDCT
KZ1-RDCT-F-INTR KZ1-RDCT-F-INTR
KZ1-RDCT-H-INTR KZ1-RDCT-H-INTR
K-Z-FUNDAMENTAL-CLASS
K-Z2-FUNDAMENTAL-CLASS
Z-ABSM-BAR Z-ABSM-BAR
Z-BAR-ABSM Z-BAR-ABSM
Z-FUNDAMENTAL-GMSM Z-FUNDAMENTAL-GMSM
Z2-ABSM-BAR Z2-ABSM-BAR
Z2-BAR-ABSM Z2-BAR-ABSM
Z2-FUNDAMENTAL-GMSM
Z-COCYCLE-GBAR Z-COCYCLE-GBAR
Z-COCYCLE-GBAR-HEAD
Z2-COCYCLE-GBAR
Z2-COCYCLE-GBAR-HEAD
;; kan.lisp ;; kan.lisp

145
src/k-pi-n.lisp
View File

@ -602,55 +602,6 @@
cocycle2) cocycle2)
(z-cocycle-gbar (1- n) (1- dmns) cocycle2)))))) (z-cocycle-gbar (1- n) (1- dmns) cocycle2))))))
#|
(cat-init)
(setf d (delta 10))
(setf chml-clss
(build-mrph :sorc d :trgt (z-chcm) :degr -1
:intr #'(lambda (dmns gmsm)
(term-cmbn 0 gmsm :gnrt-z))
:strt :gnrt
:orgn '(essai-1)))
(gmsm-cocycle (face d) 1 4 31 chml-clss)
(z-cocycle-gbar 1 4 *)
(z-cocycle-gbar-head 1 4 **)
(setf chml-clss
(build-mrph :sorc d :trgt (z-chcm) :degr -2
:intr #'(lambda (dmns gmsm)
(term-cmbn 0 gmsm :gnrt-z))
:strt :gnrt
:orgn '(essai-2)))
(gmsm-cocycle (face d) 2 2 7 chml-clss)
(z-cocycle-gbar 2 2 *)
(z-cocycle-gbar-head 2 2 **)
(gmsm-cocycle (face d) 2 2 0 chml-clss) ;; normally illegal
(z-cocycle-gbar 2 2 *)
(z-cocycle-gbar-head 2 2 **)
(gmsm-cocycle (face d) 2 3 15 chml-clss)
(z-cocycle-gbar 2 3 *)
(z-cocycle-gbar-head 2 3 **)
(gmsm-cocycle (face d) 2 4 31 chml-clss)
(z-cocycle-gbar 2 4 *)
(z-cocycle-gbar-head 2 4 **)
(setf chml-clss
(build-mrph :sorc d :trgt (z-chcm) :degr -3
:intr #'(lambda (dmns gmsm)
(term-cmbn 0 gmsm :gnrt-z))
:strt :gnrt
:orgn '(essai-3)))
(gmsm-cocycle (face d) 3 4 31 chml-clss)
(z-cocycle-gbar 3 4 *)
(z-cocycle-gbar-head 3 4 **)
(setf chml-clss
(build-mrph :sorc d :trgt (z-chcm) :degr -3
:intr #'(lambda (dmns gmsm)
(zero-cmbn 0))
:strt :gnrt
:orgn '(essai-33)))
(gmsm-cocycle (face d) 3 4 31 chml-clss)
(z-cocycle-gbar 3 4 *)
(z-cocycle-gbar-head 3 4 **)
|#
(DEFUN Z2-FUNDAMENTAL-GMSM (dmns pi-elm) ;; pi-elm not "equal" to 0, therefore 1. (DEFUN Z2-FUNDAMENTAL-GMSM (dmns pi-elm) ;; pi-elm not "equal" to 0, therefore 1.
(declare (fixnum dmns pi-elm)) (declare (fixnum dmns pi-elm))
@ -660,19 +611,14 @@
(let ((bspn (if (= 2 dmns) 0 +null-gbar+))) (let ((bspn (if (= 2 dmns) 0 +null-gbar+)))
(declare (type gmsm bspn)) (declare (type gmsm bspn))
(make-gbar :dmns dmns (make-gbar :dmns dmns
:list (cons (absm 0 (Z2-fundamental-gmsm (1- dmns) pi-elm)) :list (cons (absm 0 (Z2-fundamental-gmsm (1- dmns)
pi-elm))
(mapcar (mapcar
#'(lambda (k) #'(lambda (k)
(declare (fixnum k)) (declare (fixnum k))
(absm (mask k) bspn)) (absm (mask k) bspn))
(nreverse (<a-b> 0 (- dmns 2)))))))))) (nreverse (<a-b> 0 (- dmns 2))))))))))
#|
(Z2-fundamental-gmsm 1 1)
(Z2-fundamental-gmsm 2 1)
(Z2-fundamental-gmsm 3 1)
(Z2-fundamental-gmsm 4 1)
|#
(DEFUN Z2-COCYCLE-GBAR (n dmns cocycle) (DEFUN Z2-COCYCLE-GBAR (n dmns cocycle)
;; cocycle \in Z^n(\Delta^{dmns}, \pi) with \pi = Z/2Z ;; cocycle \in Z^n(\Delta^{dmns}, \pi) with \pi = Z/2Z
@ -723,43 +669,10 @@
(normalize-gbar (normalize-gbar
(cons dmns (cons dmns
(cons head-absm (cons head-absm
(rest (unnormalize-gbar tail-absm (rest (unnormalize-gbar
tail-absm
(if (= n 2) 0 +null-gbar+))))))))))))) (if (= n 2) 0 +null-gbar+)))))))))))))
#|
(cat-init)
(setf d (delta 10))
(setf chml-clss
(build-mrph :sorc d :trgt (z-chcm) :degr -1
:intr #'(lambda (dmns gmsm)
(term-cmbn 0 (mod gmsm 2) :gnrt-z))
:strt :gnrt
:orgn '(essai-1)))
(gmsm-cocycle (face d) 1 4 31 chml-clss)
(z2-cocycle-gbar 1 4 *)
(setf chml-clss
(build-mrph :sorc d :trgt (z-chcm) :degr -2
:intr #'(lambda (dmns gmsm)
(term-cmbn 0 (mod gmsm 2) :gnrt-z))
:strt :gnrt
:orgn '(essai-2)))
(gmsm-cocycle (face d) 2 2 7 chml-clss)
(z2-cocycle-gbar 2 2 *)
(gmsm-cocycle (face d) 2 2 0 chml-clss) ;; normally illegal
(z2-cocycle-gbar 2 2 *)
(gmsm-cocycle (face d) 2 3 15 chml-clss)
(z2-cocycle-gbar 2 3 *)
(gmsm-cocycle (face d) 2 4 31 chml-clss)
(z2-cocycle-gbar 2 4 *)
(setf chml-clss
(build-mrph :sorc d :trgt (z-chcm) :degr -3
:intr #'(lambda (dmns gmsm)
(term-cmbn 0 (mod gmsm 2) :gnrt-z))
:strt :gnrt
:orgn '(essai-3)))
(gmsm-cocycle (face d) 3 4 31 chml-clss)
(z2-cocycle-gbar 3 4 *)
|#
(DEFUN Z2-COCYCLE-GBAR-HEAD (n dmns cocycle) (DEFUN Z2-COCYCLE-GBAR-HEAD (n dmns cocycle)
;; cocycle \in Z^n(\Delta^{dmns}, \pi) with \pi = Z/2Z ;; cocycle \in Z^n(\Delta^{dmns}, \pi) with \pi = Z/2Z
@ -775,7 +688,7 @@
cocycle) cocycle)
(cond ((= n 1) (cond ((= n 1)
(error "In Z2-COCYCLE-GBAR-HEAD, this point should not have been reached.")) (error "In Z2-COCYCLE-GBAR-HEAD, this point should not have been reached."))
; (z2-bar-absm (nreverse (mapcar #'cdr cocycle)))) ;; (z2-bar-absm (nreverse (mapcar #'cdr cocycle))))
((= n dmns) ((= n dmns)
(let ((value (cdr (first cocycle)))) (let ((value (cdr (first cocycle))))
(declare (fixnum value)) (declare (fixnum value))
@ -808,46 +721,6 @@
cocycle2) cocycle2)
(z2-cocycle-gbar (1- n) (1- dmns) cocycle2))))))) (z2-cocycle-gbar (1- n) (1- dmns) cocycle2)))))))
#|
(cat-init)
(setf d (delta 10))
(setf chml-clss
(build-mrph :sorc d :trgt (z-chcm) :degr -1
:intr #'(lambda (dmns gmsm)
(term-cmbn 0 (mod gmsm 2) :gnrt-z))
:strt :gnrt
:orgn '(essai-1)))
(gmsm-cocycle (face d) 1 4 31 chml-clss)
(z2-cocycle-gbar 1 4 *)
(z2-cocycle-gbar-head 1 4 **)
(setf chml-clss
(build-mrph :sorc d :trgt (z-chcm) :degr -2
:intr #'(lambda (dmns gmsm)
(term-cmbn 0 (mod gmsm 2) :gnrt-z))
:strt :gnrt
:orgn '(essai-2)))
(gmsm-cocycle (face d) 2 2 7 chml-clss)
(z2-cocycle-gbar 2 2 *)
(z2-cocycle-gbar-head 2 2 **)
(gmsm-cocycle (face d) 2 2 0 chml-clss) ;; normally illegal
(z2-cocycle-gbar 2 2 *)
(z2-cocycle-gbar-head 2 2 **)
(gmsm-cocycle (face d) 2 3 15 chml-clss)
(z2-cocycle-gbar 2 3 *)
(z2-cocycle-gbar-head 2 3 **)
(gmsm-cocycle (face d) 2 4 31 chml-clss)
(z2-cocycle-gbar 2 4 *)
(z2-cocycle-gbar-head 2 4 **)
(setf chml-clss
(build-mrph :sorc d :trgt (z-chcm) :degr -3
:intr #'(lambda (dmns gmsm)
(term-cmbn 0 (mod gmsm 2) :gnrt-z))
:strt :gnrt
:orgn '(essai-3)))
(gmsm-cocycle (face d) 3 4 31 chml-clss)
(z2-cocycle-gbar 3 4 *)
(z2-cocycle-gbar-head 3 4 **)
|#
(DEFUN K-Z-FUNDAMENTAL-CLASS (n) (DEFUN K-Z-FUNDAMENTAL-CLASS (n)
(declare (fixnum n)) (declare (fixnum n))
@ -870,14 +743,6 @@
:strt :gnrt :strt :gnrt
:orgn `(k-z-fundamental-class ,n)))) :orgn `(k-z-fundamental-class ,n))))
#|
(cat-init)
(setf c1 (k-z-fundamental-class 1))
(? c1 1 '(34))
(? c1 2 '(34 45))
(setf c3 (k-z-fundamental-class 3))
(? c3 3 (z-fundamental-gmsm 3 45))
|#
(DEFUN K-Z2-FUNDAMENTAL-CLASS (n) (DEFUN K-Z2-FUNDAMENTAL-CLASS (n)
(declare (fixnum n)) (declare (fixnum n))

154
test/k-pi-n-test.lisp
View File

@ -217,3 +217,157 @@
(cat:gmsm-cocycle (cat:face d) 3 4 31 chml-clss) (cat:gmsm-cocycle (cat:face d) 3 4 31 chml-clss)
(cat:z-cocycle-gbar 3 4 (cat:gmsm-cocycle (cat:face d) (cat:z-cocycle-gbar 3 4 (cat:gmsm-cocycle (cat:face d)
3 4 31 chml-clss)))) 3 4 31 chml-clss))))
(test z-cocycle-gbar-head
(cat:cat-init)
(let* ((d (cat:delta 10))
(chml-clss
(cat:build-mrph :sorc d :trgt (cat:z-chcm) :degr -1
:intr #'(lambda (dmns gmsm)
(cat:term-cmbn 0 gmsm :gnrt-z))
:strt :gnrt
:orgn '(essai-1)))
(x (cat:gmsm-cocycle (cat:face d) 1 4 31 chml-clss)))
(cat:z-cocycle-gbar 1 4 x)
(signals simple-error (cat:z-cocycle-gbar-head 1 4 x))
(setf chml-clss
(cat:build-mrph :sorc d :trgt (cat:z-chcm) :degr -2
:intr #'(lambda (dmns gmsm)
(cat:term-cmbn 0 gmsm :gnrt-z))
:strt :gnrt
:orgn '(essai-2)))
(setf x (cat:gmsm-cocycle (cat:face d) 2 2 7 chml-clss))
(cat:z-cocycle-gbar 2 2 x)
(cat:z-cocycle-gbar-head 2 2 x)
;; normally illegal
(setf x (cat:gmsm-cocycle (cat:face d) 2 2 0 chml-clss))
(cat:z-cocycle-gbar 2 2 x)
(cat:z-cocycle-gbar-head 2 2 x)
(setf x (cat:gmsm-cocycle (cat:face d) 2 3 15 chml-clss))
(cat:z-cocycle-gbar 2 3 x)
(cat:z-cocycle-gbar-head 2 3 x)
(setf x (cat:gmsm-cocycle (cat:face d) 2 4 31 chml-clss))
(cat:z-cocycle-gbar 2 4 x)
(cat:z-cocycle-gbar-head 2 4 x)
(setf chml-clss
(cat:build-mrph :sorc d :trgt (cat:z-chcm) :degr -3
:intr #'(lambda (dmns gmsm)
(cat:term-cmbn 0 gmsm :gnrt-z))
:strt :gnrt
:orgn '(essai-3)))
(setf x (cat:gmsm-cocycle (cat:face d) 3 4 31 chml-clss))
(cat:z-cocycle-gbar 3 4 x)
(cat:z-cocycle-gbar-head 3 4 x)
(setf chml-clss
(cat:build-mrph :sorc d :trgt (cat:z-chcm) :degr -3
:intr #'(lambda (dmns gmsm)
(cat:zero-cmbn 0))
:strt :gnrt
:orgn '(essai-33)))
(setf x (cat:gmsm-cocycle (cat:face d) 3 4 31 chml-clss))
(cat:z-cocycle-gbar 3 4 x)
(cat:z-cocycle-gbar-head 3 4 x)))
(test Z2-fundamental-gmsm
(cat:Z2-fundamental-gmsm 1 1)
(cat:Z2-fundamental-gmsm 2 1)
(cat:Z2-fundamental-gmsm 3 1)
(cat:Z2-fundamental-gmsm 4 1))
(test z2-cocycle-gbar
(cat:cat-init)
(let* ((d (cat:delta 10))
(chml-clss
(cat:build-mrph :sorc d :trgt (cat:z-chcm) :degr -1
:intr #'(lambda (dmns gmsm)
(cat:term-cmbn 0 (mod gmsm 2) :gnrt-z))
:strt :gnrt
:orgn '(essai-1)))
(x (cat:gmsm-cocycle (cat:face d) 1 4 31 chml-clss)))
(cat:z2-cocycle-gbar 1 4 x)
(setf chml-clss
(cat:build-mrph :sorc d :trgt (cat:z-chcm) :degr -2
:intr #'(lambda (dmns gmsm)
(cat:term-cmbn 0 (mod gmsm 2) :gnrt-z))
:strt :gnrt
:orgn '(essai-2)))
(setf x (cat:gmsm-cocycle (cat:face d) 2 2 7 chml-clss))
(cat:z2-cocycle-gbar 2 2 x)
;; normally illegal
(setf x (cat:gmsm-cocycle (cat:face d) 2 2 0 chml-clss))
(cat:z2-cocycle-gbar 2 2 x)
(setf x (cat:gmsm-cocycle (cat:face d) 2 3 15 chml-clss))
(cat:z2-cocycle-gbar 2 3 x)
(setf x (cat:gmsm-cocycle (cat:face d) 2 4 31 chml-clss))
(cat:z2-cocycle-gbar 2 4 x)
(setf chml-clss
(cat:build-mrph :sorc d :trgt (cat:z-chcm) :degr -3
:intr #'(lambda (dmns gmsm)
(cat:term-cmbn 0 (mod gmsm 2) :gnrt-z))
:strt :gnrt
:orgn '(essai-3)))
(setf x (cat:gmsm-cocycle (cat:face d) 3 4 31 chml-clss))
(cat:z2-cocycle-gbar 3 4 x)))
(test z2-cocycle-gbar-head
(cat:cat-init)
(let* ((d (cat:delta 10))
(chml-clss
(cat:build-mrph :sorc d :trgt (cat:z-chcm) :degr -1
:intr #'(lambda (dmns gmsm)
(cat:term-cmbn 0 (mod gmsm 2) :gnrt-z))
:strt :gnrt
:orgn '(essai-1)))
(x (cat:gmsm-cocycle (cat:face d) 1 4 31 chml-clss)))
(cat:z2-cocycle-gbar 1 4 x)
(signals simple-error (cat:z2-cocycle-gbar-head 1 4 x))
(setf chml-clss
(cat:build-mrph :sorc d :trgt (cat:z-chcm) :degr -2
:intr #'(lambda (dmns gmsm)
(cat:term-cmbn 0 (mod gmsm 2) :gnrt-z))
:strt :gnrt
:orgn '(essai-2)))
(setf x (cat:gmsm-cocycle (cat:face d) 2 2 7 chml-clss))
(cat:z2-cocycle-gbar 2 2 x)
(cat:z2-cocycle-gbar-head 2 2 x)
;; normally illegal
(setf x (cat:gmsm-cocycle (cat:face d) 2 2 0 chml-clss))
(cat:z2-cocycle-gbar 2 2 x)
(cat:z2-cocycle-gbar-head 2 2 x)
(setf x (cat:gmsm-cocycle (cat:face d) 2 3 15 chml-clss))
(cat:z2-cocycle-gbar 2 3 x)
(cat:z2-cocycle-gbar-head 2 3 x)
(setf x (cat:gmsm-cocycle (cat:face d) 2 4 31 chml-clss))
(cat:z2-cocycle-gbar 2 4 x)
(cat:z2-cocycle-gbar-head 2 4 x)
(setf chml-clss
(cat:build-mrph :sorc d :trgt (cat:z-chcm) :degr -3
:intr #'(lambda (dmns gmsm)
(cat:term-cmbn 0 (mod gmsm 2) :gnrt-z))
:strt :gnrt
:orgn '(essai-3)))
(setf x (cat:gmsm-cocycle (cat:face d) 3 4 31 chml-clss))
(cat:z2-cocycle-gbar 3 4 x)
(cat:z2-cocycle-gbar-head 3 4 x)))
(test k-z-fundamental-class
(cat:cat-init)
(let ((c1 (cat:k-z-fundamental-class 1))
(c3 (cat:k-z-fundamental-class 3)))
(cat:? c1 1 '(34))
(cat:? c1 2 '(34 45))
(cat:? c3 3 (cat:z-fundamental-gmsm 3 45))))
(test k-z2-fundamental-class
(cat:cat-init)
(let ((c1 (cat:k-z2-fundamental-class 1))
(c3 (cat:k-z2-fundamental-class 3)))
(cat:? c1 1 1)
(cat:? c1 2 2)
(cat:? c3 3 (cat:z2-fundamental-gmsm 3 1))))