Added chcm-elementary-op tests.
This commit is contained in:
gheber
parent
c21253dd13
commit
0351445e49
@ -9,5 +9,6 @@
|
||||
(:file "combinations-test")
|
||||
(:file "various-test")
|
||||
(:file "chain-complexes-test")
|
||||
(:file "chcm-elementary-op-test")
|
||||
(:file "diabolo")
|
||||
(:file "circle")))
|
||||
|
||||
33
package.lisp
33
package.lisp
@ -17,6 +17,15 @@
|
||||
|
||||
;; chcm-elementary-op.lisp
|
||||
|
||||
ADD
|
||||
CMPS
|
||||
IDNT-MRPH
|
||||
N-MRPH
|
||||
OPPS
|
||||
SBTR
|
||||
Z-CHCM
|
||||
ZERO-MRPH
|
||||
|
||||
;; classes.lisp
|
||||
|
||||
CHAIN-COMPLEX
|
||||
@ -44,6 +53,14 @@
|
||||
ZERO-CMBN
|
||||
ZERO-INTR-DFFR
|
||||
|
||||
;; fibrations.lisp
|
||||
|
||||
FIBRATION-TOTAL
|
||||
|
||||
;; k-pi-n.lisp
|
||||
|
||||
K-Z
|
||||
|
||||
;; macros.lisp
|
||||
|
||||
BASIS
|
||||
@ -57,6 +74,18 @@
|
||||
TERM
|
||||
TERM-CMBN
|
||||
|
||||
;; searching-homology.lisp
|
||||
|
||||
HOMOLOGY
|
||||
|
||||
;; smith.lisp
|
||||
|
||||
CHML-CLSS
|
||||
|
||||
;; special-smsts.lisp
|
||||
|
||||
SPHERE
|
||||
|
||||
;; various.lisp
|
||||
|
||||
+EMPTY-LIST+
|
||||
@ -70,5 +99,9 @@
|
||||
SRANDOM
|
||||
V<A-B>
|
||||
|
||||
;; whitehead.lisp
|
||||
|
||||
Z-WHITEHEAD
|
||||
|
||||
))
|
||||
|
||||
|
||||
@ -35,19 +35,6 @@
|
||||
:strt :cmbn
|
||||
:orgn `(zero-mrph ,chcm1 ,chcm2 ,degr))))
|
||||
|
||||
#|
|
||||
(cat-init)
|
||||
(setf z (zero-mrph (Z-chcm) (Z-chcm) 2))
|
||||
(gnrt-? z 0 :z-gnrt)
|
||||
(cmbn-? z (cmbn 3))
|
||||
(setf z2 (zero-mrph (Z-chcm) (Z-chcm) 2))
|
||||
(eq z z2)
|
||||
(setf z3 (zero-mrph (Z-chcm) (Z-chcm) 3))
|
||||
(gnrt-? z3 0 :z-gnrt)
|
||||
(eq z z3))
|
||||
|#
|
||||
|
||||
|
||||
|
||||
(DEFUN IDNT-MRPH (chcm)
|
||||
(declare (type chain-complex chcm))
|
||||
@ -58,12 +45,6 @@
|
||||
:strt :cmbn
|
||||
:orgn `(idnt-mrph ,chcm))))
|
||||
|
||||
#|
|
||||
(setf zi (idnt-mrph (Z-chcm)))
|
||||
(gnrt-? zi 0 :z-gnrt)
|
||||
(setf zi2 (idnt-mrph (Z-chcm)))
|
||||
(eq zi zi2))
|
||||
|#
|
||||
|
||||
(DEFUN OPPS (mrph)
|
||||
(declare (type morphism mrph))
|
||||
@ -77,13 +58,6 @@
|
||||
:strt :cmbn
|
||||
:orgn `(opps ,mrph)))))
|
||||
|
||||
#|
|
||||
(cat-init)
|
||||
(setf -zi (opps (idnt-mrph (Z-chcm))))
|
||||
(gnrt-? -zi 0 :z-gnrt)
|
||||
(setf -zi2 (opps (idnt-mrph (Z-chcm))))
|
||||
(eq -zi -zi2))
|
||||
|#
|
||||
|
||||
(DEFMETHOD CMPS ((chcm1 chain-complex) (chcm2 chain-complex) &optional strt)
|
||||
(declare (type (or strt null) strt))
|
||||
@ -146,45 +120,7 @@
|
||||
(the cmbn
|
||||
(cmbn-? mrph1 (gnrt-? mrph2 degr gnrt))))
|
||||
:strt :gnrt :orgn `(2mrph-cmps ,mrph1 ,mrph2 ,strt))))))))
|
||||
|
||||
#|
|
||||
(cat-init)
|
||||
(setf cc (build-chcm :cmpr #'f-cmpr
|
||||
:basis :locally-effective
|
||||
:bsgn 0
|
||||
:intr-dffr #'(lambda (cmbn)
|
||||
(cmbn (1- (cmbn-degr cmbn))))
|
||||
:strt :cmbn
|
||||
:orgn '(Z of Z)))
|
||||
(setf *n* 5)
|
||||
(defun ff (degr i)
|
||||
(do ((*2n* (ash *n* 1))
|
||||
(rslt +empty-list+
|
||||
(cons (cons (let ((cffc (- (random *2n*) *n*)))
|
||||
(if (minusp cffc) cffc (1+ cffc)))
|
||||
(decf gnrt (1+ (random *n*))))
|
||||
rslt))
|
||||
(gnrt i)
|
||||
(k 0 (1+ k)))
|
||||
((= k *n*)
|
||||
(make-cmbn
|
||||
:degr 0
|
||||
:list rslt))))
|
||||
(setf mrph (build-mrph :sorc cc :trgt cc :degr 0
|
||||
:intr #'ff :strt :gnrt :orgn '(test)))
|
||||
(setf mrph2 (2mrph-cmps mrph mrph :gnrt))
|
||||
(gnrt-? mrph2 0 0)
|
||||
(dotimes (i 5)
|
||||
(print (gnrt-? mrph2 0 i)))
|
||||
(setf mrph (build-mrph :sorc cc :trgt cc :degr 0
|
||||
:intr #'ff :strt :gnrt :orgn '(test)))
|
||||
(setf mrph3 (cmps mrph mrph :cmbn))
|
||||
(gnrt-? mrph3 0 0)
|
||||
(dotimes (i 5)
|
||||
(print (gnrt-? mrph3 0 i)))
|
||||
(setf mrph33 (cmps mrph mrph :cmbn))
|
||||
(eq mrph3 mrph33))
|
||||
|#
|
||||
|
||||
|
||||
(DEFUN N-MRPH-INTR (n mrph)
|
||||
(declare
|
||||
@ -209,20 +145,6 @@
|
||||
:intr (n-mrph-intr n mrph) :strt :cmbn
|
||||
:orgn `(n-mrph ,n ,mrph)))))
|
||||
|
||||
#|
|
||||
(setf s3 (sphere 3))
|
||||
(setf ch3 (chml-clss s3 3))
|
||||
(setf 2ch3 (n-mrph 2 ch3))
|
||||
(setf f3 (z-whitehead s3 2ch3))
|
||||
(setf x (fibration-total f3))
|
||||
(homology x 0 10)
|
||||
(setf k (k-z 3))
|
||||
(setf ch3 (chml-clss k 3))
|
||||
(setf 2ch3 (n-mrph 2 ch3))
|
||||
(setf f3 (z-whitehead k 2ch3))
|
||||
(setf x (fibration-total f3))
|
||||
(homology x 0 10)
|
||||
|#
|
||||
|
||||
(DEFMETHOD ADD ((mrph1 morphism) (mrph2 morphism) &optional strt)
|
||||
(declare (type (or null strt) strt))
|
||||
@ -276,43 +198,6 @@
|
||||
:strt :cmbn
|
||||
:orgn `(2mrph-add ,mrph1 ,mrph2 ,strt)))))))))
|
||||
|
||||
#|
|
||||
(cat-init)
|
||||
(setf cc (build-chcm :cmpr #'f-cmpr
|
||||
:basis :locally-effective
|
||||
:bsgn 0
|
||||
:intr-dffr #'(lambda (cmbn)
|
||||
(cmbn (1- (cmbn-degr cmbn))))
|
||||
:strt :cmbn
|
||||
:orgn '(Z of Z)))
|
||||
(setf *n* 10)
|
||||
(defun ff (degr i)
|
||||
(do ((*2n* (ash *n* 1))
|
||||
(rslt +empty-list+
|
||||
(cons (cons (let ((cffc (- (random *2n*) *n*)))
|
||||
(if (minusp cffc) cffc (1+ cffc)))
|
||||
(decf gnrt (1+ (random *n*))))
|
||||
rslt))
|
||||
(gnrt i)
|
||||
(k 0 (1+ k)))
|
||||
((= k *n*)
|
||||
(make-cmbn
|
||||
:degr 0
|
||||
:list rslt))))
|
||||
(setf mrph1 (build-mrph :sorc cc :trgt cc :degr 0
|
||||
:intr #'ff :strt :gnrt :orgn '(test)))
|
||||
(setf mrph2 (build-mrph :sorc cc :trgt cc :degr 0
|
||||
:intr #'ff :strt :gnrt :orgn '(test2)))
|
||||
(setf mrph3 (add mrph1 mrph2 :gnrt))
|
||||
(setf +too-much-time+ -1)
|
||||
(gnrt-? mrph1 0 0)
|
||||
(gnrt-? mrph2 0 0)
|
||||
(gnrt-? mrph3 0 0)
|
||||
(setf mrph4 (add mrph1 mrph2 :cmbn))
|
||||
(gnrt-? mrph4 0 0)
|
||||
(setf mrph44 (add mrph1 mrph2 :cmbn))
|
||||
(eq mrph4 mrph44))
|
||||
|#
|
||||
|
||||
(DEFMETHOD SBTR ((mrph1 morphism) (mrph2 morphism) &optional strt)
|
||||
(declare (type (or null strt) strt))
|
||||
@ -366,44 +251,6 @@
|
||||
:strt :cmbn
|
||||
:orgn `(2mrph-sbtr ,mrph1 ,mrph2 ,strt)))))))))
|
||||
|
||||
#|
|
||||
()
|
||||
(cat-init)
|
||||
(setf cc (build-chcm :cmpr #'f-cmpr
|
||||
:basis :locally-effective
|
||||
:bsgn 0
|
||||
:intr-dffr #'(lambda (cmbn)
|
||||
(cmbn (1- (cmbn-degr cmbn))))
|
||||
:strt :cmbn
|
||||
:orgn '(Z of Z)))
|
||||
(setf *n* 10)
|
||||
(defun ff (degr i)
|
||||
(do ((*2n* (ash *n* 1))
|
||||
(rslt +empty-list+
|
||||
(cons (cons (let ((cffc (- (random *2n*) *n*)))
|
||||
(if (minusp cffc) cffc (1+ cffc)))
|
||||
(decf gnrt (1+ (random *n*))))
|
||||
rslt))
|
||||
(gnrt i)
|
||||
(k 0 (1+ k)))
|
||||
((= k *n*)
|
||||
(make-cmbn
|
||||
:degr 0
|
||||
:list rslt))))
|
||||
(setf mrph1 (build-mrph :sorc cc :trgt cc :degr 0
|
||||
:intr #'ff :strt :gnrt :orgn '(test)))
|
||||
(setf mrph2 (build-mrph :sorc cc :trgt cc :degr 0
|
||||
:intr #'ff :strt :gnrt :orgn '(test2)))
|
||||
(setf mrph3 (sbtr mrph1 mrph2 :gnrt))
|
||||
(setf +too-much-time+ -1)
|
||||
(gnrt-? mrph1 0 0)
|
||||
(gnrt-? mrph2 0 0)
|
||||
(gnrt-? mrph3 0 0)
|
||||
(setf mrph4 (sbtr mrph1 mrph2 :cmbn))
|
||||
(gnrt-? mrph4 0 0)
|
||||
(setf mrph44 (sbtr mrph1 mrph2 :cmbn))
|
||||
(eq mrph4 mrph44))
|
||||
|#
|
||||
|
||||
(DEFUN CHANGE-SORC-TRGT (mrph &key new-sorc new-trgt)
|
||||
(declare
|
||||
|
||||
187
test/chcm-elementary-op-test.lisp
Normal file
187
test/chcm-elementary-op-test.lisp
Normal file
@ -0,0 +1,187 @@
|
||||
|
||||
(in-package :kenzo-test)
|
||||
|
||||
(in-suite :kenzo)
|
||||
|
||||
(test zero-mrph
|
||||
(progn
|
||||
(cat:cat-init)
|
||||
(let* ((z (cat:zero-mrph (cat:Z-chcm) (cat:Z-chcm) 2))
|
||||
(z2 (cat:zero-mrph (cat:Z-chcm) (cat:Z-chcm) 2))
|
||||
(z3 (cat:zero-mrph (cat:Z-chcm) (cat:Z-chcm) 3))
|
||||
(comb (cat:gnrt-? z 0 :z-gnrt))
|
||||
(comb1 (cat:cmbn-? z (cat:cmbn 3)))
|
||||
(comb2 (cat:gnrt-? z3 0 :z-gnrt)))
|
||||
(is (equal (cat:cmbn-degr comb) 2))
|
||||
(is (equal (cat:cmbn-list comb) nil))
|
||||
(is (equal (cat:cmbn-degr comb1) 5))
|
||||
(is (equal (cat:cmbn-list comb1) nil))
|
||||
(is (eq z z2))
|
||||
(is (equal (cat:cmbn-degr comb2) 3))
|
||||
(is (equal (cat:cmbn-list comb2) nil))
|
||||
(is (not (eq z z3))))))
|
||||
|
||||
|
||||
(test idnt-mrph
|
||||
(progn
|
||||
(cat:cat-init)
|
||||
(let* ((zi (cat:idnt-mrph (cat:Z-chcm)))
|
||||
(comb (cat:gnrt-? zi 0 :z-gnrt))
|
||||
(zi2 (cat:idnt-mrph (cat:Z-chcm))))
|
||||
(is (equal (cat:cmbn-degr comb) 0))
|
||||
(is (equal (cat:cmbn-list comb) (cons (cons 1 :z-gnrt) nil)))
|
||||
(is (eq zi zi2)))))
|
||||
|
||||
|
||||
(test opps
|
||||
(progn
|
||||
(cat:cat-init)
|
||||
(let* ((-zi (cat:opps (cat:idnt-mrph (cat:Z-chcm))))
|
||||
(comb (cat:gnrt-? -zi 0 :z-gnrt))
|
||||
(-zi2 (cat:opps (cat:idnt-mrph (cat:Z-chcm)))))
|
||||
(is (equal (cat:cmbn-degr comb) 0))
|
||||
(is (equal (cat:cmbn-list comb) (cons (cons -1 :z-gnrt) nil)))
|
||||
(is (eq -zi -zi2)))))
|
||||
|
||||
|
||||
(defparameter *n* 5)
|
||||
(defun ff (degr i)
|
||||
(do ((*2n* (ash *n* 1))
|
||||
(rslt cat:+empty-list+
|
||||
(cons (cons (let ((cffc (- (random *2n*) *n*)))
|
||||
(if (minusp cffc) cffc (1+ cffc)))
|
||||
(decf gnrt (1+ (random *n*))))
|
||||
rslt))
|
||||
(gnrt i)
|
||||
(k 0 (1+ k)))
|
||||
((= k *n*)
|
||||
(cat:make-cmbn
|
||||
:degr 0
|
||||
:list rslt))))
|
||||
|
||||
(test cmps
|
||||
(progn
|
||||
(cat:cat-init)
|
||||
(let* ((cc (cat:build-chcm :cmpr #'cat:f-cmpr
|
||||
:basis :locally-effective
|
||||
:bsgn 0
|
||||
:intr-dffr #'(lambda (cmbn)
|
||||
(cat:cmbn
|
||||
(1- (cat:cmbn-degr cmbn))))
|
||||
:strt :cmbn
|
||||
:orgn '(Z of Z)))
|
||||
(mrph (cat:build-mrph :sorc cc :trgt cc :degr 0
|
||||
:intr #'ff :strt :gnrt :orgn '(test)))
|
||||
(mrph2 (cat:cmps mrph mrph :gnrt))
|
||||
(comb (cat:gnrt-? mrph2 0 0))
|
||||
(mrph3 (cat:cmps mrph mrph :cmbn))
|
||||
(comb1 (cat:gnrt-? mrph3 0 0))
|
||||
(mrph33 (cat:cmps mrph mrph :cmbn)))
|
||||
(dotimes (i 5)
|
||||
(setq comb (cat:gnrt-? mrph2 0 i))
|
||||
(is (equal (cat:cmbn-degr comb) 0)))
|
||||
(dotimes (i 5)
|
||||
(setq comb1 (cat:gnrt-? mrph3 0 i))
|
||||
(is (equal (cat:cmbn-degr comb1) 0)))
|
||||
(is (eq mrph3 mrph33)))))
|
||||
|
||||
#|
|
||||
(setf s3 (sphere 3))
|
||||
(setf ch3 (chml-clss s3 3))
|
||||
(setf 2ch3 (n-mrph 2 ch3))
|
||||
(setf f3 (z-whitehead s3 2ch3))
|
||||
(setf x (fibration-total f3))
|
||||
(homology x 0 10)
|
||||
(setf k (k-z 3))
|
||||
(setf ch3 (chml-clss k 3))
|
||||
(setf 2ch3 (n-mrph 2 ch3))
|
||||
(setf f3 (z-whitehead k 2ch3))
|
||||
(setf x (fibration-total f3))
|
||||
(homology x 0 10)
|
||||
|#
|
||||
|
||||
(test n-mrph
|
||||
(progn
|
||||
(cat:cat-init)
|
||||
(let* ((s3 (cat:sphere 3))
|
||||
(ch3 (cat:chml-clss s3 3))
|
||||
(2ch3 (cat:n-mrph 2 ch3))
|
||||
;; (f3 (cat:z-whitehead s3 2ch3))
|
||||
;; (x (cat:fibration-total f3))
|
||||
(k (cat:k-z 3)))
|
||||
;; (cat:homology x 0 10)
|
||||
;; (setf ch3 (cat:chml-clss k 3))
|
||||
;; (setf 2ch3 (cat:n-mrph 2 ch3))
|
||||
;; (setf f3 (cat:z-whitehead k 2ch3))
|
||||
;; (setf x (cat:fibration-total f3))
|
||||
;; (cat:homology x 0 10)
|
||||
)))
|
||||
|
||||
|
||||
(setf *n* 10)
|
||||
(setf cat:+too-much-time+ -1)
|
||||
(test add
|
||||
(progn
|
||||
(cat:cat-init)
|
||||
(let* ((cc (cat:build-chcm :cmpr #'cat:f-cmpr
|
||||
:basis :locally-effective
|
||||
:bsgn 0
|
||||
:intr-dffr #'(lambda (cmbn)
|
||||
(cat:cmbn
|
||||
(1- (cat:cmbn-degr cmbn))))
|
||||
:strt :cmbn
|
||||
:orgn '(Z of Z)))
|
||||
(mrph1 (cat:build-mrph :sorc cc :trgt cc :degr 0
|
||||
:intr #'ff :strt :gnrt :orgn '(test)))
|
||||
(mrph2 (cat:build-mrph :sorc cc :trgt cc :degr 0
|
||||
:intr #'ff :strt :gnrt :orgn '(test2)))
|
||||
(mrph3 (cat:add mrph1 mrph2 :gnrt))
|
||||
|
||||
(comb1 (cat:gnrt-? mrph1 0 0))
|
||||
(comb2 (cat:gnrt-? mrph2 0 0))
|
||||
(comb3 (cat:gnrt-? mrph3 0 0))
|
||||
(mrph4 (cat:add mrph1 mrph2 :cmbn))
|
||||
(comb4 (cat:gnrt-? mrph4 0 0))
|
||||
(mrph44 (cat:add mrph1 mrph2 :cmbn)))
|
||||
(is (equal (cat:cmbn-degr comb1) 0))
|
||||
(is (equal (length (cat:cmbn-list comb1)) 10))
|
||||
(is (equal (cat:cmbn-degr comb2) 0))
|
||||
(is (equal (length (cat:cmbn-list comb2)) 10))
|
||||
(is (equal (cat:cmbn-degr comb3) 0))
|
||||
(is (<= (length (cat:cmbn-list comb3)) 20))
|
||||
(is (equal (cat:cmbn-degr comb4) 0))
|
||||
(is (<= (length (cat:cmbn-list comb4)) 20))
|
||||
(is (eq mrph4 mrph44)))))
|
||||
|
||||
|
||||
(test sbtr
|
||||
(progn
|
||||
(cat:cat-init)
|
||||
(let* ((cc (cat:build-chcm :cmpr #'cat:f-cmpr
|
||||
:basis :locally-effective
|
||||
:bsgn 0
|
||||
:intr-dffr #'(lambda (cmbn)
|
||||
(cat:cmbn
|
||||
(1- (cat:cmbn-degr cmbn))))
|
||||
:strt :cmbn
|
||||
:orgn '(Z of Z)))
|
||||
(mrph1 (cat:build-mrph :sorc cc :trgt cc :degr 0
|
||||
:intr #'ff :strt :gnrt :orgn '(test)))
|
||||
(mrph2 (cat:build-mrph :sorc cc :trgt cc :degr 0
|
||||
:intr #'ff :strt :gnrt :orgn '(test2)))
|
||||
(mrph3 (cat:sbtr mrph1 mrph2 :gnrt))
|
||||
(comb1 (cat:gnrt-? mrph1 0 0))
|
||||
(comb2 (cat:gnrt-? mrph2 0 0))
|
||||
(comb3 (cat:gnrt-? mrph3 0 0))
|
||||
(mrph4 (cat:sbtr mrph1 mrph2 :cmbn))
|
||||
(comb4 (cat:gnrt-? mrph4 0 0))
|
||||
(mrph44 (cat:sbtr mrph1 mrph2 :cmbn)))
|
||||
(is (equal (cat:cmbn-degr comb1) 0))
|
||||
(is (equal (length (cat:cmbn-list comb1)) 10))
|
||||
(is (equal (cat:cmbn-degr comb2) 0))
|
||||
(is (equal (length (cat:cmbn-list comb2)) 10))
|
||||
(is (equal (cat:cmbn-degr comb3) 0))
|
||||
(is (<= (length (cat:cmbn-list comb3)) 20))
|
||||
(is (equal (cat:cmbn-degr comb4) 0))
|
||||
(is (<= (length (cat:cmbn-list comb4)) 20))
|
||||
(is (eq mrph4 mrph44)))))
|
||||
Loading…
Reference in New Issue
Block a user