Functions for change a chain complex to a filtered

chain complex modified
Example of bicomplex added

src/anromero/bicomplexes.lisp

@@ -373,8 +373,64 @@
       (slot-makunbound chcm 'bsgn)
       chcm)))
 
+
+
 #|
-;; Example of bicomplex from a list of morphisms of two chain complexes
+;; EXAMPLE OF BICOMPLEX
+
+(cat-init)
+
+
+(defun bcbasis (degr1 degr2)
+     (if (and (= degr1 0) (= degr2 1)) (return-from bcbasis '(a1 a2)))
+     (if (and (= degr1 1) (= degr2 0)) (return-from bcbasis '(b)))
+     (if (and (= degr1 1) (= degr2 1)) (return-from bcbasis '(c1 c2)))
+     (if (and (= degr1 2) (= degr2 0))  (return-from bcbasis '(d1 d2)))
+     (return-from bcbasis nil))
+
+(defun dif1 (degr1 degr2 gnrt)
+     (if (and (= degr1 1) (= degr2 1) (eql gnrt 'c1)) (return-from dif1 (list (cons 2 'a1))))
+     (if (and (= degr1 1) (= degr2 1) (eql gnrt 'c2)) (return-from dif1 (list (cons 2 'a2))))
+     (if (and (= degr1 2) (= degr2 0) (eql gnrt 'd1)) (return-from dif1 (list (cons 2 'b))))
+     (return-from dif1 nil))
+
+(defun dif2 (degr1 degr2 gnrt)
+     (if (and (= degr1 1) (= degr2 1) (eql gnrt 'c1)) (return-from dif2 (list (cons 1 'b))))
+     (return-from dif2 nil))
+
+(setf bc (build-bicm :cmpr #'s-cmpr :bcbasis #'bcbasis :dffr1 #'dif1 :dffr2 #'dif2
+          :orgn '(Bicomplex1)))
+
+(basis bc 1)
+
+(change-bicm-to-flcc bc)
+
+
+(do ((r 1 (1+ r)))
+    ((> r 3))
+   (dotimes (n 3)
+      (dotimes (p (+ n 1))
+         (let ((q (- n p)))
+            (spsq-group bc r p q)
+            (terpri)
+            (terpri)
+            ))))
+
+(SPSQ-DFFR-OF-ONE-ELEMENT bc 1 1 1 '(1))
+
+(SPSQ-DFFR-OF-ONE-ELEMENT bc 2 2 0 '(1 0))
+
+(SPSQ-DFFR-OF-ONE-ELEMENT bc 2 2 0 '(0 1))
+
+(spsq-cnvg bc 4)
+
+|#
+
+
+
+
+#|
+;; EXAMPLE OF BICOMPLEX FROM A LIST OF MORPHISMS OF TWO CHAIN COMPLEXES
 
 ;; First we build the three chain complexes
 

src/anromero/persistent-homology.lisp

@@ -479,7 +479,7 @@
             rslt)))
 
 
-(setf triangle (change-chcm-to-flcc triangle triangle-flin 'triangle-flin))
+(setf triangle (change-chcm-to-flcc triangle triangle-flin))
 
 
 (dotimes (p 8)

src/anromero/spectral-sequences.lisp

@@ -396,7 +396,7 @@
 (cat-init)
 (setq kz2 (k-z2-1))
 (setq fcc (bar kz2))
-(Change-Chcm-TO-Flcc fcc abar-flin `(abar-flin))
+(Change-Chcm-TO-Flcc fcc abar-flin)
 (fltr-chcm-z-mtrx fcc 2 3 2)
 (fltr-chcm-z-mtrx fcc 1 2 4)
 |#
@@ -1141,11 +1141,11 @@
 (setq k3 (k-z2 3))
 (Setq hmtp-eq3 (efhm k3))
 (setq ek3 (rbcc hmtp-eq3))
-(change-chcm-to-flcc ek3 :flin abar-flin :orgn `(filtered-chain-complex ,ek3))
+(change-chcm-to-flcc ek3 abar-flin)
 (setf k3-flin
   #'(lambda (degr gnrt)
       (flin ek3 (rf hmtp-eq3 (lg hmtp-eq3 degr gnrt)))))
-(change-chcm-to-flcc k3 :flin k3-flin :orgn `(filtered-chain-complex ,k3))
+(change-chcm-to-flcc k3 k3-flin)
 (hmtp-eq-fltr-order hmtp-eq3 3)
 (hmtp-eq-fltr-order hmtp-eq3 5)
 |#
@@ -1162,7 +1162,7 @@
     (Change-Chcm-TO-Flcc eff-chcm 
                          #'(lambda (degr gnrt)
                              (flin fltrcm (lf hmtp-eq (rg hmtp-eq degr gnrt))))
-                         (orgn eff-chcm))))
+                         )))
 
 
 
@@ -1235,8 +1235,7 @@
          (eff-chcm (rbcc hmtp-eq)))
     (declare
      (type homotopy-equivalence hmtp-eq)
-     (type chain-complex eff-chcm)
+     (type chain-complex eff-chcm))
-     )
     (progn
       (if (not (typep eff-chcm 'filtered-chain-complex))
           (translate-filtration hmtp-eq))
@@ -1617,8 +1616,8 @@
     (declare (type simplicial-set fltrcm)
              (type chain-complex ecc))
     (progn
-      (change-chcm-to-flcc fltrcm crpr-flin 'crpr-flin)
+      (change-chcm-to-flcc fltrcm crpr-flin)
-      (change-chcm-to-flcc ecc tnpr-flin 'tnpr-flin)
+      (change-chcm-to-flcc ecc tnpr-flin)
       (the spectral-sequence
         (build-ss fltrcm `(Serre-Spectral-Sequence ,f))))))
 
@@ -1629,8 +1628,8 @@
   (let ((ecc (rbcc (efhm x))))
     (declare (type chain-complex ecc))
     (progn
-      (change-chcm-to-flcc x crpr-flin 'crpr-flin)
+      (change-chcm-to-flcc x crpr-flin)
-      (change-chcm-to-flcc ecc tnpr-flin 'tnpr-flin)
+      (change-chcm-to-flcc ecc tnpr-flin)
       (the spectral-sequence
         (build-ss x   `(Serre-Spectral-Sequence ,x))))))
 
@@ -1661,7 +1660,7 @@
      (type simplicial-set ox)
      (type chain-complex ecc))
     (progn
-      (change-chcm-to-flcc ecc cobar-flin 'cobar-flin)
+      (change-chcm-to-flcc ecc cobar-flin)
       (the spectral-sequence
         (build-ss ecc `(Eilenberg-Moore-Spectral-Sequence ,x))))))