44 lines
1.2 KiB
Common Lisp
44 lines
1.2 KiB
Common Lisp
;;; SEARCHING-HOMOLOGY SEARCHING-HOMOLOGY SEARCHING-HOMOLOGY
|
|
;;; SEARCHING-HOMOLOGY SEARCHING-HOMOLOGY SEARCHING-HOMOLOGY
|
|
;;; SEARCHING-HOMOLOGY SEARCHING-HOMOLOGY SEARCHING-HOMOLOGY
|
|
|
|
(IN-PACKAGE "CAT")
|
|
|
|
(PROVIDE "searching-homology")
|
|
|
|
(DEFUN ECHCM (chcm)
|
|
(rbcc (efhm chcm)))
|
|
|
|
(DEFMETHOD HOMOLOGY ((chcm chain-complex) degr1 &optional (degr2 (1+ degr1)))
|
|
(declare (fixnum degr1 degr2))
|
|
(do ((degr degr1 (1+ degr)))
|
|
((>= degr degr2))
|
|
(declare (fixnum degr))
|
|
(chcm-homology (echcm chcm) degr)
|
|
(terpri) (clock) (terpri)))
|
|
|
|
(DEFGENERIC SEARCH-EFHM (chcm dfnt))
|
|
|
|
(DEFMETHOD SEARCH-EFHM (chcm dfnt)
|
|
(declare (ignore chcm dfnt))
|
|
nil)
|
|
|
|
(DEFMETHOD SLOT-UNBOUND (class (chcm chain-complex) (slot-name (eql 'efhm)))
|
|
(declare (ignore class))
|
|
(the equivalence
|
|
(let ((efhm (search-efhm chcm (first (dfnt chcm)))))
|
|
(declare (type (or null equivalence) efhm))
|
|
(setf (efhm chcm)
|
|
(or efhm
|
|
(when (functionp (basis chcm))
|
|
(trivial-eqvl chcm))
|
|
(error "I don't know how to determine ~
|
|
the effective homology of:~@
|
|
~A (Origin: ~A)." chcm (dfnt chcm)))))))
|
|
|
|
#|
|
|
(cat-init)
|
|
(setf d (delta 3))
|
|
(homology d 0)
|
|
|#
|