From 8f0d75b1057dc36ec4cac088edbf68c74731745e Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Ana=20Romero=20Ib=C3=A1=C3=B1ez?= <anromero@unirioja.loc>
Date: Mon, 16 Sep 2019 18:45:53 +0200
Subject: [PATCH] Functions for change a chain complex to a filtered chain
 complex modified Example of bicomplex added

---
 src/anromero/bicomplexes.lisp         |   58 +-
 src/anromero/filtered-complexes.lisp  | 1085 ++++++++++++-------------
 src/anromero/persistent-homology.lisp |    2 +-
 src/anromero/spectral-sequences.lisp  |   21 +-
 4 files changed, 585 insertions(+), 581 deletions(-)

diff --git a/src/anromero/bicomplexes.lisp b/src/anromero/bicomplexes.lisp
index 889afd5..ad7bf82 100644
--- a/src/anromero/bicomplexes.lisp
+++ b/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
 
diff --git a/src/anromero/filtered-complexes.lisp b/src/anromero/filtered-complexes.lisp
index d9a5e83..eaa8f14 100644
--- a/src/anromero/filtered-complexes.lisp
+++ b/src/anromero/filtered-complexes.lisp
@@ -9,11 +9,11 @@
 (DEFTYPE degr () 'fixnum)
 
 (DEFTYPE CHCM-FLIN () 'function) 
-                     ;; '(function (degr gnrt) degr)
+;; '(function (degr gnrt) degr)
 
 
 (DEFCLASS FILTERED-CHAIN-COMPLEX (chain-complex)
-    ((flin :type chcm-flin :initarg :flin :reader flin1)))
+  ((flin :type chcm-flin :initarg :flin :reader flin1)))
 
 (DEFVAR *flcc-list*)
 (SETF *flcc-list* +empty-list+)
@@ -22,278 +22,254 @@
 #+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
+  (the FILTERED-CHAIN-COMPLEX
+    (progn
       (format stream "[K~D Filtered-Chain-Complex]" (idnm flcm))
-     flcm)))
+      flcm)))
 #+clisp(eval-when (:compile-toplevel :load-toplevel :execute)
          (setf (ext:package-lock :clos) t))
 
 
 
 (DEFUN FLCC (idnm)
-   (declare (type fixnum idnm))
-   (the (or FILTERED-CHAIN-COMPLEX null)
-      (find idnm *flcc-list* :key #'idnm)))
+  (declare (type fixnum idnm))
+  (the (or FILTERED-CHAIN-COMPLEX null)
+    (find idnm *flcc-list* :key #'idnm)))
 
 
 ;; Function that builds a filtered chain complex. 
 (DEFUN BUILD-FLCC
     (&key cmpr basis bsgn intr-dffr dffr-strt flin orgn)
-   (declare
-      (type cmprf cmpr)
-      (type intr-mrph intr-dffr)
-      (type basis basis)
-      (type gnrt bsgn)
-      (type strt dffr-strt)
-      (type Chcm-Flin flin)
-      (list orgn))
-   (the FILTERED-CHAIN-COMPLEX
-     (progn
-         (let ((already (find orgn *flcc-list* :key #'orgn :test #'equal)))
-            (declare (type (or null FILTERED-CHAIN-COMPLEX) already))
-            (when already
-               (return-from build-flcc already)))
-         (let ((rslt (build-chcm :cmpr cmpr :basis basis :bsgn bsgn
-                        :intr-dffr intr-dffr :strt dffr-strt
-                        :orgn orgn)))
-            (declare (type chain-complex rslt))
-            (change-class rslt 'FILTERED-CHAIN-COMPLEX)
-            (setf (slot-value rslt 'flin) flin)
-            (push rslt *flcc-list*)
-               rslt))))
+  (declare
+   (type cmprf cmpr)
+   (type intr-mrph intr-dffr)
+   (type basis basis)
+   (type gnrt bsgn)
+   (type strt dffr-strt)
+   (type Chcm-Flin flin)
+   (list orgn))
+  (the FILTERED-CHAIN-COMPLEX
+    (progn
+      (let ((already (find orgn *flcc-list* :key #'orgn :test #'equal)))
+        (declare (type (or null FILTERED-CHAIN-COMPLEX) already))
+        (when already
+          (return-from build-flcc already)))
+      (let ((rslt (build-chcm :cmpr cmpr :basis basis :bsgn bsgn
+                              :intr-dffr intr-dffr :strt dffr-strt
+                              :orgn orgn)))
+        (declare (type chain-complex rslt))
+        (change-class rslt 'FILTERED-CHAIN-COMPLEX)
+        (setf (slot-value rslt 'flin) flin)
+        (push rslt *flcc-list*)
+        rslt))))
 
 
-;; Function that changes a chain complex chcm to a filtered complex, with filtration
-;; index of a generator defined by the function flin, and origin orgn. 
-#|(DEFUN CHANGE-CHCM-TO-FLCC (chcm &key flin orgn)
-   (declare
-      (type chain-complex chcm)
-      (type chcm-flin flin)
-      (type list orgn))
-   (the FILTERED-CHAIN-COMPLEX
-      (progn
-         (change-class chcm 'FILTERED-CHAIN-COMPLEX)
-         ;;(setf orgn (list (orgn chcm) 'then orgn))
-         (let ((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)))
-         (setf (slot-value chcm 'flin) flin)
-         ;;(setf (slot-value chcm 'orgn) orgn)
-         (push chcm *flcc-list*)
-         chcm)))
-|#
-
-
-(DEFMETHOD CHANGE-CHCM-TO-FLCC ((chcm chain-complex) flin flin-orgn)
-   (declare
-      (type chain-complex chcm)
-      (type chcm-flin flin)
-      ;;(type list flin-orgn)
-)
-   (the FILTERED-CHAIN-COMPLEX
-      (progn
-         (change-class chcm 'FILTERED-CHAIN-COMPLEX)
-        (let* ((orgn (orgn chcm))
-               (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))
-         (setf (slot-value chcm 'flin) flin)
-         (push chcm *flcc-list*))
-         chcm)))
+(DEFMETHOD CHANGE-CHCM-TO-FLCC ((chcm chain-complex) flin)
+  (declare
+   (type chain-complex chcm)
+   (type chcm-flin flin))
+  (the FILTERED-CHAIN-COMPLEX
+    (progn
+      (change-class chcm 'FILTERED-CHAIN-COMPLEX)
+      (let* ((orgn (orgn chcm))
+             (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))
+        (setf (slot-value chcm 'flin) flin)
+        (push chcm *flcc-list*))
+      chcm)))
 
 
 (DEFMACRO FLIN (&rest rest)
-   (ecase (length rest)
-      (1 `(flin1 ,@rest))
-      (2 `(flin2 ,@rest))
-      (3 `(flin3 ,@rest))))
+  (ecase (length rest)
+    (1 `(flin1 ,@rest))
+    (2 `(flin2 ,@rest))
+    (3 `(flin3 ,@rest))))
 
 (DEFUN FLIN3 (object degr gnrt)         
-   (declare
-      (type FILTERED-CHAIN-COMPLEX object)
-      (fixnum degr)
-      (type gnrt gnrt))
-   (the fixnum
-      (with-slots (flin) object
-         (declare (type chcm-flin flin))
-         (funcall flin degr gnrt))))
+  (declare
+   (type FILTERED-CHAIN-COMPLEX object)
+   (fixnum degr)
+   (type gnrt gnrt))
+  (the fixnum
+    (with-slots (flin) object
+      (declare (type chcm-flin flin))
+      (funcall flin degr gnrt))))
 
 (DEFUN FLIN2 (object cmbn)
-   (declare
-    (type FILTERED-CHAIN-COMPLEX object)
-    (type cmbn cmbn))
-   (the fixnum
-      (with-slots (flin) object
-         (declare (type chcm-flin flin))
-        (with-cmbn (degr cmbn-list) cmbn
-          (declare
-           (fixnum degr)
-           (list cmbn-list))
-          (labels ((list-max (list)
-                     (declare (type list list))
-                     (let* ((max-int (car list)))
-                        (do ((mark1 list (cdr mark1)))
-                            ((endp mark1))
-                           (setq max-int (max max-int (car mark1))))
-                        max-int)))
-         (if (endp cmbn-list)
-            0
+  (declare
+   (type FILTERED-CHAIN-COMPLEX object)
+   (type cmbn cmbn))
+  (the fixnum
+    (with-slots (flin) object
+      (declare (type chcm-flin flin))
+      (with-cmbn (degr cmbn-list) cmbn
+        (declare
+         (fixnum degr)
+         (list cmbn-list))
+        (labels ((list-max (list)
+                           (declare (type list list))
+                           (let* ((max-int (car list)))
+                             (do ((mark1 list (cdr mark1)))
+                                 ((endp mark1))
+                               (setq max-int (max max-int (car mark1))))
+                             max-int)))
+          (if (endp cmbn-list)
+              0
             (list-max 
-              (mapcar 
-                #'(lambda (term)
-                    (flin3 object degr (gnrt term)))
-                cmbn-list))))))))
-   
+             (mapcar 
+                 #'(lambda (term)
+                     (flin3 object degr (gnrt term)))
+               cmbn-list))))))))
+
 
 
 ;; Function that returns the min and max of the filtration index of the elements of the basis
 ;; for degree degr
 (DEFUN FLIN-MIN-MAX (fltrcm degr)
-   (declare (type FILTERED-CHAIN-COMPLEX fltrcm)
-            (type fixnum degr))
-   (when (eq (basis fltrcm) :locally-effective)
+  (declare (type FILTERED-CHAIN-COMPLEX fltrcm)
+           (type fixnum degr))
+  (when (eq (basis fltrcm) :locally-effective)
     (error "flin-min-max cannot work with a LOCALLY-EFFECTIVE chain complex."))
-   (the list
-     (let* ((basis (basis fltrcm degr)))
-        (declare (list basis))
-        (if (endp basis)
-           (list 0 0)
-           (let* ((min (flin fltrcm degr (first basis)))
-                  (max min))
-              (declare (type fixnum min max))
-              (dolist (gnrt (cdr basis))
-                 (let ((aux (flin fltrcm degr gnrt)))
-                    (declare (type fixnum aux))
-                    (if (< aux min)
-                       (setf min aux)
-                       (if (> aux max)
-                          (setf max aux)))))
-              (list min max))))))
-           
- 
-   
+  (the list
+    (let* ((basis (basis fltrcm degr)))
+      (declare (list basis))
+      (if (endp basis)
+          (list 0 0)
+        (let* ((min (flin fltrcm degr (first basis)))
+               (max min))
+          (declare (type fixnum min max))
+          (dolist (gnrt (cdr basis))
+            (let ((aux (flin fltrcm degr gnrt)))
+              (declare (type fixnum aux))
+              (if (< aux min)
+                  (setf min aux)
+                (if (> aux max)
+                    (setf max aux)))))
+          (list min max))))))
+
+
+
 ;; Function that returns the elements of the basis that have bidegree (p,q).
 (DEFUN BIGRD-BASIS (fltrcm p q)
-   (declare (type FILTERED-CHAIN-COMPLEX fltrcm)
-            (type fixnum p q))
-   (when (eq (basis fltrcm) :locally-effective)
+  (declare (type FILTERED-CHAIN-COMPLEX fltrcm)
+           (type fixnum p q))
+  (when (eq (basis fltrcm) :locally-effective)
     (error "Bigrd-Basis cannot work with a LOCALLY-EFFECTIVE chain complex."))
-   (the list
-     (let* ((degr (+ p q))
-            (basis (basis fltrcm degr)))
-        (declare 
-          (type list basis)
-          (fixnum degr))
-        (mapcan 
+  (the list
+    (let* ((degr (+ p q))
+           (basis (basis fltrcm degr)))
+      (declare 
+       (type list basis)
+       (fixnum degr))
+      (mapcan 
           #'(lambda (gnrt)
               (declare (type gnrt gnrt))
               (if (= (flin fltrcm degr gnrt) p)
-                 (list gnrt)
-                 nil))
-          basis))))
+                  (list gnrt)
+                nil))
+        basis))))
 
 ;; Function that returns the elements of the basis of degree "degr" that have
 ;; filtration index <= "fltr-index".
 (DEFUN FLTRD-BASIS (fltrcm degr fltr-index)
-   (declare (type FILTERED-CHAIN-COMPLEX fltrcm)
-            (type fixnum degr fltr-index))
-   (when (eq (basis fltrcm) :locally-effective)
+  (declare (type FILTERED-CHAIN-COMPLEX fltrcm)
+           (type fixnum degr fltr-index))
+  (when (eq (basis fltrcm) :locally-effective)
     (error "Fltrd-Basis cannot work with a LOCALLY-EFFECTIVE chain complex."))
-   (let ((min (first (flin-min-max fltrcm degr))))
-      (declare (type fixnum min))
-      (the list
-        (mapcan
+  (let ((min (first (flin-min-max fltrcm degr))))
+    (declare (type fixnum min))
+    (the list
+      (mapcan
           #'(lambda (i)
               (bigrd-basis fltrcm i (- degr i)))
-          (<a-b> min fltr-index)))))
+        (<a-b> min fltr-index)))))
 
 ;; Function that returns the elements of the basis with degree "degr",
 ;; ordered by the filtration index.
 (DEFUN ORDERED-BASIS (fltrcm degr)
-   (declare
-    (type FILTERED-CHAIN-COMPLEX fltrcm)
-    (fixnum degr))
-   (when (eq (basis fltrcm) :locally-effective)
+  (declare
+   (type FILTERED-CHAIN-COMPLEX fltrcm)
+   (fixnum degr))
+  (when (eq (basis fltrcm) :locally-effective)
     (error "Ordered-Basis cannot work with a LOCALLY-EFFECTIVE chain complex."))
-   (the list
-     (let ((max (second (flin-min-max fltrcm degr))))
-        (declare (type fixnum max))
-        (fltrd-basis fltrcm degr max))))  
+  (the list
+    (let ((max (second (flin-min-max fltrcm degr))))
+      (declare (type fixnum max))
+      (fltrd-basis fltrcm degr max))))  
 
 ;; Matrix of the differential application of degree "degr" of the subcomplex
 ;; F_pX, where p=fltr-index and X=fltrcm.
-(defun FLCC-DFFR-MTRX (fltrcm degr fltr-index)
+(DEFUN FLCC-DFFR-MTRX (fltrcm degr fltr-index)
   (declare
-    (type FILTERED-CHAIN-COMPLEX fltrcm)
-    (fixnum degr fltr-index))
-   (when (eq (basis fltrcm) :locally-effective)
+   (type FILTERED-CHAIN-COMPLEX fltrcm)
+   (fixnum degr fltr-index))
+  (when (eq (basis fltrcm) :locally-effective)
     (error "flcc-dffr-mtrx cannot work with a LOCALLY-EFFECTIVE chain complex."))
   (the matrix
     (let* ((cmpr (cmpr1 fltrcm))
-	     (dffr (dffr fltrcm))
-	     (sbasis (fltrd-basis fltrcm degr fltr-index))
+           (dffr (dffr fltrcm))
+           (sbasis (fltrd-basis fltrcm degr fltr-index))
            (tbasis (ordered-basis fltrcm (1- degr)))
            ;; If the differential application in the filtered complex respects the filtration,
            ;; i.e., d(F_pA_n) \in (F_pA)_{n-1}, the target basis is (fltrd-basis fltrcm (1- degr) fltr-index)
            (srank (length sbasis))
-	     (trank (length tbasis)))
-       (declare
-        (type cmprf cmpr)
-        (type morphism dffr)
-        (fixnum degr)
-        (list sbasis tbasis)
-        (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))
-            (do ((j 0 (1+ j))
-	           (mark sbasis (cdr mark)))
-                ((endp mark))
-               (declare
-                (fixnum j)
-                (list mark))
-               (let ((cmbn (gnrt-? dffr degr (car mark))))
-                  (declare (type cmbn cmbn))
-                  (do ((mark1 (cmbn-list cmbn) (cdr mark1)))
-                      ((endp mark1))
-                     (declare (list mark1))
-                     (with--term (cffc gnrt) mark1
-                       (declare 
-                         (fixnum cffc)
-                         (type gnrt gnrt))
-                       (do ((mark2 tbasis (cdr mark2))
-                            (i 0 (1+ i))
-                            (found nil))
-                           ((or (endp mark2) found))
-                          (declare 
-                            (list mark2)
-                            (fixnum i))
-                          (if (eq :equal (funcall cmpr gnrt (car mark2)))
-                             (progn
-                              (setq found 1)
-                              (setf (aref rslt i j) cffc))))))))
-               rslt))))
+           (trank (length tbasis)))
+      (declare
+       (type cmprf cmpr)
+       (type morphism dffr)
+       (fixnum degr)
+       (list sbasis tbasis)
+       (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))
+        (do ((j 0 (1+ j))
+             (mark sbasis (cdr mark)))
+            ((endp mark))
+          (declare
+           (fixnum j)
+           (list mark))
+          (let ((cmbn (gnrt-? dffr degr (car mark))))
+            (declare (type cmbn cmbn))
+            (do ((mark1 (cmbn-list cmbn) (cdr mark1)))
+                ((endp mark1))
+              (declare (list mark1))
+              (with--term (cffc gnrt) mark1
+                (declare 
+                 (fixnum cffc)
+                 (type gnrt gnrt))
+                (do ((mark2 tbasis (cdr mark2))
+                     (i 0 (1+ i))
+                     (found nil))
+                    ((or (endp mark2) found))
+                  (declare 
+                   (list mark2)
+                   (fixnum i))
+                  (if (eq :equal (funcall cmpr gnrt (car mark2)))
+                      (progn
+                        (setq found 1)
+                        (setf (aref rslt i j) cffc))))))))
+        rslt))))
 
 
 ;; OTHER CLASSES THAT INHERIT FROM FILTERED-CHAIN-COMPLEX
 
 
 (DEFCLASS FILTERED-COALGEBRA (filtered-chain-complex coalgebra)
-    ())
+  ())
 
 (DEFVAR *FLCLGB-LIST*
     "The variable *FLCLGB-LIST* is bound to a list of user created filtered coalgebras")
@@ -304,65 +280,63 @@
 #+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
+  (the FILTERED-COALGEBRA
+    (progn
       (format stream "[K~D FILTERED-COALGEBRA]" (idnm flclgb))
-     flclgb)))
+      flclgb)))
 #+clisp(eval-when (:compile-toplevel :load-toplevel :execute)
          (setf (ext:package-lock :clos) t))
 
 (DEFUN FltrClgb (idnm)
-   (declare (type fixnum idnm))
-   (the (or FILTERED-COALGEBRA null)
-      (find idnm *flclgb-list* :key #'idnm)))
+  (declare (type fixnum idnm))
+  (the (or FILTERED-COALGEBRA null)
+    (find idnm *flclgb-list* :key #'idnm)))
 
 ;; Function that builds a filtered coalgebra. 
 (DEFUN BUILD-FltrClgb
     (&key cmpr basis bsgn intr-dffr dffr-strt intr-cprd cprd-strt flin orgn)
-   (declare
-     (type cmprf cmpr)
-     (type intr-mrph intr-dffr intr-cprd)
-     (type basis basis)
-     (type gnrt bsgn)
-     (type strt dffr-strt cprd-strt)
-     (type chcm-flin flin)
-     (list orgn))
-   (the FILTERED-COALGEBRA
-     (progn
-         (let ((already (find orgn *flclgb-list* :key #'orgn :test #'equal)))
-            (declare (type (or null FILTERED-COALGEBRA) already))
-            (when already
-               (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-cprd :cprd-strt cprd-strt
-                        :orgn orgn)))
-            (declare (type coalgebra rslt))
-            (change-class rslt 'FILTERED-COALGEBRA)
-            (setf (slot-value rslt 'flin) flin)
-            (push rslt *flclgb-list*)
-               rslt))))
+  (declare
+   (type cmprf cmpr)
+   (type intr-mrph intr-dffr intr-cprd)
+   (type basis basis)
+   (type gnrt bsgn)
+   (type strt dffr-strt cprd-strt)
+   (type chcm-flin flin)
+   (list orgn))
+  (the FILTERED-COALGEBRA
+    (progn
+      (let ((already (find orgn *flclgb-list* :key #'orgn :test #'equal)))
+        (declare (type (or null FILTERED-COALGEBRA) already))
+        (when already
+          (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-cprd :cprd-strt cprd-strt
+                              :orgn orgn)))
+        (declare (type coalgebra rslt))
+        (change-class rslt 'FILTERED-COALGEBRA)
+        (setf (slot-value rslt 'flin) flin)
+        (push rslt *flclgb-list*)
+        rslt))))
 
-(defmethod change-chcm-to-flcc ((chcm coalgebra) flin flin-orgn )
-   (declare      
-      (type chcm-flin flin)
-      ;;(type list flin-orgn)
-)
-   (the FILTERED-COALGEBRA
-      (progn
-         (change-class chcm 'FILTERED-COALGEBRA)
-        (let* ((orgn (orgn chcm))
-              (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))
-         (setf (slot-value chcm 'flin) flin)
-          (push chcm *flCLGB-list*)
-         chcm))))
+(DEFMETHOD CHANGE-CHCM-TO-FLCC ((chcm coalgebra) flin)
+  (declare      
+   (type chcm-flin flin))
+  (the FILTERED-COALGEBRA
+    (progn
+      (change-class chcm 'FILTERED-COALGEBRA)
+      (let* ((orgn (orgn chcm))
+             (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))
+        (setf (slot-value chcm 'flin) flin)
+        (push chcm *flCLGB-list*)
+        chcm))))
 
 
 (DEFCLASS FILTERED-ALGEBRA (filtered-chain-complex algebra)
-    ())
+  ())
 
 (DEFVAR *FLALGB-LIST*
     "The variable *FLALGB-LIST* is bound to a list of user created filtered algebras.")
@@ -373,67 +347,63 @@
 #+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
+  (the FILTERED-ALGEBRA
+    (progn
       (format stream "[K~D FILTERED-ALGEBRA]" (idnm flalgb))
-     flalgb)))
+      flalgb)))
 #+clisp(eval-when (:compile-toplevel :load-toplevel :execute)
          (setf (ext:package-lock :clos) t))
 
 (DEFUN FltrAlgb (idnm)
-   (declare (type fixnum idnm))
-   (the (or FILTERED-ALGEBRA null)
-      (find idnm *flalgb-list* :key #'idnm)))
+  (declare (type fixnum idnm))
+  (the (or FILTERED-ALGEBRA null)
+    (find idnm *flalgb-list* :key #'idnm)))
 
 ;; Function that builds a filtered algebra. 
 (DEFUN BUILD-FltrAlgb
     (&key cmpr basis bsgn intr-dffr dffr-strt intr-aprd aprd-strt flin orgn)
-   (declare
-     (type cmprf cmpr)
-     (type intr-mrph intr-dffr intr-aprd)
-     (type basis basis)
-     (type gnrt bsgn)
-     (type strt dffr-strt aprd-strt)
-     (type chcm-flin flin)
-     (list orgn))
-   (the FILTERED-ALGEBRA
-     (progn
-         (let ((already (find orgn *flalgb-list* :key #'orgn :test #'equal)))
-            (declare (type (or null FILTERED-ALGEBRA) already))
-            (when already
-               (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-aprd :aprd-strt aprd-strt
-                        :orgn orgn)))
-            (declare (type algebra rslt))
-            (change-class rslt 'FILTERED-ALGEBRA)
-            (setf (slot-value rslt 'flin) flin)
-            (push rslt *flalgb-list*)
-               rslt))))
+  (declare
+   (type cmprf cmpr)
+   (type intr-mrph intr-dffr intr-aprd)
+   (type basis basis)
+   (type gnrt bsgn)
+   (type strt dffr-strt aprd-strt)
+   (type chcm-flin flin)
+   (list orgn))
+  (the FILTERED-ALGEBRA
+    (progn
+      (let ((already (find orgn *flalgb-list* :key #'orgn :test #'equal)))
+        (declare (type (or null FILTERED-ALGEBRA) already))
+        (when already
+          (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-aprd :aprd-strt aprd-strt
+                              :orgn orgn)))
+        (declare (type algebra rslt))
+        (change-class rslt 'FILTERED-ALGEBRA)
+        (setf (slot-value rslt 'flin) flin)
+        (push rslt *flalgb-list*)
+        rslt))))
 
-(defmethod change-chcm-to-flcc ((chcm algebra) flin flin-orgn )
-   (declare      
-      (type chcm-flin flin)
-      ;;(list flin-orgn)
-)
-   (the FILTERED-ALGEBRA
-      (progn
-         (change-class chcm 'FILTERED-ALGEBRA)
-       ;;(setf orgn (append (orgn chcm) (list 'FILTERED-WITH) (list flin-orgn)))
-        (let* (
-              (orgn (orgn chcm))
-              (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))
-         (setf (slot-value chcm 'flin) flin)
-          (push chcm *flaLGB-list*)
-         chcm))))
+(DEFMETHOD CHANGE-CHCM-TO-FLCC ((chcm algebra) flin)
+  (declare      
+   (type chcm-flin flin))
+  (the FILTERED-ALGEBRA
+    (progn
+      (change-class chcm 'FILTERED-ALGEBRA)
+      (let* ((orgn (orgn chcm))
+             (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))
+        (setf (slot-value chcm 'flin) flin)
+        (push chcm *flaLGB-list*)
+        chcm))))
 
 
 (DEFCLASS FILTERED-HOPF-ALGEBRA (filtered-chain-complex hopf-algebra)
-    ())
+  ())
 
 (DEFVAR *FLHOPF-LIST*
     "The variable *FLHOPF-LIST* is bound to a list of user created filtered Hopf algebras.")
@@ -444,40 +414,36 @@
 #+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
+  (the FILTERED-HOPF-ALGEBRA
+    (progn
       (format stream "[K~D FILTERED-HOPF-ALGEBRA]" (idnm flhopf))
-     flhopf)))
+      flhopf)))
 #+clisp(eval-when (:compile-toplevel :load-toplevel :execute)
          (setf (ext:package-lock :clos) t))
 
 (DEFUN FltrHopf (idnm)
-   (declare (type fixnum idnm))
-   (the (or FILTERED-HOPF-ALGEBRA null)
-      (find idnm *flhopf-list* :key #'idnm)))
+  (declare (type fixnum idnm))
+  (the (or FILTERED-HOPF-ALGEBRA null)
+    (find idnm *flhopf-list* :key #'idnm)))
 
-(defmethod change-chcm-to-flcc ((chcm hopf-algebra) flin flin-orgn )
-   (declare      
-      (type chcm-flin flin)
-      ;;(list flin-orgn)
-)
-   (the FILTERED-hopf-algebra
-      (progn
-         (change-class chcm 'FILTERED-hopf-ALGEBRA)
-        ;;(setf orgn (append (orgn chcm) (list 'FILTERED-WITH) (list flin-orgn)))
-        (let* (
-               (orgn (orgn chcm))
-               (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))
-         (setf (slot-value chcm 'flin) flin)
-          (push chcm *flhopf-list*)
-         chcm))))
+(DEFMETHOD CHANGE-CHCM-TO-FLCC ((chcm hopf-algebra) flin)
+  (declare      
+   (type chcm-flin flin))
+  (the FILTERED-hopf-algebra
+    (progn
+      (change-class chcm 'FILTERED-hopf-ALGEBRA)
+      (let* ((orgn (orgn chcm))
+             (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))
+        (setf (slot-value chcm 'flin) flin)
+        (push chcm *flhopf-list*)
+        chcm))))
 
 
 (DEFCLASS FILTERED-SIMPLICIAL-SET (FILTERED-CHAIN-COMPLEX simplicial-set )
-    ())
+  ())
 
 (DEFVAR *FLSMST-LIST*
     "The variable *FLSMST-LIST* is bound to a list of user created filtered simplicial sets")
@@ -488,71 +454,67 @@
 #+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
+  (the filtered-simplicial-set
+    (progn
       (format stream "[K~D Filtered-Simplicial-Set]" (idnm flsmst))
-     flsmst)))
+      flsmst)))
 #+clisp(eval-when (:compile-toplevel :load-toplevel :execute)
          (setf (ext:package-lock :clos) t))
 
 (DEFUN FltrSmSet (idnm)
-   (declare (type fixnum idnm))
-   (the (or filtered-simplicial-set null)
-      (find idnm *flsmst-list* :key #'idnm)))
+  (declare (type fixnum idnm))
+  (the (or filtered-simplicial-set null)
+    (find idnm *flsmst-list* :key #'idnm)))
 
 
 
 ;; Function that builds a filtered simplicial set 
 (DEFUN BUILD-FltrSmSt
     (&key cmpr basis bspn face face* intr-bndr bndr-strt intr-dgnl dgnl-strt flin orgn)
-   (declare
-     (type cmprf cmpr)
-     (type basis basis)
-     (type gmsm bspn)
-     (type face face)
-     (type (or null face*) face*)
-     (type (or intr-mrph null) intr-bndr intr-dgnl)
-        (type (or strt null) bndr-strt dgnl-strt)
-     (type chcm-flin flin)
-     (list orgn))
-   (the FILTERED-SIMPLICIAL-SET
-     (progn
-         (let ((already (find orgn *flsmst-list* :key #'orgn :test #'equal)))
-            (declare (type (or null FILTERED-SIMPLICIAL-SET) already))
-            (when already
-               (return-from build-FltrSmst already)))
-         (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-strt :orgn orgn)))
-            (declare (type simplicial-set rslt))
-            (change-class rslt 'FILTERED-SIMPLICIAL-SET)
-            (setf (slot-value rslt 'flin) flin)
-            (push rslt *flsmst-list*)
-               rslt))))
+  (declare
+   (type cmprf cmpr)
+   (type basis basis)
+   (type gmsm bspn)
+   (type face face)
+   (type (or null face*) face*)
+   (type (or intr-mrph null) intr-bndr intr-dgnl)
+   (type (or strt null) bndr-strt dgnl-strt)
+   (type chcm-flin flin)
+   (list orgn))
+  (the FILTERED-SIMPLICIAL-SET
+    (progn
+      (let ((already (find orgn *flsmst-list* :key #'orgn :test #'equal)))
+        (declare (type (or null FILTERED-SIMPLICIAL-SET) already))
+        (when already
+          (return-from build-FltrSmst already)))
+      (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-strt :orgn orgn)))
+        (declare (type simplicial-set rslt))
+        (change-class rslt 'FILTERED-SIMPLICIAL-SET)
+        (setf (slot-value rslt 'flin) flin)
+        (push rslt *flsmst-list*)
+        rslt))))
 
-(defmethod change-chcm-to-flcc ((chcm simplicial-set) flin flin-orgn )
-   (declare      
-      (type chcm-flin flin)
-      ;;(list flin-orgn)
-)
-   (the FILTERED-SIMPLICIAL-SET
-      (progn
-         (change-class chcm 'FILTERED-SIMPLICIAL-SET)
-;;        (setf orgn (append (orgn chcm) (list 'FILTERED-WITH) (list flin-orgn)))
-        (let* (
-               (orgn (orgn chcm))
-               (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))
-         (setf (slot-value chcm 'flin) flin)
-         (push chcm *flsmst-list*)
-         chcm))))
+(DEFMETHOD CHANGE-CHCM-TO-FLCC ((chcm simplicial-set) flin)
+  (declare      
+   (type chcm-flin flin))
+  (the FILTERED-SIMPLICIAL-SET
+    (progn
+      (change-class chcm 'FILTERED-SIMPLICIAL-SET)
+      (let* ((orgn (orgn chcm))
+             (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))
+        (setf (slot-value chcm 'flin) flin)
+        (push chcm *flsmst-list*)
+        chcm))))
 
 
 (DEFCLASS FILTERED-KAN (FILTERED-CHAIN-COMPLEX KAN )
-    ())
+  ())
 
 (DEFVAR *FLKAN-LIST*
     "The variable *FLKAN-LIST* is bound to a list of user created filtered Kan complexes")
@@ -563,47 +525,43 @@
 #+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
+  (the filtered-kan
+    (progn
       (format stream "[K~D Filtered-Kan-Simplicial-Set]" (idnm flkan))
-     flkan)))
+      flkan)))
 #+clisp(eval-when (:compile-toplevel :load-toplevel :execute)
          (setf (ext:package-lock :clos) t))
 
 (DEFUN FltrKan (idnm)
-   (declare (type fixnum idnm))
-   (the (or filtered-kan null)
-      (find idnm *flkan-list* :key #'idnm)))
+  (declare (type fixnum idnm))
+  (the (or filtered-kan null)
+    (find idnm *flkan-list* :key #'idnm)))
 
-(defmethod change-chcm-to-flcc ((chcm kan) flin flin-orgn )
-   (declare      
-      (type chcm-flin flin)
-      ;;(list flin-orgn)
-)
-   (the FILTERED-KAN
-      (progn
-         (change-class chcm 'FILTERED-KAN)
-        ;; (setf orgn (append (orgn chcm) (list 'FILTERED-WITH) (list flin-orgn)))
-        (let* (
-               (orgn (orgn chcm))
-               (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))
-         (setf (slot-value chcm 'flin) flin)
-         (push chcm *flkan-list*)
-         chcm))))
+(DEFMETHOD CHANGE-CHCM-TO-FLCC ((chcm kan) flin)
+  (declare      
+   (type chcm-flin flin))
+  (the FILTERED-KAN
+    (progn
+      (change-class chcm 'FILTERED-KAN)
+      (let* ((orgn (orgn chcm))
+             (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))
+        (setf (slot-value chcm 'flin) flin)
+        (push chcm *flkan-list*)
+        chcm))))
 
 
 (DEFCLASS FILTERED-SIMPLICIAL-GROUP (FILTERED-CHAIN-COMPLEX SIMPLICIAL-GROUP )
-    ())
+  ())
 
 (DEFCLASS FILTERED-AB-SIMPLICIAL-GROUP (FILTERED-CHAIN-COMPLEX AB-SIMPLICIAL-GROUP )
-    ())
+  ())
 
 (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*)
 
@@ -616,99 +574,90 @@
 #+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
+  (the filtered-simplicial-group
+    (progn
       (format stream "[K~D Filtered-Simplicial-Group]" (idnm flsmgr))
       flsmgr)))
 
 (DEFMETHOD PRINT-OBJECT ((flsmgr filtered-ab-simplicial-group) stream)
- (the filtered-simplicial-group
-   (progn
+  (the filtered-simplicial-group
+    (progn
       (format stream "[K~D Filtered-Abelian-Simplicial-Group]" (idnm flsmgr))
-     flsmgr)))
+      flsmgr)))
 #+clisp(eval-when (:compile-toplevel :load-toplevel :execute)
          (setf (ext:package-lock :clos) t))
 
 (DEFUN FltrSmgr (idnm)
-   (declare (type fixnum idnm))
-   (the (or filtered-simplicial-group null)
-      (find idnm *flsmgr-list* :key #'idnm)))
+  (declare (type fixnum idnm))
+  (the (or filtered-simplicial-group null)
+    (find idnm *flsmgr-list* :key #'idnm)))
 
 (DEFUN BUILD-FltrSmGr
     (&key cmpr basis bspn face face* intr-bndr bndr-strt intr-dgnl dgnl-strt 
-      sintr-grml sintr-grin flin orgn)
-   (declare
-     (type cmprf cmpr)
-     (type basis basis)
-     (type gmsm bspn)
-     (type face face)
-     (type (or null face*) face*)
-     (type (or intr-mrph null) intr-bndr intr-dgnl)
-        (type (or strt null) bndr-strt dgnl-strt)
-     (type sintr sintr-grml sintr-grin)
-     (type chcm-flin flin)
-     (list orgn))
-   (the FILTERED-SIMPLICIAL-GROUP
-     (progn
-         (let ((already (find orgn *flsmgr-list* :key #'orgn :test #'equal)))
-            (declare (type (or null FILTERED-SIMPLICIAL-GROUP) already))
-            (when already
-               (return-from build-FltrSmgr already)))
-         (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-strt :sintr-grml sintr-grml
-                       :sintr-grin sintr-grin :orgn orgn)))
-            (declare (type simplicial-group rslt))
-            (change-class rslt 'FILTERED-SIMPLICIAL-GROUP)
-            (setf (slot-value rslt 'flin) flin)
-            (push rslt *flsmgr-list*)
-               rslt))))
+          sintr-grml sintr-grin flin orgn)
+  (declare
+   (type cmprf cmpr)
+   (type basis basis)
+   (type gmsm bspn)
+   (type face face)
+   (type (or null face*) face*)
+   (type (or intr-mrph null) intr-bndr intr-dgnl)
+   (type (or strt null) bndr-strt dgnl-strt)
+   (type sintr sintr-grml sintr-grin)
+   (type chcm-flin flin)
+   (list orgn))
+  (the FILTERED-SIMPLICIAL-GROUP
+    (progn
+      (let ((already (find orgn *flsmgr-list* :key #'orgn :test #'equal)))
+        (declare (type (or null FILTERED-SIMPLICIAL-GROUP) already))
+        (when already
+          (return-from build-FltrSmgr already)))
+      (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-strt :sintr-grml sintr-grml
+                              :sintr-grin sintr-grin :orgn orgn)))
+        (declare (type simplicial-group rslt))
+        (change-class rslt 'FILTERED-SIMPLICIAL-GROUP)
+        (setf (slot-value rslt 'flin) flin)
+        (push rslt *flsmgr-list*)
+        rslt))))
 
 (DEFMACRO BUILD-FlABSMGR (&rest rest)
   `(change-class (build-flsmgr ,@rest) 'filtered-ab-simplicial-group))
 
-(defmethod change-chcm-to-flcc ((chcm simplicial-group) flin flin-orgn )
-   (declare
-      
-      (type chcm-flin flin)
-      ;;(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* (
-               (orgn (orgn chcm))
-               (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))
-         (setf (slot-value chcm 'flin) flin)
-         (push chcm *flsmgr-list*)
-         chcm))))
+(defmethod CHANGE-CHCM-TO-FLCC ((chcm simplicial-group) flin)
+  (declare   
+   (type chcm-flin flin))
+  (the FILTERED-SIMPLICIAL-GROUP
+    (progn
+      (change-class chcm 'FILTERED-SIMPLICIAL-GROUP)
+      (let* ((orgn (orgn chcm))
+             (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))
+        (setf (slot-value chcm 'flin) flin)
+        (push chcm *flsmgr-list*)
+        chcm))))
 
-(defmethod change-chcm-to-flcc ((chcm ab-simplicial-group) flin flin-orgn )
-   (declare
-      
-      (type chcm-flin flin)
-      ;;(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* (
-               (orgn (orgn chcm))
-               (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))
-         (setf (slot-value chcm 'flin) flin)
+(DEFMETHOD CHANGE-CHCM-TO-FLCC ((chcm ab-simplicial-group) flin)
+  (declare
+     (type chcm-flin flin))
+  (the FILTERED-AB-SIMPLICIAL-GROUP
+    (progn
+      (change-class chcm 'AB-FILTERED-SIMPLICIAL-GROUP)
+      (let* (
+             (orgn (orgn chcm))
+             (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))
+        (setf (slot-value chcm 'flin) flin)
         (push chcm *flabsmgr-list*)
-         chcm))))
+        chcm))))
+
 
-        
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;    EXAMPLES    ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
 
@@ -718,16 +667,16 @@
 
 ;; Filtration index function of a Bicomplex (first degree of a generator).
 (setf BCflin 
-      #'(lambda (degr gnrt)
-       (declare 
-         (type fixnum degr)
-         (type gnrt gnrt))
-       (let* ((degr1 (BcGnrt-Degr1 gnrt))
-              (degr2 (BcGnrt-Degr2 gnrt)))
-          (declare (type fixnum degr1 degr2))
-          (if (=  degr (+ degr1 degr2))
-             degr1
-             0))))
+  #'(lambda (degr gnrt)
+      (declare 
+       (type fixnum degr)
+       (type gnrt gnrt))
+      (let* ((degr1 (BcGnrt-Degr1 gnrt))
+             (degr2 (BcGnrt-Degr2 gnrt)))
+        (declare (type fixnum degr1 degr2))
+        (if (=  degr (+ degr1 degr2))
+            degr1
+          0))))
 
 #|
 (funcall BCflin 5 (build-bcgnrt 2 3 'a))
@@ -737,32 +686,32 @@
 ;; Function that changes the bicomplex bc to a filtered complex, with filtration
 ;; index of a generator defined as its first degree. 
 (defun CHANGE-BICM-TO-FLCC (bc)
-   (declare 
-     (type bicomplex bc))
-   (let* ((flin BCflin))
-      (declare       
-       (type chcm-flin flin))
-      (the FILTERED-CHAIN-COMPLEX
-        (change-chcm-to-flcc bc flin 'Bicomplex-Flin))))
+  (declare 
+   (type bicomplex bc))
+  (let* ((flin BCflin))
+    (declare       
+     (type chcm-flin flin))
+    (the FILTERED-CHAIN-COMPLEX
+      (change-chcm-to-flcc bc flin))))
 
 #|
 (defun bas (degr1 degr2)
-   (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 1)) (return-from bas '(c)))
-   (if (and (= degr1 2) (= degr2 0))  (return-from bas '(d)))
-   (return-from bas nil))
- 
+  (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 1)) (return-from bas '(c)))
+  (if (and (= degr1 2) (= degr2 0))  (return-from bas '(d)))
+  (return-from bas nil))
+
 (defun dif1 (degr1 degr2 gnrt)
-   (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))))
-   (return-from dif1 nil))
+  (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))))
+  (return-from dif1 nil))
 (defun dif2 (degr1 degr2 gnrt)
-   (if (and (= degr1 1) (= degr2 1) (eql gnrt 'c)) (return-from dif2 (list (cons 1 'b))))
-   (return-from dif2 nil))
+  (if (and (= degr1 1) (= degr2 1) (eql gnrt 'c)) (return-from dif2 (list (cons 1 'b))))
+  (return-from dif2 nil))
 
 (setf bc (Build-Bicm :bcbasis #'bas :dffr1 #'dif1 :dffr2 #'dif2 :cmpr 's-cmpr 
-          :orgn '(BC-test)))
+                     :orgn '(BC-test)))
 
 (change-bicm-to-flcc bc)
 (flin bc 1 (build-bcgnrt 0 1 'a))
@@ -780,40 +729,40 @@
 ;; BARS
 
 (defun abar-bidegree (abar)
-    (declare (type abar abar))
-    (the list
-      (let ((p (1- (length abar)))
-            (q 0))
-        (declare (type fixnum p q))
-        (setf q (apply #'+ (mapcar #'car (rest abar))))
-        (decf q p)
-        (return-from abar-bidegree (list p q)))))
+  (declare (type abar abar))
+  (the list
+    (let ((p (1- (length abar)))
+          (q 0))
+      (declare (type fixnum p q))
+      (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)
-         (type abar abar))
-       (let* ((abar-bidgr (abar-bidegree abar))
-              (degr1 (first abar-bidgr))
+  #'(lambda (degr abar)
+      (declare (type fixnum degr)
+               (type abar abar))
+      (let* ((abar-bidgr (abar-bidegree abar))
+             (degr1 (first abar-bidgr))
              (degr2 (second abar-bidgr)))
-         (if (=  degr (+ degr1 degr2))
-           degr1
+        (if (=  degr (+ degr1 degr2))
+            degr1
           0))))
 
 #|
 (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)
 
 
 (setf basis7 (basis bar2 7))
 
 (mapcar
- #'(lambda (gnrt)
-     (flin bar2 7 gnrt))
- basis7)
+    #'(lambda (gnrt)
+        (flin bar2 7 gnrt))
+  basis7)
 
 (flin bar2 (cmbn 7 (first basis7) (second basis7))) 
 
@@ -828,18 +777,18 @@
 ;; COBAR
 
 (defun allp-bidegree (allp)
-    (declare (type allp allp))
-    (the list
-      (let ((p (1- (length allp)))
-            (q 0))
-        (declare (type fixnum p q))
-        (setf q (apply #'+ (mapcar #'car (rest allp))))
-        (incf q p)
-        (return-from allp-bidegree (list (- p) q)))))
+  (declare (type allp allp))
+  (the list
+    (let ((p (1- (length allp)))
+          (q 0))
+      (declare (type fixnum p q))
+      (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)
+  #'(lambda (degr allp)
       (declare (ignore degr)
                (type allp allp))
       (with-allp (l) allp
@@ -852,28 +801,28 @@
 
 (DEFVAR tnpr-flin)
 (setf tnpr-flin 
-      #'(lambda (degr tnpr)
-          (declare 
-            (ignore degr)
-            (type tnpr tnpr))
-       (the fixnum
-         (degr1 tnpr))))
+  #'(lambda (degr tnpr)
+      (declare 
+       (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
-           (type fixnum degr)
-           (type crpr crpr))
-          (let* ((b (cadr crpr))
-                 (dgop (car b)))
-             (declare
-              (type iabsm b)
-              (type fixnum dgop))
-             (the fixnum
-               (- degr (length (dgop-int-ext dgop)))))))
+  #'(lambda (degr crpr)
+      (declare
+       (type fixnum degr)
+       (type crpr crpr))
+      (let* ((b (cadr crpr))
+             (dgop (car b)))
+        (declare
+         (type iabsm b)
+         (type fixnum dgop))
+        (the fixnum
+          (- degr (length (dgop-int-ext dgop)))))))
 
 #|
 (funcall fbrt-flin 3 '(:crpr (1 . s2) 0 . 3))
@@ -884,17 +833,17 @@
 
 ;; BICONES
  
-(defun bicone-flin (flinb flinc flind)
-   (declare (type chcm-flin flinb flinc flind))
-   (flet ((rslt (degr bicn)
-            (declare 
-              (type bicn bicn)
-              (type degr degr))
-            (let ((bcnx (bcnx bicn)))
-               (declare (type (member :bcnb :bcnc :bcnd) bcnx))
-               (if (eql :bcnb bcnx)
-                  (funcall flinb degr (ibicn bicn))
-                  (if (eql :bcnc bcnx)
-                     (funcall flinc degr (ibicn bicn))
+(DEFUN BICONE-FLIN (flinb flinc flind)
+  (declare (type chcm-flin flinb flinc flind))
+  (flet ((rslt (degr bicn)
+               (declare 
+                (type bicn bicn)
+                (type degr degr))
+               (let ((bcnx (bcnx bicn)))
+                 (declare (type (member :bcnb :bcnc :bcnd) bcnx))
+                 (if (eql :bcnb bcnx)
+                     (funcall flinb degr (ibicn bicn))
+                   (if (eql :bcnc bcnx)
+                       (funcall flinc degr (ibicn bicn))
                      (funcall flind degr (ibicn bicn)))))))
-     (the chcm-flin #'rslt))) 
+    (the chcm-flin #'rslt))) 
diff --git a/src/anromero/persistent-homology.lisp b/src/anromero/persistent-homology.lisp
index 7296199..ad4f40b 100644
--- a/src/anromero/persistent-homology.lisp
+++ b/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)
diff --git a/src/anromero/spectral-sequences.lisp b/src/anromero/spectral-sequences.lisp
index 219bb65..f7ba8ec 100644
--- a/src/anromero/spectral-sequences.lisp
+++ b/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 ecc tnpr-flin 'tnpr-flin)
+      (change-chcm-to-flcc fltrcm crpr-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 ecc tnpr-flin 'tnpr-flin)
+      (change-chcm-to-flcc x crpr-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))))))