Computation of spectral sequences added.
This commit is contained in:
parent
10ec7deeaa
commit
f3ed77bd9c
11
kenzo.asd
11
kenzo.asd
@ -57,16 +57,15 @@
|
||||
(:file "cl-space-efhm")
|
||||
(:file "whitehead")
|
||||
(:file "smith")
|
||||
(:file "sage-interface")
|
||||
(:module "anromero"
|
||||
:components
|
||||
((:file "resolutions")
|
||||
(:file "cylinders")
|
||||
(:file "fundamental-classes")
|
||||
(:file "homotopy")
|
||||
(:file "bicomplexes")))
|
||||
#|
|
||||
((:file "bicomplexes")
|
||||
(:file "bicomplexes")
|
||||
(:file "filtered-complexes")
|
||||
(:file "spectral-sequences")))
|
||||
|#
|
||||
))))
|
||||
(:file "spectral-sequences")
|
||||
(:file "persistent-homology")
|
||||
))))))
|
||||
|
||||
@ -250,7 +250,7 @@
|
||||
chcm)))
|
||||
|
||||
#|
|
||||
(setf bc (Build-Bicm :bcbasis #'bas :dffr1 #'dif1 :dffr2 #'dif2 :cmpr 's-cmpr
|
||||
(setf bc (Build-Bicm :bcbasis #'bas :dffr1 #'dif1 :dffr2 #'dif2 :cmpr #'s-cmpr
|
||||
:orgn '(BC-test)))
|
||||
(dotimes (i 5)
|
||||
(print (basis bc i)))
|
||||
|
||||
@ -19,11 +19,17 @@
|
||||
(SETF *flcc-list* +empty-list+)
|
||||
(PUSHNEW '*flcc-list* *list-list*)
|
||||
|
||||
#+clisp(eval-when (:compile-toplevel :load-toplevel :execute)
|
||||
(setf (ext:package-lock :clos) nil))
|
||||
(DEFMETHOD PRINT-OBJECT ((flcm FILTERED-CHAIN-COMPLEX) stream)
|
||||
(the FILTERED-CHAIN-COMPLEX
|
||||
(progn
|
||||
(format stream "[K~D Filtered-Chain-Complex]" (idnm flcm))
|
||||
flcm)))
|
||||
#+clisp(eval-when (:compile-toplevel :load-toplevel :execute)
|
||||
(setf (ext:package-lock :clos) t))
|
||||
|
||||
|
||||
|
||||
(DEFUN FLCC (idnm)
|
||||
(declare (type fixnum idnm))
|
||||
@ -64,7 +70,7 @@
|
||||
(declare
|
||||
(type chain-complex chcm)
|
||||
(type chcm-flin flin)
|
||||
(list orgn))
|
||||
(type list orgn))
|
||||
(the FILTERED-CHAIN-COMPLEX
|
||||
(progn
|
||||
(change-class chcm 'FILTERED-CHAIN-COMPLEX)
|
||||
@ -84,18 +90,19 @@
|
||||
(declare
|
||||
(type chain-complex chcm)
|
||||
(type chcm-flin flin)
|
||||
(list flin-orgn))
|
||||
;;(type list flin-orgn)
|
||||
)
|
||||
(the FILTERED-CHAIN-COMPLEX
|
||||
(progn
|
||||
(change-class chcm 'FILTERED-CHAIN-COMPLEX)
|
||||
(setf orgn (append (orgn chcm) (list 'FILTERED-WITH) flin-orgn))
|
||||
(let ((already (find orgn *flcc-list* :key #'orgn :test #'equal)))
|
||||
(let* ((orgn (append (orgn chcm) (list 'FILTERED-WITH) (list flin-orgn)))
|
||||
(already (find orgn *flcc-list* :key #'orgn :test #'equal)))
|
||||
(declare (type (or null FILTERED-CHAIN-COMPLEX) already))
|
||||
(when already
|
||||
(return-from change-chcm-to-flcc already)))
|
||||
(return-from change-chcm-to-flcc already))
|
||||
(setf (slot-value chcm 'flin) flin)
|
||||
(setf (slot-value chcm 'orgn) orgn)
|
||||
(push chcm *flcc-list*)
|
||||
(push chcm *flcc-list*))
|
||||
chcm)))
|
||||
|
||||
|
||||
@ -289,15 +296,21 @@
|
||||
(DEFCLASS FILTERED-COALGEBRA (filtered-chain-complex coalgebra)
|
||||
())
|
||||
|
||||
(DEFVAR *FLCLGB-LIST*)
|
||||
(DEFVAR *FLCLGB-LIST*
|
||||
"The variable *FLCLGB-LIST* is bound to a list of user created filtered coalgebras")
|
||||
|
||||
(SETF *FLCLGB-LIST* +empty-list+)
|
||||
(PUSHNEW '*FLCLGB-LIST* *list-list*)
|
||||
|
||||
#+clisp(eval-when (:compile-toplevel :load-toplevel :execute)
|
||||
(setf (ext:package-lock :clos) nil))
|
||||
(DEFMETHOD PRINT-OBJECT ((flclgb FILTERED-COALGEBRA) stream)
|
||||
(the FILTERED-COALGEBRA
|
||||
(progn
|
||||
(format stream "[K~D FILTERED-COALGEBRA]" (idnm flclgb))
|
||||
flclgb)))
|
||||
#+clisp(eval-when (:compile-toplevel :load-toplevel :execute)
|
||||
(setf (ext:package-lock :clos) t))
|
||||
|
||||
(DEFUN FltrClgb (idnm)
|
||||
(declare (type fixnum idnm))
|
||||
@ -323,7 +336,7 @@
|
||||
(return-from build-FltrClgb already)))
|
||||
(let ((rslt (build-clgb :cmpr cmpr :basis basis :bsgn bsgn
|
||||
:intr-dffr intr-dffr :dffr-strt dffr-strt
|
||||
:intr-cprd intr-cprf :cprd-strt cprd-strt
|
||||
:intr-cprd intr-cprd :cprd-strt cprd-strt
|
||||
:orgn orgn)))
|
||||
(declare (type coalgebra rslt))
|
||||
(change-class rslt 'FILTERED-COALGEBRA)
|
||||
@ -333,35 +346,41 @@
|
||||
|
||||
(defmethod change-chcm-to-flcc ((chcm coalgebra) flin flin-orgn )
|
||||
(declare
|
||||
|
||||
(type chcm-flin flin)
|
||||
(list flin-orgn))
|
||||
;;(type list flin-orgn)
|
||||
)
|
||||
(the FILTERED-COALGEBRA
|
||||
(progn
|
||||
(change-class chcm 'FILTERED-COALGEBRA)
|
||||
(setf orgn (append (orgn chcm) (list 'FILTERED-WITH) flin-orgn))
|
||||
(let ((already (find orgn *flclgb-list* :key #'orgn :test #'equal)))
|
||||
(let* ((orgn (append (orgn chcm) (list 'FILTERED-WITH) (list flin-orgn)))
|
||||
(already (find orgn *flclgb-list* :key #'orgn :test #'equal)))
|
||||
(declare (type (or null FILTERED-COALGEBRA) already))
|
||||
(when already
|
||||
(return-from change-chcm-to-flcc already)))
|
||||
(return-from change-chcm-to-flcc already))
|
||||
(setf (slot-value chcm 'flin) flin)
|
||||
(setf (slot-value chcm 'orgn) orgn)
|
||||
(push chcm *flCLGB-list*)
|
||||
chcm)))
|
||||
chcm))))
|
||||
|
||||
|
||||
(DEFCLASS FILTERED-ALGEBRA (filtered-chain-complex algebra)
|
||||
())
|
||||
|
||||
(DEFVAR *FLALGB-LIST*)
|
||||
(DEFVAR *FLALGB-LIST*
|
||||
"The variable *FLALGB-LIST* is bound to a list of user created filtered algebras.")
|
||||
|
||||
(SETF *FLALGB-LIST* +empty-list+)
|
||||
(PUSHNEW '*FLALGB-LIST* *list-list*)
|
||||
|
||||
#+clisp(eval-when (:compile-toplevel :load-toplevel :execute)
|
||||
(setf (ext:package-lock :clos) nil))
|
||||
(DEFMETHOD PRINT-OBJECT ((flalgb FILTERED-ALGEBRA) stream)
|
||||
(the FILTERED-ALGEBRA
|
||||
(progn
|
||||
(format stream "[K~D FILTERED-ALGEBRA]" (idnm flalgb))
|
||||
flalgb)))
|
||||
#+clisp(eval-when (:compile-toplevel :load-toplevel :execute)
|
||||
(setf (ext:package-lock :clos) t))
|
||||
|
||||
(DEFUN FltrAlgb (idnm)
|
||||
(declare (type fixnum idnm))
|
||||
@ -387,7 +406,7 @@
|
||||
(return-from build-FltrAlgb already)))
|
||||
(let ((rslt (build-algb :cmpr cmpr :basis basis :bsgn bsgn
|
||||
:intr-dffr intr-dffr :dffr-strt dffr-strt
|
||||
:intr-aprd intr-aprf :aprd-strt aprd-strt
|
||||
:intr-aprd intr-aprd :aprd-strt aprd-strt
|
||||
:orgn orgn)))
|
||||
(declare (type algebra rslt))
|
||||
(change-class rslt 'FILTERED-ALGEBRA)
|
||||
@ -397,35 +416,43 @@
|
||||
|
||||
(defmethod change-chcm-to-flcc ((chcm algebra) flin flin-orgn )
|
||||
(declare
|
||||
|
||||
(type chcm-flin flin)
|
||||
(list flin-orgn))
|
||||
;;(list flin-orgn)
|
||||
)
|
||||
(the FILTERED-ALGEBRA
|
||||
(progn
|
||||
(change-class chcm 'FILTERED-ALGEBRA)
|
||||
(setf orgn (append (orgn chcm) (list 'FILTERED-WITH) flin-orgn))
|
||||
(let ((already (find orgn *flalgb-list* :key #'orgn :test #'equal)))
|
||||
;;(setf orgn (append (orgn chcm) (list 'FILTERED-WITH) (list flin-orgn)))
|
||||
(let* (
|
||||
(orgn (append (orgn chcm) (list 'FILTERED-WITH) flin-orgn))
|
||||
(already (find orgn *flalgb-list* :key #'orgn :test #'equal)))
|
||||
(declare (type (or null FILTERED-ALGEBRA) already))
|
||||
(when already
|
||||
(return-from change-chcm-to-flcc already)))
|
||||
(return-from change-chcm-to-flcc already))
|
||||
(setf (slot-value chcm 'flin) flin)
|
||||
(setf (slot-value chcm 'orgn) orgn)
|
||||
(push chcm *flaLGB-list*)
|
||||
chcm)))
|
||||
chcm))))
|
||||
|
||||
|
||||
(DEFCLASS FILTERED-HOPF-ALGEBRA (filtered-chain-complex hopf-algebra)
|
||||
())
|
||||
|
||||
(DEFVAR *FLHOPF-LIST*)
|
||||
(DEFVAR *FLHOPF-LIST*
|
||||
"The variable *FLHOPF-LIST* is bound to a list of user created filtered Hopf algebras.")
|
||||
|
||||
(SETF *FLHOPF-LIST* +empty-list+)
|
||||
(PUSHNEW '*FLHOPF-LIST* *list-list*)
|
||||
|
||||
#+clisp(eval-when (:compile-toplevel :load-toplevel :execute)
|
||||
(setf (ext:package-lock :clos) nil))
|
||||
(DEFMETHOD PRINT-OBJECT ((flhopf FILTERED-HOPF-ALGEBRA) stream)
|
||||
(the FILTERED-HOPF-ALGEBRA
|
||||
(progn
|
||||
(format stream "[K~D FILTERED-HOPF-ALGEBRA]" (idnm flhopf))
|
||||
flhopf)))
|
||||
#+clisp(eval-when (:compile-toplevel :load-toplevel :execute)
|
||||
(setf (ext:package-lock :clos) t))
|
||||
|
||||
(DEFUN FltrHopf (idnm)
|
||||
(declare (type fixnum idnm))
|
||||
@ -434,35 +461,43 @@
|
||||
|
||||
(defmethod change-chcm-to-flcc ((chcm hopf-algebra) flin flin-orgn )
|
||||
(declare
|
||||
|
||||
(type chcm-flin flin)
|
||||
(list flin-orgn))
|
||||
(the FILTERED-hofp-algebra
|
||||
;;(list flin-orgn)
|
||||
)
|
||||
(the FILTERED-hopf-algebra
|
||||
(progn
|
||||
(change-class chcm 'FILTERED-hopf-COALGEBRA)
|
||||
(setf orgn (append (orgn chcm) (list 'FILTERED-WITH) flin-orgn))
|
||||
(let ((already (find orgn *flhopf-list* :key #'orgn :test #'equal)))
|
||||
(declare (type (or null FILTERED-HOPF-COALGEBRA) already))
|
||||
(change-class chcm 'FILTERED-hopf-ALGEBRA)
|
||||
;;(setf orgn (append (orgn chcm) (list 'FILTERED-WITH) (list flin-orgn)))
|
||||
(let* (
|
||||
(orgn (append (orgn chcm) (list 'FILTERED-WITH) flin-orgn))
|
||||
(already (find orgn *flhopf-list* :key #'orgn :test #'equal)))
|
||||
(declare (type (or null FILTERED-HOPF-ALGEBRA) already))
|
||||
(when already
|
||||
(return-from change-chcm-to-flcc already)))
|
||||
(return-from change-chcm-to-flcc already))
|
||||
(setf (slot-value chcm 'flin) flin)
|
||||
(setf (slot-value chcm 'orgn) orgn)
|
||||
(push chcm *flhopf-list*)
|
||||
chcm)))
|
||||
chcm))))
|
||||
|
||||
|
||||
(DEFCLASS FILTERED-SIMPLICIAL-SET (FILTERED-CHAIN-COMPLEX simplicial-set )
|
||||
())
|
||||
|
||||
(DEFVAR *FLSMST-LIST*)
|
||||
(DEFVAR *FLSMST-LIST*
|
||||
"The variable *FLSMST-LIST* is bound to a list of user created filtered simplicial sets")
|
||||
|
||||
(SETF *FLSMST-LIST* +empty-list+)
|
||||
(PUSHNEW '*FLSMST-LIST* *list-list*)
|
||||
|
||||
#+clisp(eval-when (:compile-toplevel :load-toplevel :execute)
|
||||
(setf (ext:package-lock :clos) nil))
|
||||
(DEFMETHOD PRINT-OBJECT ((flsmst filtered-simplicial-set) stream)
|
||||
(the filtered-simplicial-set
|
||||
(progn
|
||||
(format stream "[K~D Filtered-Simplicial-Set]" (idnm flsmst))
|
||||
flsmst)))
|
||||
#+clisp(eval-when (:compile-toplevel :load-toplevel :execute)
|
||||
(setf (ext:package-lock :clos) t))
|
||||
|
||||
(DEFUN FltrSmSet (idnm)
|
||||
(declare (type fixnum idnm))
|
||||
@ -493,7 +528,7 @@
|
||||
(let ((rslt (build-smst :cmpr cmpr :basis basis :bspn bspn
|
||||
:face face :face* face* :intr-bndr intr-bndr
|
||||
:bndr-strt bndr-strt :intr-dgnl intr-dgnl
|
||||
:dgnl-strt dgnl :orgn orgn)))
|
||||
:dgnl-strt dgnl-strt :orgn orgn)))
|
||||
(declare (type simplicial-set rslt))
|
||||
(change-class rslt 'FILTERED-SIMPLICIAL-SET)
|
||||
(setf (slot-value rslt 'flin) flin)
|
||||
@ -502,35 +537,43 @@
|
||||
|
||||
(defmethod change-chcm-to-flcc ((chcm simplicial-set) flin flin-orgn )
|
||||
(declare
|
||||
|
||||
(type chcm-flin flin)
|
||||
(list flin-orgn))
|
||||
;;(list flin-orgn)
|
||||
)
|
||||
(the FILTERED-SIMPLICIAL-SET
|
||||
(progn
|
||||
(change-class chcm 'FILTERED-SIMPLICIAL-SET)
|
||||
(setf orgn (append (orgn chcm) (list 'FILTERED-WITH) flin-orgn))
|
||||
(let ((already (find orgn *flsmst-list* :key #'orgn :test #'equal)))
|
||||
;; (setf orgn (append (orgn chcm) (list 'FILTERED-WITH) (list flin-orgn)))
|
||||
(let* (
|
||||
(orgn (append (orgn chcm) (list 'FILTERED-WITH) (list flin-orgn)))
|
||||
(already (find orgn *flsmst-list* :key #'orgn :test #'equal)))
|
||||
(declare (type (or null FILTERED-SIMPLICIAL-SET) already))
|
||||
(when already
|
||||
(return-from change-chcm-to-flcc already)))
|
||||
(return-from change-chcm-to-flcc already))
|
||||
(setf (slot-value chcm 'flin) flin)
|
||||
(setf (slot-value chcm 'orgn) orgn)
|
||||
(push chcm *flsmst-list*)
|
||||
chcm)))
|
||||
chcm))))
|
||||
|
||||
|
||||
(DEFCLASS FILTERED-KAN (FILTERED-CHAIN-COMPLEX KAN )
|
||||
())
|
||||
|
||||
(DEFVAR *FLKAN-LIST*)
|
||||
(DEFVAR *FLKAN-LIST*
|
||||
"The variable *FLKAN-LIST* is bound to a list of user created filtered Kan complexes")
|
||||
|
||||
(SETF *FLKAN-LIST* +empty-list+)
|
||||
(PUSHNEW '*FLKAN-LIST* *list-list*)
|
||||
|
||||
#+clisp(eval-when (:compile-toplevel :load-toplevel :execute)
|
||||
(setf (ext:package-lock :clos) nil))
|
||||
(DEFMETHOD PRINT-OBJECT ((flkan filtered-kan) stream)
|
||||
(the filtered-kan
|
||||
(progn
|
||||
(format stream "[K~D Filtered-Kan-Simplicial-Set]" (idnm flkan))
|
||||
flkan)))
|
||||
#+clisp(eval-when (:compile-toplevel :load-toplevel :execute)
|
||||
(setf (ext:package-lock :clos) t))
|
||||
|
||||
(DEFUN FltrKan (idnm)
|
||||
(declare (type fixnum idnm))
|
||||
@ -539,21 +582,23 @@
|
||||
|
||||
(defmethod change-chcm-to-flcc ((chcm kan) flin flin-orgn )
|
||||
(declare
|
||||
|
||||
(type chcm-flin flin)
|
||||
(list flin-orgn))
|
||||
;;(list flin-orgn)
|
||||
)
|
||||
(the FILTERED-KAN
|
||||
(progn
|
||||
(change-class chcm 'FILTERED-KAN)
|
||||
(setf orgn (append (orgn chcm) (list 'FILTERED-WITH) flin-orgn))
|
||||
(let ((already (find orgn *flkan-list* :key #'orgn :test #'equal)))
|
||||
;; (setf orgn (append (orgn chcm) (list 'FILTERED-WITH) (list flin-orgn)))
|
||||
(let* (
|
||||
(orgn (append (orgn chcm) (list 'FILTERED-WITH) (list flin-orgn)))
|
||||
(already (find orgn *flkan-list* :key #'orgn :test #'equal)))
|
||||
(declare (type (or null FILTERED-KAN) already))
|
||||
(when already
|
||||
(return-from change-chcm-to-flcc already)))
|
||||
(return-from change-chcm-to-flcc already))
|
||||
(setf (slot-value chcm 'flin) flin)
|
||||
(setf (slot-value chcm 'orgn) orgn)
|
||||
(push chcm *flkan-list*)
|
||||
chcm)))
|
||||
chcm))))
|
||||
|
||||
|
||||
(DEFCLASS FILTERED-SIMPLICIAL-GROUP (FILTERED-CHAIN-COMPLEX SIMPLICIAL-GROUP )
|
||||
@ -562,10 +607,20 @@
|
||||
(DEFCLASS FILTERED-AB-SIMPLICIAL-GROUP (FILTERED-CHAIN-COMPLEX AB-SIMPLICIAL-GROUP )
|
||||
())
|
||||
|
||||
(DEFVAR *FLSMGR-LIST*)
|
||||
(DEFVAR *FLSMGR-LIST*
|
||||
"The variable *FLSMGR-LIST* is bound to a list of user created filtered simplicial groups")
|
||||
|
||||
(SETF *FLSMGR-LIST* +empty-list+)
|
||||
(PUSHNEW '*FLSMGR-LIST* *list-list*)
|
||||
|
||||
(DEFVAR *FLABSMGR-LIST*
|
||||
"The variable *FLABSMGR-LIST* is bound to a list of user created filtered simplicial abelian groups")
|
||||
|
||||
(SETF *FLABSMGR-LIST* +empty-list+)
|
||||
(PUSHNEW '*FLABSMGR-LIST* *list-list*)
|
||||
|
||||
#+clisp(eval-when (:compile-toplevel :load-toplevel :execute)
|
||||
(setf (ext:package-lock :clos) nil))
|
||||
(DEFMETHOD PRINT-OBJECT ((flsmgr filtered-simplicial-group) stream)
|
||||
(the filtered-simplicial-group
|
||||
(progn
|
||||
@ -577,6 +632,8 @@
|
||||
(progn
|
||||
(format stream "[K~D Filtered-Abelian-Simplicial-Group]" (idnm flsmgr))
|
||||
flsmgr)))
|
||||
#+clisp(eval-when (:compile-toplevel :load-toplevel :execute)
|
||||
(setf (ext:package-lock :clos) t))
|
||||
|
||||
(DEFUN FltrSmgr (idnm)
|
||||
(declare (type fixnum idnm))
|
||||
@ -606,7 +663,7 @@
|
||||
(let ((rslt (build-smgr :cmpr cmpr :basis basis :bspn bspn
|
||||
:face face :face* face* :intr-bndr intr-bndr
|
||||
:bndr-strt bndr-strt :intr-dgnl intr-dgnl
|
||||
:dgnl-strt dgnl :sintr-grml sintr-grml
|
||||
:dgnl-strt dgnl-strt :sintr-grml sintr-grml
|
||||
:sintr-grin sintr-grin :orgn orgn)))
|
||||
(declare (type simplicial-group rslt))
|
||||
(change-class rslt 'FILTERED-SIMPLICIAL-GROUP)
|
||||
@ -621,37 +678,43 @@
|
||||
(declare
|
||||
|
||||
(type chcm-flin flin)
|
||||
(list flin-orgn))
|
||||
;;(list flin-orgn)
|
||||
)
|
||||
(the FILTERED-SIMPLICIAL-GROUP
|
||||
(progn
|
||||
(change-class chcm 'FILTERED-SIMPLICIAL-GROUP)
|
||||
(setf orgn (append (orgn chcm) (list 'FILTERED-WITH) flin-orgn))
|
||||
(let ((already (find orgn *flsmgr-list* :key #'orgn :test #'equal)))
|
||||
;; (setf orgn (append (orgn chcm) (list 'FILTERED-WITH) flin-orgn))
|
||||
(let* (
|
||||
(orgn (append (orgn chcm) (list 'FILTERED-WITH) (list flin-orgn)))
|
||||
(already (find orgn *flsmgr-list* :key #'orgn :test #'equal)))
|
||||
(declare (type (or null FILTERED-SIMPLICIAL-GROUP) already))
|
||||
(when already
|
||||
(return-from change-chcm-to-flcc already)))
|
||||
(return-from change-chcm-to-flcc already))
|
||||
(setf (slot-value chcm 'flin) flin)
|
||||
(setf (slot-value chcm 'orgn) orgn)
|
||||
(push chcm *flsmgr-list*)
|
||||
chcm)))
|
||||
chcm))))
|
||||
|
||||
(defmethod change-chcm-to-flcc ((chcm ab-simplicial-group) flin flin-orgn )
|
||||
(declare
|
||||
|
||||
(type chcm-flin flin)
|
||||
(list flin-orgn))
|
||||
;;(list flin-orgn)
|
||||
)
|
||||
(the FILTERED-AB-SIMPLICIAL-GROUP
|
||||
(progn
|
||||
(change-class chcm 'AB-FILTERED-SIMPLICIAL-GROUP)
|
||||
(setf orgn (append (orgn chcm) (list 'FILTERED-WITH) flin-orgn))
|
||||
(let ((already (find orgn *flabsmgr-list* :key #'orgn :test #'equal)))
|
||||
;; (setf orgn (append (orgn chcm) (list 'FILTERED-WITH) flin-orgn))
|
||||
(let* (
|
||||
(orgn (append (orgn chcm) (list 'FILTERED-WITH) (list flin-orgn)))
|
||||
(already (find orgn *flabsmgr-list* :key #'orgn :test #'equal)))
|
||||
(declare (type (or null FILTERED-AB-SIMPLICIAL-GROUP) already))
|
||||
(when already
|
||||
(return-from change-chcm-to-flcc already)))
|
||||
(return-from change-chcm-to-flcc already))
|
||||
(setf (slot-value chcm 'flin) flin)
|
||||
(setf (slot-value chcm 'orgn) orgn)
|
||||
(push chcm *flabsmgr-list*)
|
||||
chcm)))
|
||||
chcm))))
|
||||
|
||||
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; EXAMPLES ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
@ -659,6 +722,8 @@
|
||||
|
||||
;; BICOMPLEXES
|
||||
|
||||
(DEFVAR BCFlin)
|
||||
|
||||
;; Filtration index function of a Bicomplex (first degree of a generator).
|
||||
(setf BCflin
|
||||
#'(lambda (degr gnrt)
|
||||
@ -682,13 +747,11 @@
|
||||
(defun CHANGE-BICM-TO-FLCC (bc)
|
||||
(declare
|
||||
(type bicomplex bc))
|
||||
(let* ((orgn (orgn bc))
|
||||
(flin BCflin))
|
||||
(let* ((flin BCflin))
|
||||
(declare
|
||||
(type list orgn)
|
||||
(type chcm-flin flin))
|
||||
(the FILTERED-CHAIN-COMPLEX
|
||||
(change-chcm-to-flcc bc flin '(Bicomplex-Flin)))))
|
||||
(change-chcm-to-flcc bc flin 'Bicomplex-Flin))))
|
||||
|
||||
#|
|
||||
(defun bas (degr1 degr2)
|
||||
@ -724,7 +787,6 @@
|
||||
|
||||
;; BARS
|
||||
|
||||
#|
|
||||
(defun abar-bidegree (abar)
|
||||
(declare (type abar abar))
|
||||
(the list
|
||||
@ -734,8 +796,8 @@
|
||||
(setf q (apply #'+ (mapcar #'car (rest abar))))
|
||||
(decf q p)
|
||||
(return-from abar-bidegree (list p q)))))
|
||||
|#
|
||||
|
||||
(DEFVAR abar-flin)
|
||||
(setf abar-flin
|
||||
#'(lambda (degr abar)
|
||||
(declare (type fixnum degr)
|
||||
@ -751,7 +813,7 @@
|
||||
(setq kz2 (k-z2-1))
|
||||
(setq bar2 (bar kz2))
|
||||
|
||||
(change-chcm-to-flcc bar2 abar-flin '(abar-flin))
|
||||
(change-chcm-to-flcc bar2 abar-flin 'abar-flin)
|
||||
|
||||
|
||||
(setf basis7 (basis bar2 7))
|
||||
@ -773,7 +835,6 @@
|
||||
|
||||
;; COBAR
|
||||
|
||||
#|
|
||||
(defun allp-bidegree (allp)
|
||||
(declare (type allp allp))
|
||||
(the list
|
||||
@ -783,33 +844,32 @@
|
||||
(setf q (apply #'+ (mapcar #'car (rest allp))))
|
||||
(incf q p)
|
||||
(return-from allp-bidegree (list (- p) q)))))
|
||||
|#
|
||||
|
||||
(DEFVAR cobar-flin)
|
||||
(setf cobar-flin
|
||||
#'(lambda (degr allp)
|
||||
(declare (type fixnum degr)
|
||||
(declare (ignore degr)
|
||||
(type allp allp))
|
||||
(let* ((allp-bidgr (allp-bidegree allp))
|
||||
(degr1 (first allp-bidgr))
|
||||
(degr2 (second allp-bidgr)))
|
||||
(if (= degr (+ degr1 degr2))
|
||||
degr1
|
||||
0))))
|
||||
(with-allp (l) allp
|
||||
(the fixnum
|
||||
(- (length l))))))
|
||||
|
||||
|
||||
;; TENSOR PRODUCTS
|
||||
|
||||
|
||||
(DEFVAR tnpr-flin)
|
||||
(setf tnpr-flin
|
||||
#'(lambda (degr tnpr)
|
||||
(declare
|
||||
(type fixnum degr)
|
||||
(ignore degr)
|
||||
(type tnpr tnpr))
|
||||
(the fixnum
|
||||
(degr1 tnpr))))
|
||||
|
||||
|
||||
;; FIBRATIONS (CARTESIAN PRODUCTS AND TWISTED PRODUCTS)
|
||||
|
||||
#|
|
||||
(DEFVAR crpr-flin)
|
||||
(setf crpr-flin
|
||||
#'(lambda (degr crpr)
|
||||
(declare
|
||||
@ -822,7 +882,6 @@
|
||||
(type fixnum dgop))
|
||||
(the fixnum
|
||||
(- degr (length (dgop-int-ext dgop)))))))
|
||||
|#
|
||||
|
||||
#|
|
||||
(funcall fbrt-flin 3 '(:crpr (1 . s2) 0 . 3))
|
||||
@ -830,6 +889,7 @@
|
||||
|#
|
||||
|
||||
|
||||
|
||||
;; BICONES
|
||||
|
||||
(defun bicone-flin (flinb flinc flind)
|
||||
|
||||
@ -650,6 +650,8 @@
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
(DEFUN ZGCMBN-TWI (zgcmpr zgcmbn)
|
||||
;;(declare (type zgcmbn zgcmbn))
|
||||
(with-cmbn (degr list) zgcmbn
|
||||
|
||||
@ -7,9 +7,10 @@
|
||||
|
||||
(provide "spectral-sequences")
|
||||
|
||||
|
||||
;; Auxiliary functions to deal with matrices
|
||||
|
||||
(defun submatrix (mtrx first-line last-line first-col last-col)
|
||||
(DEFUN SUBMATRIX (mtrx first-line last-line first-col last-col)
|
||||
(declare (type matrix mtrx)
|
||||
(type fixnum first-line last-line first-col last-col))
|
||||
(the matrix
|
||||
@ -38,7 +39,7 @@
|
||||
|#
|
||||
|
||||
|
||||
(Defun column-j (mtrx j)
|
||||
(DEFUN COLUMN-J (mtrx j)
|
||||
(declare (type matrix mtrx)
|
||||
(type fixnum j))
|
||||
(assert (< j (column-number mtrx)))
|
||||
@ -56,9 +57,10 @@
|
||||
(column-j m 2)
|
||||
|#
|
||||
|
||||
|
||||
;; Function that concatenates two matrices (if their line number is different, the
|
||||
;; needed zeros are added.
|
||||
(defun mtrx-conc (mtrx1 mtrx2)
|
||||
(DEFUN MTRX-CONC (mtrx1 mtrx2)
|
||||
(declare (type matrix mtrx1 mtrx2))
|
||||
(the matrix
|
||||
(let* ((line-n-1 (line-number mtrx1))
|
||||
@ -88,14 +90,14 @@
|
||||
(do ((i 0 (1+ i)))
|
||||
((>= i line-n-1))
|
||||
(declare (type fixnum i))
|
||||
(Setf (aref rslt i j) (aref mtrx1 i j))))
|
||||
(setf (aref rslt i j) (aref mtrx1 i j))))
|
||||
(do ((j 0 (1+ j)))
|
||||
((>= j column-n-2))
|
||||
(declare (type fixnum j))
|
||||
(do ((i 0 (1+ i)))
|
||||
((>= i line-n-2))
|
||||
(declare (type fixnum i))
|
||||
(Setf (aref rslt i (+ column-n-1 j)) (aref mtrx2 i j))))
|
||||
(setf (aref rslt i (+ column-n-1 j)) (aref mtrx2 i j))))
|
||||
rslt))))
|
||||
|
||||
#|
|
||||
@ -111,7 +113,7 @@
|
||||
;; Function that returns a list of generators of the kernel of a matrix.
|
||||
;; Each generator is a list of integers which represent its coordinates
|
||||
;; in the initial basis.
|
||||
(defun kernel (mtrx)
|
||||
(DEFUN KERNEL (mtrx)
|
||||
(declare (type matrix mtrx))
|
||||
(the list
|
||||
(let* ((smith-list (smith mtrx))
|
||||
@ -142,7 +144,7 @@
|
||||
|
||||
;; Returns a matrix which has as columns the elements of the list.
|
||||
;; (Each element in the list is a list of integers).
|
||||
(defun Gnrt-List-to-Mtrx (gnrt-list)
|
||||
(DEFUN GNRT-LIST-TO-MTRX (gnrt-list)
|
||||
(declare (type list gnrt-list))
|
||||
(the matrix
|
||||
(let* ((column-n (length gnrt-list))
|
||||
@ -184,7 +186,7 @@
|
||||
|#
|
||||
|
||||
;; Returns the list of columns of the matrix mtrx.
|
||||
(defun gnrt-mtrx-to-list (mtrx)
|
||||
(DEFUN GNRT-MTRX-TO-LIST (mtrx)
|
||||
(declare (type matrix mtrx))
|
||||
(the list
|
||||
(let* ((column-n (column-number mtrx)))
|
||||
@ -204,7 +206,7 @@
|
||||
;; which are the images of the matrices mtrx1 and mtrx2, where basis=list
|
||||
;; of combinations (c_1...c_m) that forms a basis for B and divisors=list of
|
||||
;; integers (n_1....n_m) such that (n_1*c_1,...,n_m*c_m) forms a basis for C.
|
||||
(defun mtrx-quotient (mtrx1 mtrx2)
|
||||
(DEFUN MTRX-QUOTIENT (mtrx1 mtrx2)
|
||||
(declare (type matrix mtrx1 mtrx2))
|
||||
(the list
|
||||
(let* ((smith-list-1 (smith mtrx1))
|
||||
@ -216,7 +218,7 @@
|
||||
(d1-1Xp1-1Xmtrx2 (copy-mtrx p1-1Xmtrx2)))
|
||||
(declare
|
||||
(list smith-list-1)
|
||||
(type matrix p1 p1-1 s1 p1-1Xmtrx2 p1Xd1 d1-1Xp1))
|
||||
(type matrix p1 p1-1 d1 p1-1Xmtrx2 p1Xd1 d1-1Xp1-1Xmtrx2))
|
||||
(progn
|
||||
(let* ((line-n-1 (line-number p1))
|
||||
(column-n-1 (column-number p1)))
|
||||
@ -280,7 +282,7 @@
|
||||
;; differential matrix M, such that the elements of Z^r_{p,q} are those that
|
||||
;; when we apply M to them we obtain zero, i.e. Z^r_{p,q}=Ker M). Only can be applied
|
||||
;; to a finitely generated complex.
|
||||
(defun FLTR-CHCM-Z-MTRX (fltrcm r p q)
|
||||
(DEFUN FLTR-CHCM-Z-MTRX (fltrcm r p q)
|
||||
(declare
|
||||
(type filtered-chain-complex fltrcm)
|
||||
(type fixnum r p q))
|
||||
@ -348,6 +350,52 @@
|
||||
(setf (aref rslt i j) cffc))))))))
|
||||
rslt)))))
|
||||
|
||||
|
||||
|
||||
(DEFUN FLTR-CHCM-Z-MTRX2 (fltrcm r p q)
|
||||
(declare
|
||||
(type filtered-chain-complex fltrcm)
|
||||
(type fixnum r p q))
|
||||
(the matrix
|
||||
(let* ((cmpr (cmpr1 fltrcm))
|
||||
(dffr (dffr fltrcm))
|
||||
(degr (+ p q))
|
||||
(sbasis (fltrd-basis fltrcm degr p))
|
||||
(tbasis
|
||||
(mapcan
|
||||
#'(lambda (i)
|
||||
(declare (type fixnum i))
|
||||
(bigrd-basis fltrcm i (- (1- degr) i)))
|
||||
(<a-b> (1+ (- p r)) p)))) ;; We suppose that the differential
|
||||
;; respects the filtration, i.e.,
|
||||
;; d(F_pX) \in F_p(dX). If not, we must
|
||||
;; consider (<a-b> (1+ (-p r)) t(degr),
|
||||
;; where t(degr)=max{flin(x), x \in X_degr}.
|
||||
(declare
|
||||
(type cmprf cmpr)
|
||||
(type morphism dffr)
|
||||
(type fixnum degr)
|
||||
(list sbasis tbasis))
|
||||
(let ((srank (length sbasis))
|
||||
(trank (length tbasis)))
|
||||
(declare (type fixnum srank trank))
|
||||
(let ((rslt
|
||||
#-ACLPC
|
||||
(make-array (list trank srank)
|
||||
:element-type 'fixnum
|
||||
:initial-element 0)
|
||||
#+ACLPC
|
||||
(if (or (zerop srank) (zerop trank))
|
||||
(make-array (list trank srank)
|
||||
:element-type 'fixnum)
|
||||
(make-array (list trank srank)
|
||||
:element-type 'fixnum
|
||||
:initial-element 0))))
|
||||
(declare (type matrix rslt))
|
||||
|
||||
rslt)))))
|
||||
|
||||
|
||||
#|
|
||||
(cat-init)
|
||||
(setq kz2 (k-z2-1))
|
||||
@ -360,7 +408,7 @@
|
||||
|
||||
;; Returns a list of generators (list of coordinates) of Z^r_{p,q}
|
||||
;; (only for finitely generated complexes)
|
||||
(defun Fltr-Chcm-Z-Gnrt-List (FltrCm r p q)
|
||||
(DEFUN FLTR-CHCM-Z-GNRT-LIST (FltrCm r p q)
|
||||
(declare (type filtered-chain-complex fltrcm)
|
||||
(type fixnum r p q))
|
||||
(the list
|
||||
@ -371,7 +419,7 @@
|
||||
(list all-basis-gnrt-list))
|
||||
(if (= 0 r)
|
||||
all-basis-gnrt-list
|
||||
(let* ((mat (FLTR-CHCM-Z-MTRX fltrcm r p q))
|
||||
(let* ((mat (fltr-chcm-z-mtrx fltrcm r p q))
|
||||
(line-n (line-number mat))
|
||||
(column-n (column-number mat)))
|
||||
(declare
|
||||
@ -389,7 +437,7 @@
|
||||
;; Returns a list of lists with the coordinates of the elements of
|
||||
;; the basis of F_pX_n (with p=fltr-index, n=degr), that are lists with
|
||||
;; the form (0...0 i 0...0) (only for finitely generated complexes)
|
||||
(defun fltr-basis-gnrt-list (FltrCm degr fltr-index)
|
||||
(DEFUN FLTR-BASIS-GNRT-LIST (fltrcm degr fltr-index)
|
||||
(declare
|
||||
(type filtered-chain-complex fltrcm)
|
||||
(type fixnum degr fltr-index))
|
||||
@ -412,7 +460,7 @@
|
||||
|
||||
;; Returns the matrix of the generators of the numerator in E^r_{p,q}
|
||||
;; (Only for finitely generated complexes)
|
||||
(defun spsq-num-mtrx (FltrCm r p q)
|
||||
(DEFUN SPSQ-NUM-MTRX (fltrcm r p q)
|
||||
(the matrix
|
||||
(let* ((degr (+ p q))
|
||||
(fltr-p-basis (fltrd-basis fltrcm degr p))
|
||||
@ -424,7 +472,7 @@
|
||||
(num1-mtrx (mtrx-conc z1-mtrx fltr-p-1-mtrx))
|
||||
(num1-line-n (line-number num1-mtrx)))
|
||||
(declare
|
||||
(type fixnum degr num1-line-n)
|
||||
(type fixnum degr p-basis-l num1-line-n)
|
||||
(type list fltr-p-basis z1-list fltr-p-1-list)
|
||||
(type matrix z1-mtrx fltr-p-1-mtrx num1-mtrx))
|
||||
(if (eql num1-line-n p-basis-l)
|
||||
@ -443,7 +491,7 @@
|
||||
:element-type 'fixnum
|
||||
:initial-element 0))))
|
||||
(declare
|
||||
(type fixnum num-lin-n num-column-n)
|
||||
(type fixnum num-line-n num-column-n)
|
||||
(type matrix rslt))
|
||||
(do ((j 0 (1+ j)))
|
||||
((>= j num-column-n))
|
||||
@ -451,7 +499,7 @@
|
||||
(do ((i 0 (1+ i)))
|
||||
((>= i num1-line-n))
|
||||
(declare (type fixnum i))
|
||||
(Setf (aref rslt i j) (aref num1-mtrx i j))))
|
||||
(setf (aref rslt i j) (aref num1-mtrx i j))))
|
||||
rslt)))))
|
||||
|
||||
#|
|
||||
@ -461,7 +509,7 @@
|
||||
|
||||
;; Returns the matrix of the generators of the denominator in E^r_{p,q}
|
||||
;; (Only for finitely generated complexes)
|
||||
(defun spsq-den-mtrx (FltrCm r p q)
|
||||
(DEFUN SPSQ-DEN-MTRX (fltrCm r p q)
|
||||
(the matrix
|
||||
(let* ((degr (+ p q))
|
||||
(fltr-p-basis (fltrd-basis fltrcm degr p))
|
||||
@ -522,21 +570,20 @@
|
||||
|
||||
;; Function that returns the representation basis-divisors of E^r_{p,q} of a
|
||||
;; finitely generated complex.
|
||||
(defun eff-spsq-basis-dvs (FltrCm r p q)
|
||||
(DEFUN EFF-SPSQ-BASIS-DVS (FltrCm r p q)
|
||||
(declare
|
||||
(type filtered-chain-complex fltrcm)
|
||||
(type fixnum r p q))
|
||||
(the list
|
||||
(let* ((degr (+ p q))
|
||||
(fltr-p-basis (fltrd-basis fltrcm degr p))
|
||||
(p-basis-l (length fltr-p-basis))
|
||||
(num-mtrx (spsq-num-mtrx fltrcm r p q))
|
||||
(den-mtrx (spsq-den-mtrx fltrcm r p q))
|
||||
(cmbn-list nil)
|
||||
(divs nil))
|
||||
(declare
|
||||
(list fltr-p-basis cmbn-list divs)
|
||||
(type fixnum degr p-basis-l)
|
||||
(type fixnum degr)
|
||||
(type matrix num-mtrx den-mtrx))
|
||||
(progn
|
||||
(if (= 0 (array-total-size num-mtrx))
|
||||
@ -584,7 +631,7 @@
|
||||
|#
|
||||
|
||||
|
||||
(defun eff-spsq-gnrts (FltrCm r p q)
|
||||
(DEFUN EFF-SPSQ-GNRTS (FltrCm r p q)
|
||||
(declare
|
||||
(type filtered-chain-complex fltrcm)
|
||||
(type fixnum r p q))
|
||||
@ -603,14 +650,13 @@
|
||||
|
||||
;; Function that presents on the screen the components of the E^r_{p,q}
|
||||
;; of the spectral sequence of a filtered complex.
|
||||
(defun eff-spsq-group (fltrcm r p q)
|
||||
(DEFUN EFF-SPSQ-GROUP (fltrcm r p q)
|
||||
(declare
|
||||
(type filtered-chain-complex fltrcm)
|
||||
(type fixnum r p q))
|
||||
(let* ((basis-dvs (eff-spsq-basis-dvs fltrcm r p q))
|
||||
(cmbns (first basis-dvs))
|
||||
(divs (second basis-dvs)))
|
||||
(declare (list basis-dvs cmbns divs))
|
||||
(declare (list basis-dvs divs))
|
||||
(format t "Spectral sequence E^~D_{~D,~D}" r p q)
|
||||
(dolist (item divs)
|
||||
(declare (type fixnum item))
|
||||
@ -644,7 +690,7 @@
|
||||
|
||||
;; Function that returns the coordinates of a vector vctr with regard to
|
||||
;; the basis whose elements are the columns of the matrix gnrt-mtrx.
|
||||
(defun vctr-coordinates (vctr gnrt-mtrx)
|
||||
(DEFUN VCTR-COORDINATES (vctr gnrt-mtrx)
|
||||
(declare
|
||||
(type list vctr)
|
||||
(type matrix gnrt-mtrx))
|
||||
@ -655,7 +701,6 @@
|
||||
(p-1 (second smith-list))
|
||||
(D (third smith-list))
|
||||
(q (fourth smith-list))
|
||||
(q-1 (fifth smith-list))
|
||||
(C2 (mtrx-prdc p-1 C))
|
||||
(line-n (column-number B))
|
||||
(A2
|
||||
@ -672,7 +717,7 @@
|
||||
:initial-element 0)))
|
||||
(end nil))
|
||||
(declare
|
||||
(type matrix C B p-1 D q q-1 C2 A2)
|
||||
(type matrix C B p-1 D q C2 A2)
|
||||
(type list smith-list)
|
||||
(type fixnum line-n ))
|
||||
(do ((i 0 (1+ i)))
|
||||
@ -680,8 +725,8 @@
|
||||
(declare (type fixnum i))
|
||||
(let* ((di (aref D i i)))
|
||||
(declare (type fixnum di))
|
||||
(if (eql 0 di)
|
||||
(setq found 1)
|
||||
(if (not (eql 0 di))
|
||||
;;(setq found 1)
|
||||
(progn
|
||||
(setf (aref A2 i 0) (floor (aref C2 i 0) di))))))
|
||||
(let* ((A (mtrx-prdc Q A2)))
|
||||
@ -696,7 +741,7 @@
|
||||
|
||||
;; Function that returns the list of coefficients of the combination "cmbn"
|
||||
;; in the basis (list of generators) "basis" (with comparison function "cmpr").
|
||||
(defun cmbn-cffc-list (cmbn basis cmpr)
|
||||
(DEFUN CMBN-CFFC-LIST (cmbn basis cmpr)
|
||||
(declare
|
||||
(type cmbn cmbn)
|
||||
(type list basis)
|
||||
@ -736,7 +781,7 @@
|
||||
;; Function that returns the list of coordinates of the combination "cmbn" in the basis
|
||||
;; formed by the combinations in the list "gnrt-list". All these combinations are combinations
|
||||
;; of the generators in "basis" ("cmpr" is the comparison function).
|
||||
(defun cmbn-coordinates (cmbn gnrt-list basis cmpr)
|
||||
(DEFUN CMBN-COORDINATES (cmbn gnrt-list basis cmpr)
|
||||
(declare
|
||||
(type cmbn cmbn)
|
||||
(type list gnrt-list basis)
|
||||
@ -769,7 +814,7 @@
|
||||
;; on each of the components of E^r_{p-r,q+r-1} of the differential
|
||||
;; d: E^r_{p,q} --> E^r_{p-r,q+r-1} applied to the element of E^r_{p,q}
|
||||
;; which has as coordinates the list int-list. (Only for finitely generated complexes)
|
||||
(defun eff-spsq-dffr (fltrcm r p q int-list)
|
||||
(DEFUN EFF-SPSQ-DFFR (fltrcm r p q int-list)
|
||||
(declare
|
||||
(type filtered-chain-complex fltrcm)
|
||||
(type fixnum r p q)
|
||||
@ -785,13 +830,13 @@
|
||||
(s-basis-dvs (mtrx-quotient (copy-mtrx num-mtrx) den-mtrx))
|
||||
(s-gnrt-list (first s-basis-dvs))
|
||||
(s-dvs (second s-basis-dvs))
|
||||
(t-basis-dvs (spsq-basis-dvs fltrcm r (- p r) (1- (+ q r))))
|
||||
(t-basis-dvs (eff-spsq-basis-dvs fltrcm r (- p r) (1- (+ q r))))
|
||||
(t-gnrt-list (first t-basis-dvs))
|
||||
(t-dvs (second t-basis-dvs))
|
||||
(selement (make-list (length sbasis) :initial-element 0))
|
||||
(cmbn (cmbn degr)))
|
||||
(declare
|
||||
(type fcmpr cmpr)
|
||||
(type cmprf cmpr)
|
||||
(type fixnum degr)
|
||||
(type list sbasis tbasis z-gnrt-list s-basis-dvs s-gnrt-list s-dvs
|
||||
t-basis-dvs t-gnrt-list t-dvs selement)
|
||||
@ -876,7 +921,7 @@
|
||||
;; the homology group of the complex. It begins with m zeros if the free part of the
|
||||
;; group is Z^m and the rest of the list contains the torsion coefficients.
|
||||
;; (only for finitely generated complexes).
|
||||
(defun eff-compare-spsq-with-homology (fltrcm r degr hmlg-cmpns)
|
||||
(DEFUN EFF-COMPARE-SPSQ-WITH-HOMOLOGY (fltrcm r degr hmlg-cmpns)
|
||||
(declare
|
||||
(type filtered-chain-complex fltrcm)
|
||||
(type fixnum r degr)
|
||||
@ -896,7 +941,7 @@
|
||||
(hmlg-prdc 1)
|
||||
(spsq-prdc 1))
|
||||
(declare
|
||||
(type function spsq)
|
||||
(type function spsq-cmpns)
|
||||
(type list spsq-cmpns mark2)
|
||||
(type fixnum hmlg-prdc spsq-prdc))
|
||||
(progn
|
||||
@ -927,7 +972,7 @@
|
||||
;; filtered complex fltrcm with p+q=degr are equal to E^\infty_{p,q} (i.e., it
|
||||
;; determines the level r which the convergence of the spectral sequence has been
|
||||
;; reached at for the degree n).
|
||||
(defun eff-spsq-cnvg (fltrcm degr)
|
||||
(DEFUN EFF-SPSQ-CNVG (fltrcm degr)
|
||||
(declare
|
||||
(type filtered-chain-complex fltrcm)
|
||||
(type fixnum degr))
|
||||
@ -962,18 +1007,15 @@
|
||||
;; which will determine the level r (=t+1) up to which the spectral sequences E^r_p,q
|
||||
;; (with p+q=n) of the left and right complexes are isomorphic. This function can only be used
|
||||
;; when the top complex is effective (we need to obtain the elements in the basis of this complex).
|
||||
(defun hmtp-eq-fltr-order (hmtp-eq degr)
|
||||
(DEFUN HMTP-EQ-FLTR-ORDER (hmtp-eq degr)
|
||||
(declare
|
||||
(type HOMOTOPY-EQUIVALENCE hmtp-eq)
|
||||
(type fixnum degr))
|
||||
(let* ((lcc (lbcc hmtp-eq))
|
||||
(tcc (tcc hmtp-eq))
|
||||
(lf (lf hmtp-eq))
|
||||
(rh (rh hmtp-eq))
|
||||
(max 0))
|
||||
(declare
|
||||
(type chain-complex lcc tcc)
|
||||
(type morphism lf rh)
|
||||
(type fixnum max))
|
||||
(when (eq (basis tcc) :locally-effective)
|
||||
(error "Hmtp-eq-fltr-order cannot work when the top complex of the homotopy equivalence
|
||||
@ -1005,16 +1047,16 @@
|
||||
;; Function that changes the right bottom chain complex in a homotopy equivalence into
|
||||
;; a filtered complex, with a filtration defined translating the filtration in the left complex
|
||||
;; (which must be a filtered complex).
|
||||
(defun translate-filtration (hmtp-eq)
|
||||
(DEFUN TRANSLATE-FILTRATION (hmtp-eq)
|
||||
(declare
|
||||
(type homotopy-equivalence hmtp-eq))
|
||||
(let ((fltrcm (lbcc hmtp-eq))
|
||||
(eff-chcm (rbcc hmtp-eq)))
|
||||
(declare (type chain-complex fltrcm eff-chcm))
|
||||
(Change-Chcm-TO-Flcc eff-chcm :flin
|
||||
(Change-Chcm-TO-Flcc eff-chcm
|
||||
#'(lambda (degr gnrt)
|
||||
(flin fltrcm (lf hmtp-eq (rg hmtp-eq degr gnrt))))
|
||||
:orgn (orgn eff-chcm))))
|
||||
(orgn eff-chcm))))
|
||||
|
||||
|
||||
|
||||
@ -1027,17 +1069,16 @@
|
||||
;; complex translating the filtration in the original filtered complex FltrCm, suposing that the
|
||||
;; homotopy in the right side is compatible with the filtration in the left complex for such r (we
|
||||
;; supose that flin(rh(lf(y)))-flin(lf(y))<r for every y in the top complex).
|
||||
(defun spsq-basis-dvs (FltrCm r p q)
|
||||
(DEFMETHOD SPSQ-BASIS-DVS ((FltrCm filtered-chain-complex) r p q)
|
||||
(declare
|
||||
(type filtered-chain-complex fltrcm)
|
||||
(type fixnum r p q))
|
||||
(let* ((hmtp-eq (efhm fltrcm))
|
||||
(eff-chcm (rbcc hmtp-eq))
|
||||
(degr (+ p q)))
|
||||
)
|
||||
(declare
|
||||
(type homotopy-equivalence hmtp-eq)
|
||||
(type chain-complex eff-chcm)
|
||||
(type fixnum degr))
|
||||
)
|
||||
(progn
|
||||
(if (not (typep eff-chcm 'filtered-chain-complex))
|
||||
(translate-filtration hmtp-eq))
|
||||
@ -1056,23 +1097,23 @@
|
||||
|#
|
||||
|
||||
|
||||
(defun spsq-gnrts (fltrcm r p q)
|
||||
(DEFUN SPSQ-GNRTS (fltrcm r p q)
|
||||
(declare
|
||||
(type filtered-chain-complex fltrcm)
|
||||
(type fixnum r p q))
|
||||
(let* ((hmtp-eq (efhm fltrcm))
|
||||
(eff-chcm (rbcc hmtp-eq))
|
||||
(degr (+ p q)))
|
||||
)
|
||||
(declare
|
||||
(type homotopy-equivalence hmtp-eq)
|
||||
(type chain-complex eff-chcm)
|
||||
(type fixnum degr))
|
||||
)
|
||||
(progn
|
||||
(if (not (typep eff-chcm 'filtered-chain-complex))
|
||||
(translate-filtration hmtp-eq))
|
||||
(eff-spsq-gnrts eff-chcm r p q))))
|
||||
|
||||
;; Function that presents on the screen the components of the E^r_{p,q}
|
||||
;; Method that presents on the screen the components of the E^r_{p,q}
|
||||
;; of the spectral sequence of a filtered complex fltrcm with effective homology.
|
||||
;; If the effective complex is a filtered complex, we supose that both reductions in the equi-
|
||||
;; valence are compatible with the filtrations (f and g respect the filtration index and h has
|
||||
@ -1080,38 +1121,38 @@
|
||||
;; complex translating the filtration in the original filtered complex FltrCm, suposing that the
|
||||
;; homotopy in the right side is compatible with the filtration in the left complex for such r (we
|
||||
;; supose that flin(rh(lf(y)))-flin(lf(y))<r for every y in the top complex).
|
||||
(defun spsq-group (fltrcm r p q)
|
||||
(DEFMETHOD SPSQ-GROUP ((fltrcm FILTERED-CHAIN-COMPLEX) r p q)
|
||||
(declare
|
||||
(type filtered-chain-complex fltrcm)
|
||||
(type fixnum r p q))
|
||||
(let* ((hmtp-eq (efhm fltrcm))
|
||||
(eff-chcm (rbcc hmtp-eq))
|
||||
(degr (+ p q)))
|
||||
)
|
||||
(declare
|
||||
(type homotopy-equivalence hmtp-eq)
|
||||
(type chain-complex eff-chcm)
|
||||
(type fixnum degr))
|
||||
)
|
||||
(progn
|
||||
(if (not (typep eff-chcm 'filtered-chain-complex))
|
||||
(translate-filtration hmtp-eq))
|
||||
(eff-spsq-group eff-chcm r p q))))
|
||||
|
||||
;; Function that returns the list of integers which correspond to the coordinates
|
||||
;; Method that returns the list of integers which correspond to the coordinates
|
||||
;; on each of the components of E^r_{p-r,q+r-1} of the differential
|
||||
;; d: E^r_{p,q} --> E^r_{p-r,q+r-1} applied to the element of E^r_{p,q}
|
||||
;; which has as coordinates the list int-list.
|
||||
(defun spsq-dffr (fltrcm r p q int-list)
|
||||
(DEFMETHOD SPSQ-DFFR ((fltrcm FILTERED-CHAIN-COMPLEX) r p q int-list)
|
||||
(declare
|
||||
(type filtered-chain-complex fltrcm)
|
||||
(type fixnum p q r)
|
||||
(type list int-list))
|
||||
(let* ((hmtp-eq (efhm fltrcm))
|
||||
(eff-chcm (rbcc hmtp-eq))
|
||||
(degr (+ p q)))
|
||||
)
|
||||
(declare
|
||||
(type homotopy-equivalence hmtp-eq)
|
||||
(type chain-complex eff-chcm)
|
||||
(type fixnum degr))
|
||||
)
|
||||
(progn
|
||||
(if (not (typep eff-chcm 'filtered-chain-complex))
|
||||
(translate-filtration hmtp-eq))
|
||||
@ -1121,7 +1162,7 @@
|
||||
;; of the filtered complex fltrcm (with effective homology) are equal to E^\infty_{p,q} (i.e., it
|
||||
;; determines the level r which the convergence of the spectral sequence has been
|
||||
;; reached at for the degree n).
|
||||
(defun spsq-cnvg (fltrcm degr)
|
||||
(DEFUN SPSQ-CNVG (fltrcm degr)
|
||||
(declare
|
||||
(type filtered-chain-complex fltrcm)
|
||||
(type fixnum degr))
|
||||
@ -1143,12 +1184,13 @@
|
||||
;; Homology filtration
|
||||
|
||||
|
||||
(defun homology-gnrt-list (chcm degr)
|
||||
(declare (type cc chcm) (type fixnum degr))
|
||||
(DEFUN HOMOLOGY-GNRT-LIST (chcm degr)
|
||||
(declare (type chain-complex chcm)
|
||||
(type fixnum degr))
|
||||
(let ((src (cons :unused (basis chcm degr)))
|
||||
(hom-dvs-gnrts (homologie (chcm-mat chcm degr) (chcm-mat chcm (1+ degr))))
|
||||
(rslt nil))
|
||||
(declare (type list src hom-dvs-gnrts rslt))
|
||||
)
|
||||
(declare (type list src hom-dvs-gnrts ))
|
||||
(mapcar #'(lambda (item)
|
||||
(declare (type list item))
|
||||
(let ((cmbn (cmbn degr))
|
||||
@ -1161,8 +1203,8 @@
|
||||
|
||||
|
||||
|
||||
|
||||
(defun homology-fltr1 (fltrcm degr fltr-index)
|
||||
#|
|
||||
(DEFUN HOMOLOGY-FLTR1 (fltrcm degr fltr-index)
|
||||
(declare
|
||||
(type filtered-chain-complex fltrcm)
|
||||
(type fixnum degr fltr-index))
|
||||
@ -1181,22 +1223,10 @@
|
||||
(ss-dvs (second ss-basis-dvs))
|
||||
(rslt nil))
|
||||
(declare
|
||||
(type fcmpr cmpr)
|
||||
(type cmprf cmpr)
|
||||
(type fixnum r q)
|
||||
(type list total-basis z-gnrt-list ss-basis-dvs ss-gnrt-list ss-dvs rslt)
|
||||
(type matrix num-mtrx den-mtrx))
|
||||
(labels ((2list-add (list1 list2)
|
||||
(declare (type list list1 list2))
|
||||
(the list
|
||||
(mapcar #'+ list1 list2)))
|
||||
(n-list (n list)
|
||||
(declare
|
||||
(type list list)
|
||||
(type fixnum n))
|
||||
(the list
|
||||
(mapcar #'(lambda (i)
|
||||
(* n i))
|
||||
list))))
|
||||
(do ((mark1 ss-gnrt-list (cdr mark1))
|
||||
(mark2 ss-dvs (cdr mark2)))
|
||||
((endp mark1))
|
||||
@ -1236,30 +1266,28 @@
|
||||
cmbn2)))
|
||||
(car mark3))))))))
|
||||
(setf rslt (nconc rslt (list cmbn)))
|
||||
rslt)))))))
|
||||
rslt))))))
|
||||
(<a-b> 0 fltr-index))))
|
||||
(if (not (endp fltrt-basis))
|
||||
(let ((fltrt-mtrx
|
||||
(let* ((fltrt-mtrx
|
||||
(gnrt-list-to-mtrx
|
||||
(mapcar #'(lambda (cmbn)
|
||||
(cmbn-cff-list cmbn total-basis cmpr))
|
||||
(fltrt-basis))))
|
||||
(cmbn-cffc-list cmbn total-basis cmpr))
|
||||
(fltrd-basis))))
|
||||
(num-mtrx (mtrx-conc fltrt-mtrx dffr-mtrx)))
|
||||
(mtrx-quotient num-mtrx dffr-mtrx))
|
||||
nil)))
|
||||
|#
|
||||
|
||||
|
||||
|
||||
(defun eff-hmlg-fltr (fltrcm degr p)
|
||||
(DEFUN EFF-HMLG-FLTR (fltrcm degr p)
|
||||
(declare
|
||||
(type filtered-chain-complex fltrcm)
|
||||
(type fixnum degr p))
|
||||
(let* ((min-max-1 (flin-min-max fltrcm (1- degr)))
|
||||
(min-1 (first min-max-1))
|
||||
(max-1 (second min-max-1))
|
||||
(min-max+1 (flin-min-max fltrcm (1+ degr)))
|
||||
(min+1 (first min-max+1))
|
||||
(max+1 (second min-max+1))
|
||||
(r (1+ (- p min-1)))
|
||||
(q (- degr p))
|
||||
(Z-gnrts (Fltr-Chcm-Z-Gnrt-List FltrCm r p q))
|
||||
@ -1278,7 +1306,7 @@
|
||||
)))))
|
||||
|
||||
|
||||
(defun hmlg-fltr (fltrcm degr p)
|
||||
(DEFUN HMLG-FLTR (fltrcm degr p)
|
||||
(declare
|
||||
(type filtered-chain-complex fltrcm)
|
||||
(type fixnum degr))
|
||||
@ -1296,62 +1324,180 @@
|
||||
|
||||
|
||||
|
||||
(DEFTYPE ss-type () '(member :serre :eilenberg-moore :filtration))
|
||||
;;(DEFTYPE ss-type () '(member :serre :eilenberg-moore :filtration))
|
||||
|
||||
|
||||
|
||||
(defclass OUTPUT-SPECTRAL-SEQUENCE ()
|
||||
((hmeq :type homotopy-equivalence :initarg hmeq :reader hmeq)
|
||||
(eff-flin :type chcm-fltrindex :initarg eff-flin :reader eff-flin)
|
||||
(bgn :type fixnum :initarg bgn :reader bgn)
|
||||
(DEFCLASS SPECTRAL-SEQUENCE ()
|
||||
(;; FiLTeRedchainCoMplex
|
||||
(fltrcm :type filtered-chain-complex :initarg :fltrcm :reader fltrcm)
|
||||
;; ReSuLTS
|
||||
(group-rslts :type list :initarg :group-rslts :reader group-rslts)
|
||||
(dffr-rslts :type list :initarg :dffr-rslts :reader dffr-rslts)
|
||||
;; IDentification NuMber
|
||||
(idnm :type fixnum :initform (incf *idnm-counter*) :reader idnm)
|
||||
;; ORiGiN
|
||||
(orgn :type list :initarg :orgn :reader orgn)))
|
||||
|
||||
|
||||
(DEFVAR *oss-list*)
|
||||
(SETF *oss-list* +empty-list+)
|
||||
(PUSHNEW '*oss-list* *list-list*)
|
||||
(DEFVAR *ss-list*
|
||||
"The variable *SS-LIST* is bound to a list of user created spectral sequences")
|
||||
(SETF *ss-list* +empty-list+)
|
||||
(PUSHNEW '*ss-list* *list-list*)
|
||||
|
||||
(DEFMETHOD PRINT-OBJECT ((oss OUTPUT-SPECTRAL-SEQUENCE) stream)
|
||||
(the output-spectral-sequence
|
||||
|
||||
#+clisp(eval-when (:compile-toplevel :load-toplevel :execute)
|
||||
(setf (ext:package-lock :clos) nil))
|
||||
(DEFMETHOD PRINT-OBJECT ((ss SPECTRAL-SEQUENCE) stream)
|
||||
(the spectral-sequence
|
||||
(progn
|
||||
(format stream "[K~D output-spectral-sequence]" (idnm oss))
|
||||
oss)))
|
||||
(format stream "[K~D Spectral-Sequence]" (idnm ss))
|
||||
ss)))
|
||||
#+clisp(eval-when (:compile-toplevel :load-toplevel :execute)
|
||||
(setf (ext:package-lock :clos) t))
|
||||
|
||||
(DEFUN Oss (idnm)
|
||||
|
||||
(DEFUN SS (idnm)
|
||||
(declare (type fixnum idnm))
|
||||
(the (or OUTPUT-SPECTRAL-SEQUENCE null)
|
||||
(find idnm *oss-list* :key #'idnm)))
|
||||
(the (or SPECTRAL-SEQUENCE null)
|
||||
(find idnm *ss-list* :key #'idnm)))
|
||||
|
||||
|
||||
(DEFUN BUILD-oss (&key hmeq eff-flin bgn orgn)
|
||||
(DEFUN BUILD-ss (fltrcm orgn)
|
||||
(declare
|
||||
(type homotopy-equivalence hmeq)
|
||||
(type chcm-fltrindex eff-flin)
|
||||
(type fixnum bgn)
|
||||
(type filtered-chain-complex fltrcm)
|
||||
(type list orgn))
|
||||
(the output-spectral-sequence
|
||||
(the spectral-sequence
|
||||
(progn
|
||||
(let ((already (find orgn *oss-list* :test #'equal :key #'orgn)))
|
||||
(declare (type (or output-spectral-sequence null) already))
|
||||
(let ((already (find orgn *ss-list* :test #'equal :key #'orgn)))
|
||||
(declare (type (or spectral-sequence null) already))
|
||||
(when already
|
||||
(return-from build-oss already)))
|
||||
(let ((oss (make-instance 'output-spectral-sequence
|
||||
:hmeq hmeq
|
||||
:eff-flin eff-flin
|
||||
:bgn bgn
|
||||
:orgn orgn)))
|
||||
(declare (type output-spectral-sequence oss))
|
||||
(push oss *oss-list*)
|
||||
oss))))
|
||||
(return-from build-ss already)))
|
||||
(let ((ss (make-instance 'spectral-sequence
|
||||
:fltrcm fltrcm
|
||||
:orgn orgn
|
||||
:group-rslts +empty-list+
|
||||
:dffr-rslts +empty-list+)))
|
||||
(declare (type spectral-sequence ss))
|
||||
(push ss *ss-list*)
|
||||
ss))))
|
||||
|
||||
;;(defun serre-ss (fibration)
|
||||
|
||||
#|(defun serre-ss (f)
|
||||
(DEFMETHOD SPSQ-BASIS-DVS ((ss SPECTRAL-SEQUENCE) r p q)
|
||||
(declare
|
||||
(type fixnum r p q))
|
||||
(let* ((fltrcm (fltrcm ss))
|
||||
(rslts (group-rslts ss))
|
||||
(pos (position (list r p q nil) rslts :test #'(lambda (l1 l2)
|
||||
(and
|
||||
(eq (first l1) (first l2))
|
||||
(eq (second l1) (second l2))
|
||||
(eq (third l1) (third l2)))))))
|
||||
(the list
|
||||
(if pos (fourth (nth pos rslts))
|
||||
(let ((basis-dvs (spsq-basis-dvs fltrcm r p q)))
|
||||
(declare (type list basis-dvs))
|
||||
(progn
|
||||
(push (list r p q basis-dvs) rslts)
|
||||
(setf (slot-value ss 'group-rslts) rslts)
|
||||
basis-dvs))))))
|
||||
|
||||
|
||||
(DEFMETHOD SPSQ-GROUP ((ss SPECTRAL-SEQUENCE) r p q)
|
||||
(declare
|
||||
(type spectral-sequence ss)
|
||||
(type fixnum r p q))
|
||||
(let* ((basis-dvs (SPSQ-BASIS-DVS SS r p q))
|
||||
(divs (second basis-dvs)))
|
||||
(declare (list basis-dvs divs))
|
||||
(format t "Spectral sequence E^~D_{~D,~D}" r p q)
|
||||
(dolist (item divs)
|
||||
(declare (type fixnum item))
|
||||
(if (not (eql 1 item))
|
||||
(progn
|
||||
(format t "~2%Component Z")
|
||||
(unless (zerop item)
|
||||
(format t "/~DZ" item))
|
||||
)))
|
||||
(terpri)))
|
||||
|
||||
|
||||
;; Method that returns the list of integers which correspond to the coordinates
|
||||
;; on each of the components of E^r_{p-r,q+r-1} of the differential
|
||||
;; d: E^r_{p,q} --> E^r_{p-r,q+r-1} applied to the element of E^r_{p,q}
|
||||
;; which has as coordinates the list int-list.
|
||||
(DEFMETHOD SPSQ-DFFR ((ss SPECTRAL-SEQUENCE) r p q int-list)
|
||||
(declare
|
||||
(type spectral-sequence ss)
|
||||
(type fixnum p q r)
|
||||
(type list int-list))
|
||||
(let* ((fltrcm (fltrcm ss))
|
||||
(rslts (dffr-rslts ss))
|
||||
(pos (position (list r p q int-list nil) rslts :test #'(lambda (l1 l2)
|
||||
(and
|
||||
(eq (first l1) (first l2))
|
||||
(eq (second l1) (second l2))
|
||||
(eq (third l1) (third l2))
|
||||
(eq (fourth l1) (fourth l2)))))))
|
||||
(the list
|
||||
(if pos (fifth (nth pos rslts))
|
||||
(let ((l (spsq-dffr fltrcm r p q int-list)))
|
||||
(declare (type list l))
|
||||
(progn
|
||||
(push (list r p q int-list l) rslts)
|
||||
(setf (slot-value ss 'dffr-rslts) rslts)
|
||||
l))))))
|
||||
|
||||
|
||||
(DEFUN SERRE-SS (f)
|
||||
(declare (type fibration f))
|
||||
(let* ((X (fibration-total f))
|
||||
(hmeq (efhm X))
|
||||
(eX (rbcc efhm))
|
||||
(let* ((fltrcm (fibration-total f))
|
||||
(ecc (rbcc (efhm fltrcm))))
|
||||
(progn
|
||||
(change-chcm-to-flcc fltrcm crpr-flin 'crpr-flin)
|
||||
(change-chcm-to-flcc ecc tnpr-flin 'tnpr-flin)
|
||||
(build-ss fltrcm `(Serre-Spectral-Sequence ,f)))))
|
||||
|
||||
|
||||
(DEFUN EILENBERG-MOORE-SS (x)
|
||||
(declare (type simplicial-set x))
|
||||
(let* ((ox (loop-space x))
|
||||
(ecc (rbcc (efhm OX))))
|
||||
(progn
|
||||
(change-chcm-to-flcc ecc cobar-flin 'cobar-flin)
|
||||
(build-ss ecc `(Eilenberg-Moore-Spectral-Sequence ,x)))))
|
||||
|
||||
|
||||
#|
|
||||
(cat-init)
|
||||
(progn
|
||||
(setf s3 (sphere 3))
|
||||
(setf k3 (chml-clss s3 3))
|
||||
(setf F3 (z-whitehead s3 k3)))
|
||||
|
||||
|
||||
(setf sss (serre-ss f3))
|
||||
|
||||
|
||||
(setf r 2)
|
||||
|
||||
(dotimes (n 8)
|
||||
(dotimes (p (1+ n))
|
||||
(let ((q (- n p)))
|
||||
(spsq-group sss r p q))))
|
||||
|
||||
|
||||
|
||||
|
||||
(cat-init)
|
||||
(setf ss2 (eilenberg-moore-ss (loop-space (sphere 3))))
|
||||
(setf effox (rbcc (efhm (fltrcm ss2))))
|
||||
|
||||
(spsq-group effOX 1 -2 6)
|
||||
|
||||
(dotimes (n 9)
|
||||
(dotimes (p (1+ n))
|
||||
(let ((q (+ n p)))
|
||||
(spsq-group ss2 1 (- p) q))))
|
||||
|
||||
|#
|
||||
|
||||
|
||||
@ -53,7 +53,16 @@
|
||||
"cs-twisted-products"
|
||||
"cl-space-efhm"
|
||||
"whitehead"
|
||||
"smith"))
|
||||
"smith"
|
||||
"anromero\\resolutions"
|
||||
"anromero\\cylinders"
|
||||
"anromero\\fundamental-classes"
|
||||
"anromero\\homotopy"
|
||||
"anromero\\bicomplexes"
|
||||
"anromero\\filtered-complexes"
|
||||
"anromero\\spectral-sequences"
|
||||
"anromero\\persistent-homology"
|
||||
))
|
||||
|
||||
(DO ((i 1 (1+ i))
|
||||
(mark +file-list+ (cdr mark)))
|
||||
@ -61,8 +70,8 @@
|
||||
(format t "~% FILE ~2D: ~A" i (car mark)))
|
||||
|
||||
(DEFCONSTANT +SOURCE-EXTENSION+
|
||||
#+(or allegro lispworks) "cl"
|
||||
#+(or clisp ccl ecl sbcl) "lisp"
|
||||
#+(or lispworks) "cl"
|
||||
#+(or allegro clisp ccl ecl sbcl) "lisp"
|
||||
#-(or allegro ccl clisp ecl lispworks sbcl)
|
||||
(error "Not an Allegro or CCL or CLisp or LispWorks or SBCL environment."))
|
||||
|
||||
|
||||
Loading…
Reference in New Issue
Block a user