Extracted simple tests from homology-groups.lisp and searching-homology.lisp.
This commit is contained in:
parent
ded9d544ca
commit
911a74de68
@ -17,4 +17,6 @@
|
|||||||
(:file "circle")
|
(:file "circle")
|
||||||
(:file "ccn")
|
(:file "ccn")
|
||||||
(:file "effective-homology-test")
|
(:file "effective-homology-test")
|
||||||
(:file "bicones-test")))
|
(:file "bicones-test")
|
||||||
|
(:file "homology-groups-test")
|
||||||
|
(:file "searching-homology-test")))
|
||||||
|
|||||||
@ -106,6 +106,7 @@
|
|||||||
|
|
||||||
;; delta.lisp
|
;; delta.lisp
|
||||||
|
|
||||||
|
DELTA
|
||||||
DELTA-N-BASIS
|
DELTA-N-BASIS
|
||||||
|
|
||||||
;; effective-homology.lisp
|
;; effective-homology.lisp
|
||||||
@ -121,6 +122,12 @@
|
|||||||
|
|
||||||
FIBRATION-TOTAL
|
FIBRATION-TOTAL
|
||||||
|
|
||||||
|
;; homology-groups
|
||||||
|
|
||||||
|
CHCM-HOMOLOGY
|
||||||
|
CHCM-HOMOLOGY-GEN
|
||||||
|
CHCM-MAT
|
||||||
|
|
||||||
;; k-pi-n.lisp
|
;; k-pi-n.lisp
|
||||||
|
|
||||||
K-Z
|
K-Z
|
||||||
|
|||||||
@ -582,13 +582,6 @@ Rank of the source-module : ~D.~2%"
|
|||||||
(format t "~%End of computing.~2%")))
|
(format t "~%End of computing.~2%")))
|
||||||
mat)))
|
mat)))
|
||||||
|
|
||||||
#|
|
|
||||||
()
|
|
||||||
(setf d (delta 3))
|
|
||||||
(chcm-mat d 2)
|
|
||||||
(chcm-mat d 3)
|
|
||||||
(chcm-mat d 4)
|
|
||||||
|#
|
|
||||||
|
|
||||||
(defun chcm-homology (cc n)
|
(defun chcm-homology (cc n)
|
||||||
(declare (type chain-complex cc) (type fixnum n))
|
(declare (type chain-complex cc) (type fixnum n))
|
||||||
@ -603,13 +596,6 @@ Rank of the source-module : ~D.~2%"
|
|||||||
(terpri) (terpri)
|
(terpri) (terpri)
|
||||||
(done))
|
(done))
|
||||||
|
|
||||||
#|
|
|
||||||
()
|
|
||||||
(setf d (sphere 3))
|
|
||||||
(chcm-homology d 2)
|
|
||||||
(chcm-homology d 3)
|
|
||||||
(chcm-homology d 4)
|
|
||||||
|#
|
|
||||||
|
|
||||||
(defun chcm-homology-gen (cc n)
|
(defun chcm-homology-gen (cc n)
|
||||||
(declare (type chain-complex cc) (type fixnum n))
|
(declare (type chain-complex cc) (type fixnum n))
|
||||||
@ -637,14 +623,6 @@ Rank of the source-module : ~D.~2%"
|
|||||||
rsl))
|
rsl))
|
||||||
rsl))
|
rsl))
|
||||||
|
|
||||||
#|
|
|
||||||
()
|
|
||||||
(setf d (sphere 3))
|
|
||||||
(chcm-homology-gen d 2)
|
|
||||||
(chcm-homology-gen d 3)
|
|
||||||
(chcm-homology-gen d 4)
|
|
||||||
|
|
||||||
|#
|
|
||||||
|
|
||||||
(defun chcm-homology-gen-old (cc n)
|
(defun chcm-homology-gen-old (cc n)
|
||||||
(declare (type chain-complex cc) (type fixnum n))
|
(declare (type chain-complex cc) (type fixnum n))
|
||||||
@ -662,11 +640,3 @@ Rank of the source-module : ~D.~2%"
|
|||||||
(declare (type cons item2))
|
(declare (type cons item2))
|
||||||
(format t "~%~D~6T* ~S" (car item2) (nth (cdr item2) src)))))
|
(format t "~%~D~6T* ~S" (car item2) (nth (cdr item2) src)))))
|
||||||
(done))
|
(done))
|
||||||
|
|
||||||
#|
|
|
||||||
()
|
|
||||||
(setf d (sphere 3))
|
|
||||||
(chcm-homology-gen-old d 2)
|
|
||||||
(chcm-homology-gen-old d 3)
|
|
||||||
(chcm-homology-gen-old d 4)
|
|
||||||
|#
|
|
||||||
|
|||||||
@ -9,8 +9,10 @@
|
|||||||
(DEFUN ECHCM (chcm)
|
(DEFUN ECHCM (chcm)
|
||||||
(rbcc (efhm chcm)))
|
(rbcc (efhm chcm)))
|
||||||
|
|
||||||
|
|
||||||
(DEFGENERIC HOMOLOGY (chcm degr1 &optional degr2))
|
(DEFGENERIC HOMOLOGY (chcm degr1 &optional degr2))
|
||||||
|
|
||||||
|
|
||||||
(DEFMETHOD HOMOLOGY ((chcm chain-complex) degr1 &optional (degr2 (1+ degr1)))
|
(DEFMETHOD HOMOLOGY ((chcm chain-complex) degr1 &optional (degr2 (1+ degr1)))
|
||||||
(declare (fixnum degr1 degr2))
|
(declare (fixnum degr1 degr2))
|
||||||
(do ((degr degr1 (1+ degr)))
|
(do ((degr degr1 (1+ degr)))
|
||||||
@ -19,12 +21,15 @@
|
|||||||
(chcm-homology (echcm chcm) degr)
|
(chcm-homology (echcm chcm) degr)
|
||||||
(terpri) (clock) (terpri)))
|
(terpri) (clock) (terpri)))
|
||||||
|
|
||||||
|
|
||||||
(DEFGENERIC SEARCH-EFHM (chcm orgn))
|
(DEFGENERIC SEARCH-EFHM (chcm orgn))
|
||||||
|
|
||||||
|
|
||||||
(DEFMETHOD SEARCH-EFHM (chcm orgn)
|
(DEFMETHOD SEARCH-EFHM (chcm orgn)
|
||||||
(declare (ignore chcm orgn))
|
(declare (ignore chcm orgn))
|
||||||
nil)
|
nil)
|
||||||
|
|
||||||
|
|
||||||
(DEFMETHOD SLOT-UNBOUND (class (chcm chain-complex) (slot-name (eql 'efhm)))
|
(DEFMETHOD SLOT-UNBOUND (class (chcm chain-complex) (slot-name (eql 'efhm)))
|
||||||
(declare (ignore class))
|
(declare (ignore class))
|
||||||
(the homotopy-equivalence
|
(the homotopy-equivalence
|
||||||
@ -36,9 +41,3 @@
|
|||||||
(error "I don't know how to determine ~
|
(error "I don't know how to determine ~
|
||||||
the effective homology of:~@
|
the effective homology of:~@
|
||||||
~A (Origin: ~A)." chcm (orgn chcm)))))))
|
~A (Origin: ~A)." chcm (orgn chcm)))))))
|
||||||
|
|
||||||
#|
|
|
||||||
(cat-init)
|
|
||||||
(setf d (delta 3))
|
|
||||||
(homology d 0)
|
|
||||||
|#
|
|
||||||
|
|||||||
34
test/homology-groups-test.lisp
Normal file
34
test/homology-groups-test.lisp
Normal file
@ -0,0 +1,34 @@
|
|||||||
|
|
||||||
|
(in-package :kenzo-test)
|
||||||
|
|
||||||
|
(in-suite :kenzo)
|
||||||
|
|
||||||
|
(test chcm-mat
|
||||||
|
(progn
|
||||||
|
(let ((d (cat:delta 3)))
|
||||||
|
(princ (cat:chcm-mat d 2))
|
||||||
|
(princ (cat:chcm-mat d 3))
|
||||||
|
(princ (cat:chcm-mat d 4)))))
|
||||||
|
|
||||||
|
(test chcm-homology
|
||||||
|
(progn
|
||||||
|
(let ((d (cat:sphere 3)))
|
||||||
|
(princ (cat:chcm-homology d 2))
|
||||||
|
(princ (cat:chcm-homology d 3))
|
||||||
|
(princ (cat:chcm-homology d 4)))))
|
||||||
|
|
||||||
|
(test chcm-homology-gen
|
||||||
|
(progn
|
||||||
|
(let ((d (cat:sphere 3)))
|
||||||
|
(princ (cat:chcm-homology-gen d 2))
|
||||||
|
(princ (cat:chcm-homology-gen d 3))
|
||||||
|
(princ (cat:chcm-homology-gen d 4)))))
|
||||||
|
|
||||||
|
|
||||||
|
#|
|
||||||
|
()
|
||||||
|
(setf d (sphere 3))
|
||||||
|
(chcm-homology-gen-old d 2)
|
||||||
|
(chcm-homology-gen-old d 3)
|
||||||
|
(chcm-homology-gen-old d 4)
|
||||||
|
|#
|
||||||
10
test/searching-homology-test.lisp
Normal file
10
test/searching-homology-test.lisp
Normal file
@ -0,0 +1,10 @@
|
|||||||
|
|
||||||
|
(in-package :kenzo-test)
|
||||||
|
|
||||||
|
(in-suite :kenzo)
|
||||||
|
|
||||||
|
(test homology
|
||||||
|
(progn
|
||||||
|
(cat:cat-init)
|
||||||
|
(let ((d (cat:delta 3)))
|
||||||
|
(princ (cat:homology d 0)))))
|
||||||
Loading…
Reference in New Issue
Block a user