Spectral sequence associated to a bicomplex added.

Spectral sequence associated to a list of morphisms added.

src/anromero/bicomplexes.lisp

@@ -24,9 +24,9 @@
 
 
 
-        ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-        ;;; TYPES FOR BICOMPLEXES ;;;
+;;; TYPES FOR BICOMPLEXES ;;;
-        ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
 ;; TYPE BcGnrt (a generator in a Bicomplex)
 (DEFUN BcGnrt-p (object)
@@ -50,7 +50,7 @@
 ;; TYPE BcBasis (basis of a Bicomplex, function of the variables p and q or
 ;; ":locally-effective")
 (DEFTYPE BcBASIS () '(or function (eql :locally-effective))) 
-                     ;; (function (degr degr) (list gnrt)) 
+;; (function (degr degr) (list gnrt)) 
 
 
 ;; TYPE Bicomplex
@@ -63,9 +63,9 @@
 (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 
@@ -260,10 +260,187 @@
 (? bc 2 (build-BcGnrt 2 0 'd))
 (? bc 2 '(: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)
+        ))))
+
+
+|#

src/anromero/spectral-sequences.lisp

@@ -1455,6 +1455,8 @@
    (orgn :type list :initarg :orgn :reader orgn)))
 
 
+
+
 (DEFVAR *ss-list*
     "The variable *SS-LIST* is bound to a list of user created spectral sequences")
 (SETF *ss-list* +empty-list+)
@@ -1664,6 +1666,19 @@
         (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)))
 ;;      (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-of-one-element ss2 1 -2 8 '(1 0 0))
 (spectral-sequence-differential-of-one-element ss2 1 -2 8 '(0 1 0))
@@ -1750,8 +1767,80 @@
       (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)
+
 
 
 |#
        
-