mmarco/kenzo
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

Spectral sequence associated to a bicomplex added.

Browse Source 
Spectral sequence associated to a list of morphisms added.
This commit is contained in:
Ana Romero Ibáñez 2019-09-13 11:20:50 +02:00
parent 658803c996
commit 676b634a8a
2 changed files with 422 additions and 156 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

487
src/anromero/bicomplexes.lisp
View File

@ -7,37 +7,37 @@
(PROVIDE "bicomplexes") (PROVIDE "bicomplexes")
(DEFMETHOD PRINT-KEYCONS ((car (eql :BcGnrt)) cdr stream) (DEFMETHOD PRINT-KEYCONS ((car (eql :BcGnrt)) cdr stream)
(declare (declare
(cons cdr) (cons cdr)
(stream stream)) (stream stream))
(the (eql t) (the (eql t)
(let* (let*
((cdr (cons car cdr)) ((cdr (cons car cdr))
(degr1 (BcGnrt-Degr1 cdr)) (degr1 (BcGnrt-Degr1 cdr))
(degr2 (BcGnrt-Degr2 cdr)) (degr2 (BcGnrt-Degr2 cdr))
(gnrt (BcGnrt-gnrt cdr))) (gnrt (BcGnrt-gnrt cdr)))
(progn (progn
(format stream "<BcGnrt ") (format stream "<BcGnrt ")
(format stream "[~D ~D] ~A" degr1 degr2 gnrt) (format stream "[~D ~D] ~A" degr1 degr2 gnrt)
(format stream ">")) (format stream ">"))
t))) t)))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; TYPES FOR BICOMPLEXES ;;; ;;; TYPES FOR BICOMPLEXES ;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; TYPE BcGnrt (a generator in a Bicomplex) ;; TYPE BcGnrt (a generator in a Bicomplex)
(DEFUN BcGnrt-p (object) (DEFUN BcGnrt-p (object)
(declare (type any object)) (declare (type any object))
(the boolean (the boolean
(and (consp object) (and (consp object)
(eql :BcGnrt (car object)) (eql :BcGnrt (car object))
(consp (cdr object)) (consp (cdr object))
(consp (cadr object)) (consp (cadr object))
(typep (caadr object) 'fixnum) (typep (caadr object) 'fixnum)
(typep (cdadr object) 'fixnum)))) (typep (cdadr object) 'fixnum))))
(DEFTYPE BcGnrt () '(satisfies BcGnrt-p)) (DEFTYPE BcGnrt () '(satisfies BcGnrt-p))
#| #|
@ -50,31 +50,31 @@
;; TYPE BcBasis (basis of a Bicomplex, function of the variables p and q or ;; TYPE BcBasis (basis of a Bicomplex, function of the variables p and q or
;; ":locally-effective") ;; ":locally-effective")
(DEFTYPE BcBASIS () '(or function (eql :locally-effective))) (DEFTYPE BcBASIS () '(or function (eql :locally-effective)))
;; (function (degr degr) (list gnrt)) ;; (function (degr degr) (list gnrt))
;; TYPE Bicomplex ;; TYPE Bicomplex
(DEFUN OrgnBiCmpl-p (object) (DEFUN OrgnBiCmpl-p (object)
(declare (type chain-complex object)) (declare (type chain-complex object))
(let* ((orgn (orgn object))) (let* ((orgn (orgn object)))
(the boolean (the boolean
(and (consp orgn) (and (consp orgn)
(eql (car orgn) 'BiCmpl))))) (eql (car orgn) 'BiCmpl)))))
(DEFTYPE Bicomplex () '(satisfies OrgnBiCmpl-p)) (DEFTYPE Bicomplex () '(satisfies OrgnBiCmpl-p))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; FUCTIONS FOR THE REPRESENTATION OF (GENERAL) BICOMPLEXES ;;; ;;; FUCTIONS FOR THE REPRESENTATION OF (GENERAL) BICOMPLEXES ;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Function that builds a generator of a Bicomplex from two degrees and ;; Function that builds a generator of a Bicomplex from two degrees and
;; a simple generator. ;; a simple generator.
(DEFUN build-BcGnrt (degr1 degr2 gnrt) (DEFUN build-BcGnrt (degr1 degr2 gnrt)
(declare (declare
(type fixnum degr1 degr2) (type fixnum degr1 degr2)
(type any gnrt)) (type any gnrt))
(list :BcGnrt (cons degr1 degr2) gnrt)) (list :BcGnrt (cons degr1 degr2) gnrt))
#| #|
(build-BcGnrt 2 3 'c) (build-BcGnrt 2 3 'c)
@ -84,18 +84,18 @@
;; Function that returns the first degree from a bicomplex' generator. ;; Function that returns the first degree from a bicomplex' generator.
(DEFUN BcGnrt-Degr1 (BcGnrt) (DEFUN BcGnrt-Degr1 (BcGnrt)
(declare (type BcGnrt BcGnrt)) (declare (type BcGnrt BcGnrt))
(caadr BcGnrt)) (caadr BcGnrt))
;; Function that returns the second degree from a bicomplex' generator. ;; Function that returns the second degree from a bicomplex' generator.
(DEFUN BcGnrt-Degr2 (BcGnrt) (DEFUN BcGnrt-Degr2 (BcGnrt)
(declare (type BcGnrt BcGnrt)) (declare (type BcGnrt BcGnrt))
(cdadr BcGnrt)) (cdadr BcGnrt))
;; Function that returns the original generator from a bicomplex' generator. ;; Function that returns the original generator from a bicomplex' generator.
(DEFUN BcGnrt-Gnrt (BcGnrt) (DEFUN BcGnrt-Gnrt (BcGnrt)
(declare (type BcGnrt BcGnrt)) (declare (type BcGnrt BcGnrt))
(caddr BcGnrt)) (caddr BcGnrt))
#| #|
(build-BcGnrt 5 6 8) (build-BcGnrt 5 6 8)
@ -108,23 +108,23 @@
;; Comparison function of a bicomplex. ;; Comparison function of a bicomplex.
(defun BC-CMPR (cmpr) (defun BC-CMPR (cmpr)
(declare (type cmprf cmpr)) (declare (type cmprf cmpr))
(flet ((comp (bc1 bc2) (flet ((comp (bc1 bc2)
(declare (type BcGnrt bc1 bc2)) (declare (type BcGnrt bc1 bc2))
(let ((degr11 (BcGnrt-Degr1 bc1)) (let ((degr11 (BcGnrt-Degr1 bc1))
(degr21 (BcGnrt-Degr2 bc1)) (degr21 (BcGnrt-Degr2 bc1))
(degr12 (BcGnrt-Degr1 bc2)) (degr12 (BcGnrt-Degr1 bc2))
(degr22 (BcGnrt-Degr2 bc2)) (degr22 (BcGnrt-Degr2 bc2))
(gnrt1 (BcGnrt-Gnrt bc1)) (gnrt1 (BcGnrt-Gnrt bc1))
(gnrt2 (BcGnrt-Gnrt bc2))) (gnrt2 (BcGnrt-Gnrt bc2)))
(declare (declare
(type fixnum degr11 degr21 degr12 degr22) (type fixnum degr11 degr21 degr12 degr22)
(type any gnrt1 gnrt2)) (type any gnrt1 gnrt2))
(lexico (lexico
(f-cmpr degr11 degr12) (f-cmpr degr11 degr12)
(f-cmpr degr21 degr22) (f-cmpr degr21 degr22)
(funcall cmpr gnrt1 gnrt2))))) (funcall cmpr gnrt1 gnrt2)))))
(the cmprf #'comp))) (the cmprf #'comp)))
#| #|
(setf cmpr (BC-CMPR #'s-cmpr)) (setf cmpr (BC-CMPR #'s-cmpr))
@ -136,95 +136,95 @@
;; Basis of a bicomplex (from a function of type BcBasis). ;; Basis of a bicomplex (from a function of type BcBasis).
(DEFUN BC-BASIS (bcbasis) (DEFUN BC-BASIS (bcbasis)
(declare (type BcBasis bcbasis)) (declare (type BcBasis bcbasis))
(when (eq bcbasis :locally-effective) (when (eq bcbasis :locally-effective)
(return-from bc-basis :locally-effective)) (return-from bc-basis :locally-effective))
(flet ((bas (degr) (flet ((bas (degr)
(declare (type fixnum degr)) (declare (type fixnum degr))
(the list (the list
(progn (progn
(when (minusp degr) (when (minusp degr)
(return-from bas +empty-list+)) (return-from bas +empty-list+))
(mapcan (mapcan
#'(lambda (degr1) #'(lambda (degr1)
(declare (type fixnum degr1)) (declare (type fixnum degr1))
(let* ((degr2 (- degr degr1)) (let* ((degr2 (- degr degr1))
(basis (funcall bcbasis degr1 degr2))) (basis (funcall bcbasis degr1 degr2)))
(declare (declare
(fixnum degr2) (fixnum degr2)
(list basis)) (list basis))
(the list (the list
(mapcar (mapcar
#'(lambda (gnrt) #'(lambda (gnrt)
(declare (type gnrt gnrt)) (declare (type gnrt gnrt))
(the BcGnrt (the BcGnrt
(build-BcGnrt degr1 degr2 gnrt))) (build-BcGnrt degr1 degr2 gnrt)))
basis))) basis)))
) )
(<a-b> 0 degr)))))) (<a-b> 0 degr))))))
(the basis #'bas))) (the basis #'bas)))
#| #|
(defun bas (degr1 degr2) (defun bas (degr1 degr2)
(if (and (= degr1 0) (= degr2 1)) (return-from bas '(a))) (if (and (= degr1 0) (= degr2 1)) (return-from bas '(a)))
(if (and (= degr1 1) (= degr2 0)) (return-from bas '(b))) (if (and (= degr1 1) (= degr2 0)) (return-from bas '(b)))
(if (and (= degr1 1) (= degr2 1)) (return-from bas '(c))) (if (and (= degr1 1) (= degr2 1)) (return-from bas '(c)))
(if (and (= degr1 2) (= degr2 0)) (return-from bas '(d))) (if (and (= degr1 2) (= degr2 0)) (return-from bas '(d)))
(return-from bas nil)) (return-from bas nil))
(setf basis (BC-BASIS #'bas)) (setf basis (BC-BASIS #'bas))
(dotimes (i 5) (dotimes (i 5)
(print (funcall basis i))) (print (funcall basis i)))
|# |#
;; Differential function of a Bicomplex (from the differential functions, ;; Differential function of a Bicomplex (from the differential functions,
;; dffr1=horizontal dffr, dffr2=vertical dffr). ;; dffr1=horizontal dffr, dffr2=vertical dffr).
(DEFUN BC-INTR-DFFR (dffr1 dffr2) (DEFUN BC-INTR-DFFR (dffr1 dffr2)
(declare (type function dffr1 dffr2)) (declare (type function dffr1 dffr2))
(flet ((dif (degr bc) (flet ((dif (degr bc)
(declare (declare
(fixnum degr) (fixnum degr)
(type BcGnrt bc)) (type BcGnrt bc))
(the cmbn (the cmbn
(let* ((degr1 (BcGnrt-Degr1 bc)) (let* ((degr1 (BcGnrt-Degr1 bc))
(degr2 (BcGnrt-Degr2 bc)) (degr2 (BcGnrt-Degr2 bc))
(gnrt (BcGnrt-Gnrt bc)) (gnrt (BcGnrt-Gnrt bc))
(degr1-1 (1- degr1)) (degr1-1 (1- degr1))
(degr2-1 (1- degr2)) (degr2-1 (1- degr2))
(list1 (funcall dffr1 degr1 degr2 gnrt)) (list1 (funcall dffr1 degr1 degr2 gnrt))
(list2 (funcall dffr2 degr1 degr2 gnrt))) (list2 (funcall dffr2 degr1 degr2 gnrt)))
(declare (type fixnum degr1 degr2 degr1-1) (declare (type fixnum degr1 degr2 degr1-1)
(list list1 list2)) (list list1 list2))
(make-cmbn (make-cmbn
:degr (1- degr) :degr (1- degr)
:list (nconc :list (nconc
(mapcar (mapcar
#'(lambda (term1) #'(lambda (term1)
(declare (type term term1)) (declare (type term term1))
(let* ((cffc1 (cffc term1)) (let* ((cffc1 (cffc term1))
(gnrt1 (gnrt term1))) (gnrt1 (gnrt term1)))
(declare (type fixnum cffc1) (declare (type fixnum cffc1)
(type gnrt gnrt1)) (type gnrt gnrt1))
(term cffc1 (build-BcGnrt degr1-1 degr2 gnrt1)))) (term cffc1 (build-BcGnrt degr1-1 degr2 gnrt1))))
list1) list1)
(mapcar (mapcar
#'(lambda (term2) #'(lambda (term2)
(declare (type term term2)) (declare (type term term2))
(let* ((cffc2 (cffc term2)) (let* ((cffc2 (cffc term2))
(gnrt2 (gnrt term2))) (gnrt2 (gnrt term2)))
(declare (type fixnum cffc2) (declare (type fixnum cffc2)
(type gnrt gnrt2)) (type gnrt gnrt2))
(term cffc2 (build-BcGnrt degr1 degr2-1 gnrt2)))) (term cffc2 (build-BcGnrt degr1 degr2-1 gnrt2))))
list2))))))) list2)))))))
(the intr-mrph #'dif))) (the intr-mrph #'dif)))
#| #|
(defun dif1 (degr1 degr2 gnrt) (defun dif1 (degr1 degr2 gnrt)
(if (and (= degr1 1) (= degr2 1) (eql gnrt 'c)) (return-from dif1 (list (cons 2 'a)))) (if (and (= degr1 1) (= degr2 1) (eql gnrt 'c)) (return-from dif1 (list (cons 2 'a))))
(if (and (= degr1 2) (= degr2 0) (eql gnrt 'd)) (return-from dif1 (list (cons 2 'b)))) (if (and (= degr1 2) (= degr2 0) (eql gnrt 'd)) (return-from dif1 (list (cons 2 'b))))
(return-from dif1 nil)) (return-from dif1 nil))
(defun dif2 (degr1 degr2 gnrt) (defun dif2 (degr1 degr2 gnrt)
(if (and (= degr1 1) (= degr2 1) (eql gnrt 'c)) (return-from dif2 (list (cons 1 'b)))) (if (and (= degr1 1) (= degr2 1) (eql gnrt 'c)) (return-from dif2 (list (cons 1 'b))))
(return-from dif2 nil)) (return-from dif2 nil))
(setf dif (BC-INTR-DFFR #'dif1 #'dif2)) (setf dif (BC-INTR-DFFR #'dif1 #'dif2))
(funcall dif 2 (build-BcGnrt 1 1 'c)) (funcall dif 2 (build-BcGnrt 1 1 'c))
|# |#
@ -232,38 +232,215 @@
;; Function that builds a bicomplex from a basis function, the two differential ;; Function that builds a bicomplex from a basis function, the two differential
;; functions and the original comparison. ;; functions and the original comparison.
(DEFUN BUILD-BICM (&key bcbasis dffr1 dffr2 cmpr orgn) (DEFUN BUILD-BICM (&key bcbasis dffr1 dffr2 cmpr orgn)
(declare (declare
(type BCbasis bcbasis) (type BCbasis bcbasis)
(type function dffr1 dffr2) (type function dffr1 dffr2)
(type cmprf cmpr) (type cmprf cmpr)
(type list orgn)) (type list orgn))
(the chain-complex (the chain-complex
(let ((chcm (let ((chcm
(build-chcm (build-chcm
:cmpr (BC-CMPR cmpr) :cmpr (BC-CMPR cmpr)
:basis (BC-BASIS bcbasis) :basis (BC-BASIS bcbasis)
:intr-dffr (BC-INTR-DFFR dffr1 dffr2) :intr-dffr (BC-INTR-DFFR dffr1 dffr2)
:strt :gnrt :strt :gnrt
:orgn orgn))) :orgn orgn)))
(declare (type chain-complex chcm)) (declare (type chain-complex chcm))
(slot-makunbound chcm 'bsgn) (slot-makunbound chcm 'bsgn)
chcm))) 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))) :orgn '(BC-test)))
(dotimes (i 5) (dotimes (i 5)
(print (basis bc i))) (print (basis bc i)))
(cmpr bc (build-BcGnrt 0 1 'a) (build-BcGnrt 1 1 'c)) (cmpr bc (build-BcGnrt 0 1 'a) (build-BcGnrt 1 1 'c))
(? bc (? bc 2 (build-BcGnrt 1 1 'c))) (? bc (? bc 2 (build-BcGnrt 1 1 'c)))
(? bc 2 (build-BcGnrt 2 0 'd)) (? bc 2 (build-BcGnrt 2 0 'd))
(? bc 2 '(:BcGnrt (1 . 1) c)) (? bc 2 '(:BcGnrt (1 . 1) c))
(? bc (cmbn 2 3 '(:BcGnrt (1 . 1) c))) (? bc (cmbn 2 3 '(:BcGnrt (1 . 1) c)))
(? bc 1 (build-bicm 0 1 'a)) (? bc 1 (build-BcGnrt 0 1 'a))
|# |#
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;; BICOMPLEX FROM A LIST OF MORPHISMS OF CHAIN COMPLEXES ;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; EACH CHAIN COMPLEX IS A COLUMN OF THE BICOMPLEX
;; VERTICAL DIFFERENTIAL MAPS ARE THE DIFFERENTIAL MAPS OF THE CHAIN COMPLEXES
;; HORIZONTAL DIFFERENTIAL MAPS ARE THE MAPS INDUCED BY THE MORPHISMS
;; Function that builds the bicomplex basis from a list of morphisms of chain complexes.
(DEFUN LIST-OF-MRPH-BCBASIS (l)
(declare (type list l))
(when (eq (basis (sorc (first l))) :locally-effective)
(return-from list-of-mrph-bcbasis :locally-effective))
(dotimes (i (length l))
(declare (type fixnum i))
(when (eq (basis (trgt (nth i l))) :locally-effective)
(return-from list-of-mrph-bcbasis :locally-effective)))
(flet ((bcbasis (degr1 degr2)
(declare (type fixnum degr1 degr2))
(if (< degr1 (length l))
(basis (trgt (nth degr1 l)) degr2)
(if (= degr1 (length l))
(basis (sorc (nth (1- (length l)) l)) degr2)
nil
))))
(the bcbasis #'bcbasis)))
;; Function that builds the bicomplex horizontal internal differential
;; from a list of morphisms of chain complexes.
(DEFUN LIST-OF-MRPH-DFFR1 (l)
(declare (type list l))
(flet ((dffr1 (degr1 degr2 gnrt)
(declare (type fixnum degr1 degr2)
(type gnrt gnrt))
(if (and (> degr1 0) (<= degr1 (length l)))
(let ((mrph (nth (1- degr1) l)))
(declare (type morphism mrph))
(cmbn-list (? mrph degr2 gnrt)))
nil)))
(the function #'dffr1)))
;; Function that builds the bicomplex vertical internal differential
;; from a list of morphisms of chain complexes.
(DEFUN LIST-OF-MRPH-DFFR2 (l)
(declare (type list l))
(flet ((dffr2 (degr1 degr2 gnrt)
(declare (type fixnum degr1 degr2)
(type gnrt gnrt))
(if (and (> degr1 0) (<= degr1 (length l)))
(let ((mrph (nth (1- degr1) l)))
(cmbn-list (? (sorc mrph) degr2 gnrt)))
(if (= degr1 0)
(cmbn-list (? (trgt (first l)) degr2 gnrt))
nil))))
(the function #'dffr2)))
;; Function that constructs the comparison function of a bicomplex
;; from a list of morphisms of chain complexes.
(DEFUN LIST-OF-MRPH-BC-CMPR (l)
(declare (type list l))
(flet ((comp (bc1 bc2)
(declare (type BcGnrt bc1 bc2))
(let ((degr11 (BcGnrt-Degr1 bc1))
(degr21 (BcGnrt-Degr2 bc1))
(degr12 (BcGnrt-Degr1 bc2))
(degr22 (BcGnrt-Degr2 bc2))
(gnrt1 (BcGnrt-Gnrt bc1))
(gnrt2 (BcGnrt-Gnrt bc2)))
(declare
(type fixnum degr11 degr21 degr12 degr22)
(type any gnrt1 gnrt2))
(lexico
(f-cmpr degr11 degr12)
(f-cmpr degr21 degr22)
(if (and (> degr11 0) (<= degr11 (length l)))
(let ((chcm (sorc (nth (1- degr11) l))))
(funcall (cmpr chcm) gnrt1 gnrt2))
(if (= degr11 0)
(let ((chcm (trgt (nth 0 l))))
(funcall (cmpr chcm) gnrt1 gnrt2))
:equal))
))))
(the cmprf #'comp)))
;; Function that builds a bicomplex from a list of morphisms of chain complexes.
(DEFUN LIST-OF-MRPH-BUILD-BICM (l)
(declare (type list l))
(dotimes (i (1- (length l)))
(declare (fixnum i))
(let* ((mrphi (nth i l))
(mrphi+1 (nth (1+ i) l))
(sorci (sorc mrphi))
(trgti+1 (trgt mrphi+1)))
(unless (eq (grmd sorci) (grmd trgti+1))
(error "In LIST-OF-MRPH-BUILD-BICM, the morphisms ~A and ~A may not be composed (cf source and target)."
mrphi mrphi+1))))
(the chain-complex
(let ((chcm
(build-chcm
:cmpr (list-of-mrph-BC-CMPR l)
:basis (BC-BASIS (list-of-mrph-bcbasis l))
:intr-dffr (BC-INTR-DFFR (list-of-mrph-dffr1 l) (list-of-mrph-dffr2 l))
:strt :gnrt
:orgn `(list-of-mrph-bicomplex from ,l))))
(declare (type chain-complex chcm))
(slot-makunbound chcm 'bsgn)
chcm)))
#|
;; Example of bicomplex from a list of morphisms of two chain complexes
;; First we build the three chain complexes
(cat-init)
(defun chcm1-basis (degr)
(if (= degr 1)
(return-from chcm1-basis (list 'a1 'a2))
(return-from chcm1-basis nil)))
(defun chcm2-basis (degr)
(if (= degr 0) (return-from chcm2-basis (list 'b))
(if (= degr 1) (return-from chcm2-basis (list 'c1 'c2))
(return-from chcm2-basis nil))))
(defun chcm3-basis (degr)
(if (= degr 0)
(return-from chcm3-basis (list 'd1 'd2))
(return-from chcm3-basis nil)))
(defun chcm1-intr-dffr (degr gnrt)
(return-from chcm1-intr-dffr (cmbn (1- degr))))
(defun chcm2-intr-dffr (degr gnrt)
(if (and (= degr 1) (eql gnrt 'c1))
(return-from chcm2-intr-dffr (cmbn 0 1 'b))
(return-from chcm2-intr-dffr (cmbn (1- degr)))))
(defun chcm3-intr-dffr (degr gnrt)
(return-from chcm3-intr-dffr (cmbn (1- degr))))
(setf chcm1 (build-chcm :cmpr #'s-cmpr :basis #'chcm1-basis :intr-dffr #'chcm1-intr-dffr :strt :gnrt :orgn `(chcm1)))
(setf chcm2 (build-chcm :cmpr #'s-cmpr :basis #'chcm2-basis :intr-dffr #'chcm2-intr-dffr :strt :gnrt :orgn `(chcm2)))
(setf chcm3 (build-chcm :cmpr #'s-cmpr :basis #'chcm3-basis :intr-dffr #'chcm3-intr-dffr :strt :gnrt :orgn `(chcm3)))
;; Then we build the two morphisms
(defun mrph1-intr (degr gnrt)
(if (and (= degr 1) (eql gnrt 'c1))
(return-from mrph1-intr (cmbn 1 2 'a1))
(if (and (= degr 1) (eql gnrt 'c2))
(return-from mrph1-intr (cmbn 1 2 'a2))
(return-from mrph1-intr (cmbn degr)))))
(defun mrph2-intr (degr gnrt)
(if (and (= degr 0) (eql gnrt 'd1))
(return-from mrph2-intr (cmbn 0 2 'b))
(return-from mrph2-intr (cmbn degr))))
(setf mrph1 (build-mrph :sorc chcm2 :trgt chcm1 :intr #'mrph1-intr :strt :gnrt :orgn `(mrph1)))
(setf mrph2 (build-mrph :sorc chcm3 :trgt chcm2 :intr #'mrph2-intr :strt :gnrt :orgn `(mrph2)))
;; Finally we build the list and the bicomplex and we change it into a filtered chain complex
(setf l (list mrph1 mrph2))
(setf bic (list-of-mrph-build-bicm l))
(change-bicm-to-flcc bic)
;; We compute the groups of the associated spectral sequence
(dotimes (r 5)
(dotimes (n 3)
(dotimes (p (1+ n))
(let ((q (- n p)))
(spsq-group bic r p q)
))))
|#

91
src/anromero/spectral-sequences.lisp
View File

@ -1455,6 +1455,8 @@
(orgn :type list :initarg :orgn :reader orgn))) (orgn :type list :initarg :orgn :reader orgn)))
(DEFVAR *ss-list* (DEFVAR *ss-list*
"The variable *SS-LIST* is bound to a list of user created spectral sequences") "The variable *SS-LIST* is bound to a list of user created spectral sequences")
(SETF *ss-list* +empty-list+) (SETF *ss-list* +empty-list+)
@ -1664,6 +1666,19 @@
(build-ss ecc `(Eilenberg-Moore-Spectral-Sequence ,x)))))) (build-ss ecc `(Eilenberg-Moore-Spectral-Sequence ,x))))))
;; Function that constructs the spectral sequence associated to the bicomplex
;; constructed from a list of morphisms of chain complexes
;; Returns an object of the class Spectral-sequence
(DEFUN BICOMPLEX-SPECTRAL-SEQUENCE (l)
(declare (type list l))
(let* ((bic (list-of-mrph-build-bicm l)))
(declare
(type chain-complex bic))
(progn
(change-bicm-to-flcc bic)
(the spectral-sequence
(build-ss bic `(Bicomplex-Spectral-Sequence ,bic))))))
@ -1704,6 +1719,8 @@
;; (let ((q (+ n p))) ;; (let ((q (+ n p)))
;; (print-spsq-group ss2 1 (- p) q)))) ;; (print-spsq-group ss2 1 (- p) q))))
(print-spsq-group ss2 0 -3 6)
(spectral-sequence-differential-matrix ss2 1 -2 8) (spectral-sequence-differential-matrix ss2 1 -2 8)
(spectral-sequence-differential-of-one-element ss2 1 -2 8 '(1 0 0)) (spectral-sequence-differential-of-one-element ss2 1 -2 8 '(1 0 0))
(spectral-sequence-differential-of-one-element ss2 1 -2 8 '(0 1 0)) (spectral-sequence-differential-of-one-element ss2 1 -2 8 '(0 1 0))
@ -1750,8 +1767,80 @@
(terpri)))) (terpri))))
;; Example of bicomplex spectral sequence (same example in file "bicomplexes.lisp")
;; First we build the three chain complexes
(cat-init)
(defun chcm1-basis (degr)
(if (= degr 1)
(return-from chcm1-basis (list 'a1 'a2))
(return-from chcm1-basis nil)))
(defun chcm2-basis (degr)
(if (= degr 0) (return-from chcm2-basis (list 'b))
(if (= degr 1) (return-from chcm2-basis (list 'c1 'c2))
(return-from chcm2-basis nil))))
(defun chcm3-basis (degr)
(if (= degr 0)
(return-from chcm3-basis (list 'd1 'd2))
(return-from chcm3-basis nil)))
(defun chcm1-intr-dffr (degr gnrt)
(return-from chcm1-intr-dffr (cmbn (1- degr))))
(defun chcm2-intr-dffr (degr gnrt)
(if (and (= degr 1) (eql gnrt 'c1))
(return-from chcm2-intr-dffr (cmbn 0 1 'b))
(return-from chcm2-intr-dffr (cmbn (1- degr)))))
(defun chcm3-intr-dffr (degr gnrt)
(return-from chcm3-intr-dffr (cmbn (1- degr))))
(setf chcm1 (build-chcm :cmpr #'s-cmpr :basis #'chcm1-basis :intr-dffr #'chcm1-intr-dffr :strt :gnrt :orgn `(chcm1)))
(setf chcm2 (build-chcm :cmpr #'s-cmpr :basis #'chcm2-basis :intr-dffr #'chcm2-intr-dffr :strt :gnrt :orgn `(chcm2)))
(setf chcm3 (build-chcm :cmpr #'s-cmpr :basis #'chcm3-basis :intr-dffr #'chcm3-intr-dffr :strt :gnrt :orgn `(chcm3)))
;; Then we build the two morphisms
(defun mrph1-intr (degr gnrt)
(if (and (= degr 1) (eql gnrt 'c1))
(return-from mrph1-intr (cmbn 1 2 'a1))
(if (and (= degr 1) (eql gnrt 'c2))
(return-from mrph1-intr (cmbn 1 2 'a2))
(return-from mrph1-intr (cmbn degr)))))
(defun mrph2-intr (degr gnrt)
(if (and (= degr 0) (eql gnrt 'd1))
(return-from mrph2-intr (cmbn 0 2 'b))
(return-from mrph2-intr (cmbn degr))))
(setf mrph1 (build-mrph :sorc chcm2 :trgt chcm1 :intr #'mrph1-intr :strt :gnrt :orgn `(mrph1)))
(setf mrph2 (build-mrph :sorc chcm3 :trgt chcm2 :intr #'mrph2-intr :strt :gnrt :orgn `(mrph2)))
;; Finally we build the list and the associated spectral sequence
(setf l (list mrph1 mrph2))
(setf bss (bicomplex-spectral-sequence l))
;; We compute the groups of the associated spectral sequence
(dotimes (r 5)
(dotimes (n 3)
(dotimes (p (1+ n))
(let ((q (- n p)))
(format t "Spectral sequence E^~D_{~D,~D}" r p q)
(print (spectral-sequence-group bss r p q))
(terpri)
))))
(spectral-sequence-differential-matrix bss 1 1 1)
(spectral-sequence-differential-matrix bss 2 2 0)
|# |#