First batch of k-pi-n tests.
This commit is contained in:
Gerd Heber
parent
dc99be9e18
commit
c75796d4c7
@ -25,4 +25,6 @@
|
||||
(:file "cartesian-products-test")
|
||||
(:file "cones-test")
|
||||
;;(:file "cl-space-efhm-test")
|
||||
(:file "tensor-products-test")))
|
||||
(:file "tensor-products-test")
|
||||
(:file "k-pi-n-test")
|
||||
))
|
||||
|
||||
19
package.lisp
19
package.lisp
@ -206,8 +206,26 @@
|
||||
|
||||
;; k-pi-n.lisp
|
||||
|
||||
CIRCLE
|
||||
INTERESTING-FACES
|
||||
GMSM-COCYCLE
|
||||
K-Z
|
||||
K-Z-1
|
||||
K-Z-1-CMPR
|
||||
K-Z-1-FACE
|
||||
K-Z-1-GRIN
|
||||
K-Z-1-GRML
|
||||
K-Z2
|
||||
K-Z2-1
|
||||
KZ1-RDCT
|
||||
KZ1-RDCT-F-INTR
|
||||
KZ1-RDCT-H-INTR
|
||||
Z-ABSM-BAR
|
||||
Z-BAR-ABSM
|
||||
Z-FUNDAMENTAL-GMSM
|
||||
Z2-ABSM-BAR
|
||||
Z2-BAR-ABSM
|
||||
Z-COCYCLE-GBAR
|
||||
|
||||
;; macros.lisp
|
||||
|
||||
@ -235,6 +253,7 @@
|
||||
DFFR
|
||||
DGNL
|
||||
GNRT
|
||||
GRIN
|
||||
I-SBTR
|
||||
MASK
|
||||
RBCC
|
||||
|
||||
406
src/k-pi-n.lisp
406
src/k-pi-n.lisp
@ -17,11 +17,6 @@
|
||||
(:less (return-from k-z-1-cmpr :less))
|
||||
(:greater (return-from k-z-1-cmpr :greater))))))
|
||||
|
||||
#|
|
||||
(k-z-1-cmpr '(1 1 2) '(1 2 2))
|
||||
(k-z-1-cmpr '(1 1 2) '(1 1 2))
|
||||
(k-z-1-cmpr '(1 1 2) '(1 1 -1))
|
||||
|#
|
||||
|
||||
(DEFUN K-Z-1-FACE (indx dmns gmsm)
|
||||
(declare
|
||||
@ -37,21 +32,16 @@
|
||||
((= i indx) (let ((new-k (+ (car mark) (cadr mark))))
|
||||
(declare (fixnum new-k))
|
||||
(if (zerop new-k)
|
||||
(absm (2-exp (1- indx)) (nreconc rslt (cddr mark)))
|
||||
(absm 0 (nreconc rslt (cons new-k (cddr mark)))))))
|
||||
(absm (2-exp (1- indx))
|
||||
(nreconc rslt (cddr mark)))
|
||||
(absm 0
|
||||
(nreconc rslt
|
||||
(cons new-k
|
||||
(cddr mark)))))))
|
||||
(declare
|
||||
(list rslt mark)
|
||||
(fixnum i)))))))
|
||||
|
||||
#|
|
||||
(k-z-1-face 0 1 '(3))
|
||||
(k-z-1-face 1 1 '(3))
|
||||
(k-z-1-face 0 3 '(1 2 3))
|
||||
(k-z-1-face 1 3 '(1 2 3))
|
||||
(k-z-1-face 2 3 '(1 2 3))
|
||||
(k-z-1-face 2 3 '(1 2 -2))
|
||||
(k-z-1-face 3 3 '(1 2 3))
|
||||
|#
|
||||
|
||||
(DEFUN Z-ABSM-BAR (absm)
|
||||
(declare (type absm absm))
|
||||
@ -68,13 +58,6 @@
|
||||
(pop bar1))
|
||||
rslt)))))
|
||||
|
||||
#|
|
||||
(z-absm-bar (absm 0 '()))
|
||||
(z-absm-bar (absm 1 '()))
|
||||
(z-absm-bar (absm 0 '(2)))
|
||||
(dotimes (i 8)
|
||||
(print (z-absm-bar (absm i '(3 6)))))
|
||||
|#
|
||||
|
||||
(DEFUN Z-BAR-ABSM (bar)
|
||||
(declare (list bar))
|
||||
@ -93,13 +76,6 @@
|
||||
(incf rslt-dgop bark)
|
||||
(push k-i rslt-bar))))))
|
||||
|
||||
#|
|
||||
(z-bar-absm (z-absm-bar (absm 0 '())))
|
||||
(z-bar-absm (z-absm-bar (absm 1 '())))
|
||||
(z-bar-absm (z-absm-bar (absm 0 '(2))))
|
||||
(dotimes (i 8)
|
||||
(print (z-bar-absm (z-absm-bar (absm i '(3 6))))))
|
||||
|#
|
||||
|
||||
(DEFUN K-Z-1-GRML (dmns crpr)
|
||||
(declare
|
||||
@ -129,15 +105,6 @@
|
||||
(incf rslt-dgop bark)
|
||||
(push item rslt-bar)))))))
|
||||
|
||||
#|
|
||||
(k-z-1-grml 0 (crpr 0 nil 0 nil))
|
||||
(k-z-1-grml 1 (crpr 0 '(3) 0 '(4)))
|
||||
(k-z-1-grml 1 (crpr 0 '(3) 0 '(-3)))
|
||||
(k-z-1-grml 1 (crpr 0 '(3) 1 '()))
|
||||
(k-z-1-grml 1 (crpr 1 '() 0 '(3)))
|
||||
(k-z-1-grml 1 (crpr 1 '() 1 '()))
|
||||
(k-z-1-grml 5 (crpr 24 '(2 2 3) 20 '(-2 2 4)))
|
||||
|#
|
||||
|
||||
(DEFUN K-Z-1-GRIN (dmns bar)
|
||||
(declare
|
||||
@ -146,11 +113,6 @@
|
||||
(the absm
|
||||
(absm 0 (mapcar #'- bar))))
|
||||
|
||||
#|
|
||||
(k-z-1-grin 3 '(2 3 -4))
|
||||
(setf gmsm '(2 3 -4))
|
||||
(k-z-1-grml 3 (crpr 0 gmsm 0 (gmsm (k-z-1-grin 3 gmsm))))
|
||||
|#
|
||||
|
||||
#|
|
||||
(DEFUN K-Z-1-KFLL (indx dmns hat)
|
||||
@ -207,22 +169,6 @@
|
||||
:sintr-grin #'k-z-1-grin
|
||||
:orgn '(k-z-1))))
|
||||
|
||||
#|
|
||||
(setf k (k-z-1))
|
||||
(defun aleat-list (max length)
|
||||
(let ((rslt nil)
|
||||
(2max (+ max max)))
|
||||
(dotimes (i length)
|
||||
(push (let ((k (- (random 2max) max)))
|
||||
(if (zerop k)
|
||||
max
|
||||
k))
|
||||
rslt))
|
||||
rslt))
|
||||
(? k (? k 14 (aleat-list 200 14)))
|
||||
(setf zero? (add (idnt-mrph k) (grin k)))
|
||||
(? zero? 14 (aleat-list 200 14))
|
||||
|#
|
||||
|
||||
(DEFUN K-Z (n)
|
||||
(declare (fixnum n))
|
||||
@ -253,17 +199,12 @@
|
||||
:strt :cmbn
|
||||
:orgn '(circle))))
|
||||
|
||||
#|
|
||||
(setf c (circle))
|
||||
(cmpr c '* '*)
|
||||
(basis c 1)
|
||||
(? c 1 's1)
|
||||
|#
|
||||
|
||||
(DEFUN KZ1-RDCT-F-INTR (cmbn)
|
||||
(declare (type cmbn cmbn))
|
||||
(the cmbn
|
||||
(with-cmbn (degr list) cmbn
|
||||
(with-cmbn
|
||||
(degr list) cmbn
|
||||
(case degr
|
||||
(0 (if list
|
||||
(term-cmbn 0 (-cffc list) '*)
|
||||
@ -273,24 +214,15 @@
|
||||
(mapcar
|
||||
#'(lambda (term)
|
||||
(declare (type term term))
|
||||
(with-term (cffc gnrt) term
|
||||
(the fixnum (* cffc
|
||||
(first gnrt)))))
|
||||
(with-term
|
||||
(cffc gnrt) term
|
||||
(the fixnum (* cffc (first gnrt)))))
|
||||
list))))
|
||||
(if (zerop rslt)
|
||||
(zero-cmbn 1)
|
||||
(term-cmbn 1 rslt 's1))))
|
||||
(otherwise (zero-cmbn degr))))))
|
||||
|
||||
#|
|
||||
(kz1-rdct-f-intr (cmbn 0))
|
||||
(kz1-rdct-f-intr (cmbn 0 4 '()))
|
||||
(kz1-rdct-f-intr (cmbn 1))
|
||||
(kz1-rdct-f-intr (cmbn 1 4 '(3)))
|
||||
(kz1-rdct-f-intr (cmbn 1 4 '(3) 5 '(2)))
|
||||
(kz1-rdct-f-intr (cmbn 1 4 '(3) -3 '(4)))
|
||||
(kz1-rdct-f-intr (cmbn -3))
|
||||
|#
|
||||
|
||||
(DEFUN KZ1-RDCT-F ()
|
||||
(the morphism
|
||||
@ -312,6 +244,7 @@
|
||||
(1 (term-cmbn 1 (-cffc list) (list 1))))
|
||||
(zero-cmbn degr)))))
|
||||
|
||||
|
||||
(DEFUN KZ1-RDCT-G ()
|
||||
(the morphism
|
||||
(build-mrph
|
||||
@ -322,6 +255,7 @@
|
||||
:strt :cmbn
|
||||
:orgn '(kz1-rdct-g))))
|
||||
|
||||
|
||||
(DEFUN KZ1-RDCT-H-INTR (dmns bar)
|
||||
(declare
|
||||
(fixnum dmns)
|
||||
@ -354,17 +288,6 @@
|
||||
((< i k1) (make-cmbn :degr (1+ dmns)
|
||||
:list rslt))))))))
|
||||
|
||||
#|
|
||||
(kz1-rdct-h-intr 0 nil)
|
||||
(kz1-rdct-h-intr 1 '(-4))
|
||||
(kz1-rdct-h-intr 1 '(-1))
|
||||
(kz1-rdct-h-intr 1 '(1))
|
||||
(kz1-rdct-h-intr 1 '(4))
|
||||
(kz1-rdct-h-intr 3 '(-4 3 5))
|
||||
(kz1-rdct-h-intr 3 '(-1 3 -1))
|
||||
(kz1-rdct-h-intr 3 '(1 2 2))
|
||||
(kz1-rdct-h-intr 3 '(4 3 5))
|
||||
|#
|
||||
|
||||
(DEFUN KZ1-RDCT-H ()
|
||||
(the morphism
|
||||
@ -376,6 +299,7 @@
|
||||
:strt :gnrt
|
||||
:orgn '(kz1-rdct-h))))
|
||||
|
||||
|
||||
(DEFUN KZ1-RDCT ()
|
||||
(the reduction
|
||||
(build-rdct
|
||||
@ -384,20 +308,6 @@
|
||||
:h (kz1-rdct-h)
|
||||
:orgn '(kz1-rdct))))
|
||||
|
||||
#|
|
||||
(pre-check-rdct (kz1-rdct))
|
||||
(setf *tc* (cmbn 0 1 '()))
|
||||
(setf *bc* (cmbn 0 1 '*))
|
||||
(check-rdct)
|
||||
(setf *tc* (cmbn 1 1 '(-4) 10 '(-1) 100 '(1) 1000 '(5)))
|
||||
(setf *bc* (cmbn 1 1 's1))
|
||||
(check-rdct)
|
||||
(setf *tc* (cmbn 2 1 '(-4 2) 10 '(-1 3) 100 '(1 -4) 1000 '(5 5)))
|
||||
(check-rdct)
|
||||
(setf *tc* (cmbn 3 1 '(-4 -4 5) 10 '(-1 2 1)
|
||||
100 '(1 4 2) 1000 '(5 1 -1)))
|
||||
(check-rdct)
|
||||
|#
|
||||
|
||||
(DEFUN KZ1-EFHM ()
|
||||
(the homotopy-equivalence
|
||||
@ -410,10 +320,6 @@
|
||||
(declare (ignore k-z-1))
|
||||
(kz1-efhm))
|
||||
|
||||
#|
|
||||
(cat-init)
|
||||
(homology (k-z-1) 1)
|
||||
|#
|
||||
|
||||
(DEFUN K-Z2-1-GRML-INTR (dmns crpr)
|
||||
(declare
|
||||
@ -426,6 +332,7 @@
|
||||
(declare (fixnum dgop))
|
||||
(absm dgop (- dmns (logcount dgop)))))))
|
||||
|
||||
|
||||
(DEFUN K-Z2-1-GRML ()
|
||||
(the simplicial-mrph
|
||||
(build-smmr
|
||||
@ -435,6 +342,7 @@
|
||||
:sintr #'k-z2-1-grml-intr
|
||||
:orgn '(k-z2-1-grml))))
|
||||
|
||||
|
||||
(DEFUN K-Z2-1-GRIN-INTR (dmns gmsm)
|
||||
(declare
|
||||
(ignore dmns)
|
||||
@ -442,6 +350,7 @@
|
||||
(the absm
|
||||
(absm 0 gmsm)))
|
||||
|
||||
|
||||
(DEFUN K-Z2-1-GRIN ()
|
||||
(the simplicial-mrph
|
||||
(build-smmr
|
||||
@ -453,6 +362,7 @@
|
||||
:strt :cmbn
|
||||
:orgn '(k-z2-1-grin))))
|
||||
|
||||
|
||||
(DEFUN K-Z2-1 ()
|
||||
(the ab-simplicial-group
|
||||
(let ((rslt (r-proj-space)))
|
||||
@ -465,10 +375,6 @@
|
||||
(pushnew rslt *smgr-list*)
|
||||
rslt)))
|
||||
|
||||
#|
|
||||
(setf k (k-z2-1))
|
||||
(homology k 0 4)
|
||||
|#
|
||||
|
||||
(DEFUN K-Z2 (n)
|
||||
(declare (fixnum n))
|
||||
@ -477,10 +383,6 @@
|
||||
(k-z2-1)
|
||||
(classifying-space (k-z2 (1- n))))))
|
||||
|
||||
#|
|
||||
(setf k3 (k-z2 3))
|
||||
(homology k3 7)
|
||||
|#
|
||||
|
||||
(DEFUN Z2-ABSM-BAR (absm)
|
||||
(declare (type absm absm))
|
||||
@ -496,6 +398,7 @@
|
||||
(fixnum bmark)
|
||||
(list rslt))))))
|
||||
|
||||
|
||||
(DEFUN Z2-BAR-ABSM (bar)
|
||||
(declare (list bar))
|
||||
(the absm
|
||||
@ -511,12 +414,6 @@
|
||||
(incf dgop 2-pwr)
|
||||
(incf gmsm)))))
|
||||
|
||||
#|
|
||||
(dotimes (i 8) ;;; not really legal
|
||||
(dotimes (j 8)
|
||||
(print (z2-bar-absm (z2-absm-bar (absm i j))))))
|
||||
|#
|
||||
|
||||
|
||||
(DEFUN HOPF-FIBRATION-SINTR (n)
|
||||
(declare (fixnum n))
|
||||
@ -527,6 +424,7 @@
|
||||
(absm 0 (list n)))))
|
||||
(the sintr #'rslt)))
|
||||
|
||||
|
||||
(DEFUN HOPF-FIBRATION (n)
|
||||
(declare (fixnum n))
|
||||
(the simplicial-mrph
|
||||
@ -537,6 +435,7 @@
|
||||
:sintr (hopf-fibration-sintr n)
|
||||
:orgn `(hopf-fibration ,n))))
|
||||
|
||||
|
||||
(DEFUN Z-FUNDAMENTAL-GMSM (dmns pi-elm) ;;; pi-elm not equal to 0
|
||||
(declare (fixnum dmns pi-elm))
|
||||
(the gmsm
|
||||
@ -545,19 +444,14 @@
|
||||
(let ((bspn (if (= 2 dmns) +empty-list+ +null-gbar+)))
|
||||
(declare (type gmsm bspn))
|
||||
(make-gbar :dmns dmns
|
||||
:list (cons (absm 0 (z-fundamental-gmsm (1- dmns) pi-elm))
|
||||
:list (cons (absm 0 (z-fundamental-gmsm (1- dmns)
|
||||
pi-elm))
|
||||
(mapcar
|
||||
#'(lambda (k)
|
||||
(declare (fixnum k))
|
||||
(absm (mask k) bspn))
|
||||
(nreverse (<a-b> 0 (- dmns 2))))))))))
|
||||
|
||||
#|
|
||||
(z-fundamental-gmsm 1 33)
|
||||
(z-fundamental-gmsm 2 33)
|
||||
(z-fundamental-gmsm 3 33)
|
||||
(z-fundamental-gmsm 4 33)
|
||||
|#
|
||||
|
||||
(DEFUN INTERESTING-FACES (face small-dmns high-dmns gmsm)
|
||||
(declare
|
||||
@ -569,7 +463,8 @@
|
||||
(declare (fixnum max))
|
||||
(if (= small-dmns high-dmns)
|
||||
(list (cons max (absm 0 gmsm)))
|
||||
(do ((prev-list (interesting-faces face (1+ small-dmns) high-dmns gmsm))
|
||||
(do ((prev-list (interesting-faces face (1+ small-dmns) high-dmns
|
||||
gmsm))
|
||||
(k (1- max) (1- k))
|
||||
(rslt +empty-list+)
|
||||
(count (binomial-n-p high-dmns small-dmns)))
|
||||
@ -584,18 +479,14 @@
|
||||
(push (cons k
|
||||
(a-face4 face
|
||||
(- small-dmns -1
|
||||
(if (= i (integer-length k)) (1+ i) i))
|
||||
(if (= i (integer-length k))
|
||||
(1+ i)
|
||||
i))
|
||||
(1+ small-dmns)
|
||||
(cdr (assoc (+ k (2-exp i)) prev-list))))
|
||||
(cdr (assoc (+ k (2-exp i))
|
||||
prev-list))))
|
||||
rslt)))))))))
|
||||
|
||||
#|
|
||||
(setf d (delta 14))
|
||||
(setf f (face d))
|
||||
(do ((i 5 (1- i)))
|
||||
((minusp i))
|
||||
(print (interesting-faces f i 5 (mask 6))))
|
||||
|#
|
||||
|
||||
(DEFUN GMSM-COCYCLE (face small-dmns high-dmns gmsm chml-clss)
|
||||
(declare
|
||||
@ -615,8 +506,10 @@
|
||||
(with-absm (dgop gmsm2) absm
|
||||
(if (plusp dgop)
|
||||
0
|
||||
(let ((cmbn-list (cmbn-list (gnrt-? chml-clss
|
||||
small-dmns gmsm2))))
|
||||
(let ((cmbn-list
|
||||
(cmbn-list (gnrt-? chml-clss
|
||||
small-dmns
|
||||
gmsm2))))
|
||||
(declare (list cmbn-list))
|
||||
(if cmbn-list
|
||||
(-cffc cmbn-list)
|
||||
@ -624,24 +517,6 @@
|
||||
int-faces)
|
||||
int-faces)))
|
||||
|
||||
#|
|
||||
(cat-init)
|
||||
(setf d (delta 10))
|
||||
(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-1)))
|
||||
(gmsm-cocycle (face d) 2 4 31 chml-clss)
|
||||
(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-2)))
|
||||
(gmsm-cocycle (face d) 1 4 31 chml-clss)
|
||||
|#
|
||||
|
||||
(DEFUN Z-COCYCLE-GBAR (n dmns cocycle)
|
||||
;; cocycle \in Z^n(\Delta^{dmns}, \pi) with \pi = Z
|
||||
@ -683,51 +558,10 @@
|
||||
(normalize-gbar
|
||||
(cons dmns
|
||||
(cons head-absm
|
||||
(rest (unnormalize-gbar tail-absm
|
||||
(rest (unnormalize-gbar
|
||||
tail-absm
|
||||
(if (= n 2) () +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 gmsm :gnrt-z))
|
||||
:strt :gnrt
|
||||
:orgn '(essai-1)))
|
||||
(gmsm-cocycle (face d) 1 4 31 chml-clss)
|
||||
(z-cocycle-gbar 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 *)
|
||||
(gmsm-cocycle (face d) 2 2 0 chml-clss) ;; normally illegal
|
||||
(z-cocycle-gbar 2 2 *)
|
||||
(gmsm-cocycle (face d) 2 3 15 chml-clss)
|
||||
(z-cocycle-gbar 2 3 *)
|
||||
(gmsm-cocycle (face d) 2 4 31 chml-clss)
|
||||
(z-cocycle-gbar 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 *)
|
||||
(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 *)
|
||||
|#
|
||||
|
||||
(DEFUN Z-COCYCLE-GBAR-HEAD (n dmns cocycle)
|
||||
;; cocycle \in Z^n(\Delta^{dmns}, \pi) with \pi = Z
|
||||
@ -737,7 +571,7 @@
|
||||
(the absm
|
||||
(cond ((= n 1)
|
||||
(error "In Z-COCYCLE-GBAR-HEAD, this point should not have been reached."))
|
||||
; (z-bar-absm (nreverse (mapcar #'cdr cocycle))))
|
||||
;; (z-bar-absm (nreverse (mapcar #'cdr cocycle))))
|
||||
((= n dmns)
|
||||
(let ((value (cdr (first cocycle))))
|
||||
(declare (fixnum value))
|
||||
@ -769,53 +603,53 @@
|
||||
(z-cocycle-gbar (1- n) (1- dmns) cocycle2))))))
|
||||
|
||||
#|
|
||||
(cat-init)
|
||||
(setf d (delta 10))
|
||||
(setf chml-clss
|
||||
(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
|
||||
(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
|
||||
(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
|
||||
(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 **)
|
||||
(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.
|
||||
@ -834,10 +668,10 @@
|
||||
(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)
|
||||
(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)
|
||||
@ -893,38 +727,38 @@
|
||||
(if (= n 2) 0 +null-gbar+)))))))))))))
|
||||
|
||||
#|
|
||||
(cat-init)
|
||||
(setf d (delta 10))
|
||||
(setf chml-clss
|
||||
(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
|
||||
(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
|
||||
(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 *)
|
||||
(gmsm-cocycle (face d) 3 4 31 chml-clss)
|
||||
(z2-cocycle-gbar 3 4 *)
|
||||
|#
|
||||
|
||||
(DEFUN Z2-COCYCLE-GBAR-HEAD (n dmns cocycle)
|
||||
@ -975,44 +809,44 @@
|
||||
(z2-cocycle-gbar (1- n) (1- dmns) cocycle2)))))))
|
||||
|
||||
#|
|
||||
(cat-init)
|
||||
(setf d (delta 10))
|
||||
(setf chml-clss
|
||||
(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
|
||||
(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
|
||||
(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 **)
|
||||
(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)
|
||||
@ -1037,12 +871,12 @@
|
||||
: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))
|
||||
(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)
|
||||
@ -1061,11 +895,11 @@
|
||||
:orgn `(k-z2-fundamental-class ,n))))
|
||||
|
||||
#|
|
||||
(cat-init)
|
||||
(setf c1 (k-z2-fundamental-class 1))
|
||||
(? c1 1 1)
|
||||
(? c1 2 2)
|
||||
(setf c3 (k-z2-fundamental-class 3))
|
||||
(? c3 3 (z2-fundamental-gmsm 3 1))
|
||||
(cat-init)
|
||||
(setf c1 (k-z2-fundamental-class 1))
|
||||
(? c1 1 1)
|
||||
(? c1 2 2)
|
||||
(setf c3 (k-z2-fundamental-class 3))
|
||||
(? c3 3 (z2-fundamental-gmsm 3 1))
|
||||
|#
|
||||
|
||||
|
||||
214
test/k-pi-n-test.lisp
Normal file
214
test/k-pi-n-test.lisp
Normal file
@ -0,0 +1,214 @@
|
||||
|
||||
(in-package :kenzo-test)
|
||||
|
||||
(in-suite :kenzo)
|
||||
|
||||
(test k-z-1-cmpr
|
||||
(is (equal :less (cat:k-z-1-cmpr '(1 1 2) '(1 2 2))))
|
||||
(is (equal :equal (cat:k-z-1-cmpr '(1 1 2) '(1 1 2))))
|
||||
(is (equal :greater (cat:k-z-1-cmpr '(1 1 2) '(1 1 -1)))))
|
||||
|
||||
(test k-z-1-face
|
||||
(cat:k-z-1-face 0 1 '(3))
|
||||
(cat:k-z-1-face 1 1 '(3))
|
||||
(cat:k-z-1-face 0 3 '(1 2 3))
|
||||
(cat:k-z-1-face 1 3 '(1 2 3))
|
||||
(cat:k-z-1-face 2 3 '(1 2 3))
|
||||
(cat:k-z-1-face 2 3 '(1 2 -2))
|
||||
(cat:k-z-1-face 3 3 '(1 2 3)))
|
||||
|
||||
(test z-absm-bar
|
||||
(cat:z-absm-bar (cat:absm 0 '()))
|
||||
(cat:z-absm-bar (cat:absm 1 '()))
|
||||
(cat:z-absm-bar (cat:absm 0 '(2)))
|
||||
(dotimes (i 8)
|
||||
(print (cat:z-absm-bar (cat:absm i '(3 6))))))
|
||||
|
||||
|
||||
(test z-bar-absm
|
||||
(cat:z-bar-absm (cat:z-absm-bar (cat:absm 0 '())))
|
||||
(cat:z-bar-absm (cat:z-absm-bar (cat:absm 1 '())))
|
||||
(cat:z-bar-absm (cat:z-absm-bar (cat:absm 0 '(2))))
|
||||
(dotimes (i 8)
|
||||
(print (cat:z-bar-absm (cat:z-absm-bar (cat:absm i '(3 6)))))))
|
||||
|
||||
|
||||
(test k-z-1-grml
|
||||
(cat:k-z-1-grml 0 (cat:crpr 0 nil 0 nil))
|
||||
(cat:k-z-1-grml 1 (cat:crpr 0 '(3) 0 '(4)))
|
||||
(cat:k-z-1-grml 1 (cat:crpr 0 '(3) 0 '(-3)))
|
||||
(cat:k-z-1-grml 1 (cat:crpr 0 '(3) 1 '()))
|
||||
(cat:k-z-1-grml 1 (cat:crpr 1 '() 0 '(3)))
|
||||
(cat:k-z-1-grml 1 (cat:crpr 1 '() 1 '()))
|
||||
(cat:k-z-1-grml 5 (cat:crpr 24 '(2 2 3) 20 '(-2 2 4))))
|
||||
|
||||
|
||||
(test k-z-1-grin
|
||||
(cat:k-z-1-grin 3 '(2 3 -4))
|
||||
(let ((gmsm '(2 3 -4)))
|
||||
(cat:k-z-1-grml 3 (cat:crpr 0 gmsm 0
|
||||
(cat:gmsm (cat:k-z-1-grin 3 gmsm))))))
|
||||
|
||||
|
||||
(defun aleat-list (max length)
|
||||
(let ((rslt nil)
|
||||
(2max (+ max max)))
|
||||
(dotimes (i length)
|
||||
(push (let ((k (- (random 2max) max)))
|
||||
(if (zerop k)
|
||||
max
|
||||
k))
|
||||
rslt))
|
||||
rslt))
|
||||
|
||||
|
||||
(test k-z-1
|
||||
(let ((k (cat:k-z-1))
|
||||
zero?)
|
||||
(cat:? k (cat:? k 14 (aleat-list 200 14)))
|
||||
(setf zero? (cat:add (cat:idnt-mrph k) (cat:grin k)))
|
||||
(cat:? zero? 14 (aleat-list 200 14))))
|
||||
|
||||
|
||||
(test circle
|
||||
(let ((c (cat:circle)))
|
||||
(cat:cmpr c '* '*)
|
||||
(cat:basis c 1)
|
||||
(cat:? c 1 's1)))
|
||||
|
||||
|
||||
(test kz1-rdct-f-intr
|
||||
(cat:kz1-rdct-f-intr (cat:cmbn 0))
|
||||
(cat:kz1-rdct-f-intr (cat:cmbn 0 4 '()))
|
||||
(cat:kz1-rdct-f-intr (cat:cmbn 1))
|
||||
(cat:kz1-rdct-f-intr (cat:cmbn 1 4 '(3)))
|
||||
(cat:kz1-rdct-f-intr (cat:cmbn 1 4 '(3) 5 '(2)))
|
||||
(cat:kz1-rdct-f-intr (cat:cmbn 1 4 '(3) -3 '(4)))
|
||||
(cat:kz1-rdct-f-intr (cat:cmbn -3)))
|
||||
|
||||
|
||||
(test kz1-rdct-h-intr
|
||||
(cat:kz1-rdct-h-intr 0 nil)
|
||||
(cat:kz1-rdct-h-intr 1 '(-4))
|
||||
(cat:kz1-rdct-h-intr 1 '(-1))
|
||||
(cat:kz1-rdct-h-intr 1 '(1))
|
||||
(cat:kz1-rdct-h-intr 1 '(4))
|
||||
(cat:kz1-rdct-h-intr 3 '(-4 3 5))
|
||||
(cat:kz1-rdct-h-intr 3 '(-1 3 -1))
|
||||
(cat:kz1-rdct-h-intr 3 '(1 2 2))
|
||||
(cat:kz1-rdct-h-intr 3 '(4 3 5)))
|
||||
|
||||
|
||||
(test kz1-rdct
|
||||
(cat:cat-init)
|
||||
(cat:pre-check-rdct (cat:kz1-rdct))
|
||||
(setf cat:*tc* (cat:cmbn 0 1 '()))
|
||||
(setf cat:*bc* (cat:cmbn 0 1 '*))
|
||||
(check-rdct)
|
||||
(setf cat:*tc* (cat:cmbn 1 1 '(-4) 10 '(-1) 100 '(1) 1000 '(5)))
|
||||
(setf cat:*bc* (cat:cmbn 1 1 's1))
|
||||
(check-rdct)
|
||||
(setf cat:*tc* (cat:cmbn 2 1 '(-4 2) 10 '(-1 3) 100 '(1 -4) 1000 '(5 5)))
|
||||
(check-rdct)
|
||||
(setf cat:*tc* (cat:cmbn 3 1 '(-4 -4 5) 10 '(-1 2 1)
|
||||
100 '(1 4 2) 1000 '(5 1 -1)))
|
||||
(check-rdct))
|
||||
|
||||
|
||||
(test k-z-1-homology
|
||||
(cat:cat-init)
|
||||
(cat:homology (cat:k-z-1) 1))
|
||||
|
||||
|
||||
(test k-z2-1-homology
|
||||
(let ((k (cat:k-z2-1)))
|
||||
(cat:homology k 0 4)))
|
||||
|
||||
#|
|
||||
(test k-z2-homology
|
||||
(let ((k3 (cat:k-z2 3)))
|
||||
(cat:homology k3 7)))
|
||||
|#
|
||||
|
||||
(test z2-bar-absm
|
||||
(dotimes (i 8) ;;; not really legal
|
||||
(dotimes (j 8)
|
||||
(print (cat:z2-bar-absm (cat:z2-absm-bar (cat:absm i j)))))))
|
||||
|
||||
|
||||
(test z-fundamental-gmsm
|
||||
(cat:z-fundamental-gmsm 1 33)
|
||||
(cat:z-fundamental-gmsm 2 33)
|
||||
(cat:z-fundamental-gmsm 3 33)
|
||||
(cat:z-fundamental-gmsm 4 33))
|
||||
|
||||
|
||||
(test interesting-faces
|
||||
(let* ((d (cat:delta 14))
|
||||
(f (cat:face d)))
|
||||
(do ((i 5 (1- i)))
|
||||
((minusp i))
|
||||
(print (cat:interesting-faces f i 5 (cat:mask 6))))))
|
||||
|
||||
|
||||
(test gmsm-cocycle
|
||||
(cat:cat-init)
|
||||
(let* ((d (cat:delta 10))
|
||||
(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-1))))
|
||||
(cat:gmsm-cocycle (cat:face d) 2 4 31 chml-clss)
|
||||
(setf 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-2)))
|
||||
(cat:gmsm-cocycle (cat:face d) 1 4 31 chml-clss)))
|
||||
|
||||
#|
|
||||
(test z-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 gmsm
|
||||
:gnrt-z))
|
||||
:strt :gnrt
|
||||
:orgn '(essai-1))))
|
||||
(cat:gmsm-cocycle (cat:face d) 1 4 31 chml-clss)
|
||||
(cat:z-cocycle-gbar 1 4 *)
|
||||
(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)))
|
||||
(cat:gmsm-cocycle (cat:face d) 2 2 7 chml-clss)
|
||||
(cat:z-cocycle-gbar 2 2 *)
|
||||
(cat:gmsm-cocycle (cat:face d) 2 2 0 chml-clss) ;; normally illegal
|
||||
(cat:z-cocycle-gbar 2 2 *)
|
||||
(cat:gmsm-cocycle (cat:face d) 2 3 15 chml-clss)
|
||||
(cat:z-cocycle-gbar 2 3 *)
|
||||
(cat:gmsm-cocycle (cat:face d) 2 4 31 chml-clss)
|
||||
(cat:z-cocycle-gbar 2 4 *)
|
||||
(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)))
|
||||
(cat:gmsm-cocycle (cat:face d) 3 4 31 chml-clss)
|
||||
(cat:z-cocycle-gbar 3 4 *)
|
||||
(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)))
|
||||
(cat:gmsm-cocycle (cat:face d) 3 4 31 chml-clss)
|
||||
(cat:z-cocycle-gbar 3 4 *)))
|
||||
|#
|
||||
Loading…
Reference in New Issue
Block a user