From 911a74de688f034ad749f483a825418e5c361feb Mon Sep 17 00:00:00 2001
From: Gerd Heber <gheber@hdfgroup.org>
Date: Tue, 7 Jul 2015 20:07:07 -0500
Subject: [PATCH] Extracted simple tests from homology-groups.lisp and
 searching-homology.lisp.

---
 kenzo-test.asd                    |   4 +-
 package.lisp                      |   7 +
 src/homology-groups.lisp          | 514 ++++++++++++++----------------
 src/searching-homology.lisp       |  41 ++-
 test/homology-groups-test.lisp    |  34 ++
 test/searching-homology-test.lisp |  10 +
 6 files changed, 316 insertions(+), 294 deletions(-)
 create mode 100644 test/homology-groups-test.lisp
 create mode 100644 test/searching-homology-test.lisp

diff --git a/kenzo-test.asd b/kenzo-test.asd
index e70e2de..635403a 100644
--- a/kenzo-test.asd
+++ b/kenzo-test.asd
@@ -17,4 +17,6 @@
 	       (:file "circle")
                (:file "ccn")
 	       (:file "effective-homology-test")
-	       (:file "bicones-test")))
+	       (:file "bicones-test")
+	       (:file "homology-groups-test")
+	       (:file "searching-homology-test")))
diff --git a/package.lisp b/package.lisp
index b08cd9b..3e05054 100644
--- a/package.lisp
+++ b/package.lisp
@@ -106,6 +106,7 @@
 
 	   ;; delta.lisp
 
+	   DELTA
 	   DELTA-N-BASIS
 
 	   ;; effective-homology.lisp
@@ -121,6 +122,12 @@
 
 	   FIBRATION-TOTAL
 
+	   ;; homology-groups
+
+	   CHCM-HOMOLOGY
+	   CHCM-HOMOLOGY-GEN
+	   CHCM-MAT
+
 	   ;; k-pi-n.lisp
 
 	   K-Z
diff --git a/src/homology-groups.lisp b/src/homology-groups.lisp
index 3f9005e..e286ec9 100644
--- a/src/homology-groups.lisp
+++ b/src/homology-groups.lisp
@@ -7,53 +7,53 @@
 (provide "homology-groups")
 
 ;;
-;;  Computing ordinary homology-groups. 
-;;  
+;;  Computing ordinary homology-groups.
+;;
 
 
 ;; Functions.
 
 (defun creer-matrice (n1 n2)
-   (let ((mat (make-matrice
-                 :leftcol (make-array (1+ n1))
-                 :uplig (make-array (1+ n2)))))
-      (setf (baselig mat 0) (make-t-mat :ilig 0 :icol 0))
-      (setf (basecol mat 0) (baselig mat 0))
-      (do ((i 1 (1+ i)))
-         ((> i n1))
-         (setf (baselig mat i)
+  (let ((mat (make-matrice
+	      :leftcol (make-array (1+ n1))
+	      :uplig (make-array (1+ n2)))))
+    (setf (baselig mat 0) (make-t-mat :ilig 0 :icol 0))
+    (setf (basecol mat 0) (baselig mat 0))
+    (do ((i 1 (1+ i)))
+	((> i n1))
+      (setf (baselig mat i)
             (make-t-mat :ilig i :icol 0 :up (baselig mat (1- i))))
-         (setf (left (baselig mat i)) (baselig mat i)))
-      (do ((j 1 (1+ j)))
-         ((> j n2))
-         (setf (basecol mat j)
+      (setf (left (baselig mat i)) (baselig mat i)))
+    (do ((j 1 (1+ j)))
+	((> j n2))
+      (setf (basecol mat j)
             (make-t-mat :ilig 0 :icol j :left (basecol mat (1- j))))
-         (setf (up (basecol mat j)) (basecol mat j)))
-      (setf (up (baselig mat 0)) (baselig mat n1))
-      (setf (left (basecol mat 0)) (basecol mat n2))
-      mat))
+      (setf (up (basecol mat j)) (basecol mat j)))
+    (setf (up (baselig mat 0)) (baselig mat n1))
+    (setf (left (basecol mat 0)) (basecol mat n2))
+    mat))
 
 (defun chercher-hor (p ic)
-   (do ((p2 p p1)
-        (p1 (left p) (left p1)))
-        ((<= (icol p1) ic) p2)))
+  (do ((p2 p p1)
+       (p1 (left p) (left p1)))
+      ((<= (icol p1) ic) p2)))
 
 (defun chercher-ver (p il)
-   (do ((p2 p p1)
-        (p1 (up p) (up p1)))
-       ((<= (ilig p1) il) p2)))
+  (do ((p2 p p1)
+       (p1 (up p) (up p1)))
+      ((<= (ilig p1) il) p2)))
 
 (defun inserer-terme (pl pc val)
-   (setf (left pl) (make-t-mat :val val
-                               :ilig (ilig pl)
-                               :icol (icol pc)
-                               :left (left pl)
-                               :up (up pc))
-         (up pc) (left pl)))
+  (setf (left pl) (make-t-mat :val val
+			      :ilig (ilig pl)
+			      :icol (icol pc)
+			      :left (left pl)
+			      :up (up pc))
+	(up pc) (left pl)))
 
 (defun supprimer-terme (pl pc)
-   (setf (left pl) (left (left pl))
-         (up pc) (up (up pc))))
+  (setf (left pl) (left (left pl))
+	(up pc) (up (up pc))))
 
 (defun maj-terme (pl pc val)
   (if (= val 0)
@@ -63,176 +63,176 @@
           (inserer-terme pl pc val))))
 
 (defun maj-ligne (mat il liste)
-   (let ((ptl (baselig mat il)))
-        (mapcar
-           #'(lambda (elem)
-                (maj-terme (chercher-hor ptl (first elem))
-                           (chercher-ver (basecol mat (first elem)) il)
-                           (second elem)))
-           liste)
-        ptl))
+  (let ((ptl (baselig mat il)))
+    (mapcar
+     #'(lambda (elem)
+	 (maj-terme (chercher-hor ptl (first elem))
+		    (chercher-ver (basecol mat (first elem)) il)
+		    (second elem)))
+     liste)
+    ptl))
 
 (defun maj-colonne (mat ic liste)
-   (let ((ptc (basecol mat ic)))
-        (mapcar
-           #'(lambda (elem)
-                (maj-terme (chercher-hor (baselig mat (first elem)) ic)
-			   (chercher-ver ptc (first elem))
-                           (second elem)))
-           liste)
-        ptc))
+  (let ((ptc (basecol mat ic)))
+    (mapcar
+     #'(lambda (elem)
+	 (maj-terme (chercher-hor (baselig mat (first elem)) ic)
+		    (chercher-ver ptc (first elem))
+		    (second elem)))
+     liste)
+    ptc))
 
 (defun maj-matrice (mat liste)
   (mapcar
-     #'(lambda (elem) (apply #'maj-ligne mat elem))
-     liste)
+   #'(lambda (elem) (apply #'maj-ligne mat elem))
+   liste)
   mat)
 
 (defun disp-p (p)
-   `((,(ilig p) ,(icol p) ,(val p))
-     (,(ilig (left p)) ,(icol (left p)) ,(val (left p)))
-     (,(ilig (up p)) ,(icol (up p)) ,(val (up p)))))
+  `((,(ilig p) ,(icol p) ,(val p))
+    (,(ilig (left p)) ,(icol (left p)) ,(val (left p)))
+    (,(ilig (up p)) ,(icol (up p)) ,(val (up p)))))
 
 (defun disp-ligne (mat il)
-   (terpri)
-   (princ "L")
-   (princ il)
-   (princ "=")
-   (mapcar
-      #'(lambda (elem)
-           (princ "(")
-           (princ (first elem))
-           (princ ":")
-           (princ (second elem))
-           (princ ")"))
-      (let ((ptl (baselig mat il))
-            (res '()))
-         (do ((pl (left ptl) (left pl)))
-             ((eq pl ptl))
-            (push (list (icol pl) (val pl)) res))
-         res))
+  (terpri)
+  (princ "L")
+  (princ il)
+  (princ "=")
+  (mapcar
+   #'(lambda (elem)
+       (princ "(")
+       (princ (first elem))
+       (princ ":")
+       (princ (second elem))
+       (princ ")"))
+   (let ((ptl (baselig mat il))
+	 (res '()))
+     (do ((pl (left ptl) (left pl)))
+	 ((eq pl ptl))
+       (push (list (icol pl) (val pl)) res))
+     res))
   (values ))
 
 (defun disp-colonne (mat ic)
-   (terpri)
-   (princ "C")
-   (princ ic)
-   (princ "=")
-   (mapcar
-      #'(lambda (elem)
-           (princ "(")
-           (princ (first elem))
-           (princ ":")
-           (princ (second elem))
-           (princ ")"))
-      (let ((ptc (basecol mat ic))
-            (res '()))
-         (do ((pc (up ptc) (up pc)))
-             ((eq pc ptc))
-            (push (list (ilig pc) (val pc)) res))
-         res))
-   (values ))
+  (terpri)
+  (princ "C")
+  (princ ic)
+  (princ "=")
+  (mapcar
+   #'(lambda (elem)
+       (princ "(")
+       (princ (first elem))
+       (princ ":")
+       (princ (second elem))
+       (princ ")"))
+   (let ((ptc (basecol mat ic))
+	 (res '()))
+     (do ((pc (up ptc) (up pc)))
+	 ((eq pc ptc))
+       (push (list (ilig pc) (val pc)) res))
+     res))
+  (values ))
 
 (defun nlig (mat) (1- (array-dimension (leftcol mat) 0)))
 (defun ncol (mat) (1- (array-dimension (uplig mat) 0)))
 
 (defun disp-matrice (mat)
-   (let ((nlig (nlig mat)))
-      (do ((i 1 (1+ i)))
-          ((> i nlig))
-          (disp-ligne mat i)))
-   (done))
+  (let ((nlig (nlig mat)))
+    (do ((i 1 (1+ i)))
+	((> i nlig))
+      (disp-ligne mat i)))
+  (done))
 
 #+clisp(eval-when (:compile-toplevel :load-toplevel :execute)
          (setf (ext:package-lock :clos) nil))
 (DEFMETHOD PRINT-OBJECT ((mtrx matrice) stream)
   (declare (stream stream))
   (the matrice (progn
-    (let ((nlig (nlig mtrx))
-	  (ncol (ncol mtrx)))
-      (declare (fixnum nlig ncol))
-      (format stream "~%========== MATRIX ~D lines + ~D columns ====="
-	      nlig ncol)
-      (do ((ilig 1 (1+ ilig)))
-	  ((> ilig nlig))
-	  (declare (fixnum ilig))
-	(format stream "~%L~D=" ilig)
-	(dolist (item (let ((baselig (baselig mtrx ilig)))
-			(declare (type t-mat baselig))
-			(do ((rslt +empty-list+ (cons t-mat rslt))
-			     (t-mat (left baselig) (left t-mat)))
-			    ((eq t-mat baselig) rslt)
-			    (declare
-			      (list rslt)
-			      (type t-mat t-mat)))))
-	   (declare (type t-mat item))
-	   (format stream "[C~D=~D]" (icol item) (val item))))
-      (format stream "~%========== END-MATRIX"))
+		 (let ((nlig (nlig mtrx))
+		       (ncol (ncol mtrx)))
+		   (declare (fixnum nlig ncol))
+		   (format stream "~%========== MATRIX ~D lines + ~D columns ====="
+			   nlig ncol)
+		   (do ((ilig 1 (1+ ilig)))
+		       ((> ilig nlig))
+		     (declare (fixnum ilig))
+		     (format stream "~%L~D=" ilig)
+		     (dolist (item (let ((baselig (baselig mtrx ilig)))
+				     (declare (type t-mat baselig))
+				     (do ((rslt +empty-list+ (cons t-mat rslt))
+					  (t-mat (left baselig) (left t-mat)))
+					 ((eq t-mat baselig) rslt)
+				       (declare
+					(list rslt)
+					(type t-mat t-mat)))))
+		       (declare (type t-mat item))
+		       (format stream "[C~D=~D]" (icol item) (val item))))
+		   (format stream "~%========== END-MATRIX"))
                  mtrx)))
 #+clisp(eval-when (:compile-toplevel :load-toplevel :execute)
          (setf (ext:package-lock :clos) t))
 
 
 (defun disp-matrice-colonnes (mat)
-   (let ((ncol (ncol mat)))
-      (do ((i 1 (1+ i)))
-          ((> i ncol))
-          (disp-colonne mat i)))
-   (done))
+  (let ((ncol (ncol mat)))
+    (do ((i 1 (1+ i)))
+	((> i ncol))
+      (disp-colonne mat i)))
+  (done))
 
 (defun terme (mat i j)
-   (let ((p (left (chercher-hor (baselig mat i) j))))
-        (if (= j (icol p))
-            (val (left p))
-            nil)))
+  (let ((p (left (chercher-hor (baselig mat i) j))))
+    (if (= j (icol p))
+	(val (left p))
+	nil)))
 
 (defun mat-aleat (n1 n2 dens x)
-   (let ((mat (creer-matrice n1 n2))
-         (n (truncate (* dens n1 n2)))
-         (2x (* 2 x))
-         (res nil))
-      (dotimes (i n)
-         (let* ((il (1+ (random n1)))
-                (ic (1+ (random n2)))
-                (val (let ((pval (- (random 2x) x)))
-                        (if (minusp pval)
-                            pval
-                            (1+ pval))))
-                (elem (member il res
-                         :test #'(lambda (x y) (eql x (first y))))))
-            (if elem
-                (push (list ic val) (cadar elem))
-                (push (list il (list (list ic val))) res))))
-      (maj-matrice mat res)))
+  (let ((mat (creer-matrice n1 n2))
+	(n (truncate (* dens n1 n2)))
+	(2x (* 2 x))
+	(res nil))
+    (dotimes (i n)
+      (let* ((il (1+ (random n1)))
+	     (ic (1+ (random n2)))
+	     (val (let ((pval (- (random 2x) x)))
+		    (if (minusp pval)
+			pval
+			(1+ pval))))
+	     (elem (member il res
+			   :test #'(lambda (x y) (eql x (first y))))))
+	(if elem
+	    (push (list ic val) (cadar elem))
+	    (push (list il (list (list ic val))) res))))
+    (maj-matrice mat res)))
 
 (defun op-elem (pl pc alpha)
-   (if (eq (left pl) (up pc))
-       (if (= alpha (val (left pl)))
-           (supprimer-terme pl pc)
-           (decf (val (left pl)) alpha))
-       (inserer-terme pl pc (- alpha))))
+  (if (eq (left pl) (up pc))
+      (if (= alpha (val (left pl)))
+	  (supprimer-terme pl pc)
+	  (decf (val (left pl)) alpha))
+      (inserer-terme pl pc (- alpha))))
 
 (defun peigne-ver (mat ptl il)
-       (if (< il (ilig ptl))
-           (do ((res nil (cons (chercher-ver pl il)
-                               res))
-                (pl (left ptl) (left pl)))
-               ((eq pl ptl) (nreverse res)))
-           (do ((res nil (cons (chercher-ver (basecol mat (icol pl)) il)
-                               res))
-                (pl (left ptl) (left pl)))
-               ((eq pl ptl) (nreverse res)))))
+  (if (< il (ilig ptl))
+      (do ((res nil (cons (chercher-ver pl il)
+			  res))
+	   (pl (left ptl) (left pl)))
+	  ((eq pl ptl) (nreverse res)))
+      (do ((res nil (cons (chercher-ver (basecol mat (icol pl)) il)
+			  res))
+	   (pl (left ptl) (left pl)))
+	  ((eq pl ptl) (nreverse res)))))
 
 (defun peigne-hor (mat ptc ic)
-       (if (< ic (icol ptc))
-           (do ((res nil (cons (chercher-hor pc ic)
-                               res))
-                (pc (up ptc) (up pc)))
-               ((eq pc ptc) (nreverse res)))
-           (do ((res nil (cons (chercher-hor (baselig mat (ilig pc)) ic)
-                               res))
-                (pc (up ptc) (up pc)))
-               ((eq pc ptc) (nreverse res)))))
+  (if (< ic (icol ptc))
+      (do ((res nil (cons (chercher-hor pc ic)
+			  res))
+	   (pc (up ptc) (up pc)))
+	  ((eq pc ptc) (nreverse res)))
+      (do ((res nil (cons (chercher-hor (baselig mat (ilig pc)) ic)
+			  res))
+	   (pc (up ptc) (up pc)))
+	  ((eq pc ptc) (nreverse res)))))
 
 (defun op-lig (ptl1 ptl2 peigne lambda)
   (do ((pl1 (left ptl1) (left pl1))
@@ -471,70 +471,70 @@
   (prog ((B (identite (n-col M)))
          (res nil)
          (p1) (p2) (div))
-    depart1
-      (setf p1 (terme-minimal-matrice M))
-    loop1
-      (if (null p1)
-          (go depart2)
-          (if (= 1 (abs (val p1)))
-              (go pivot1)
-              (progn (setf p2 (reste-minimal-colonne M p1))
-                     (if (null p2)
-                         (progn (setf p2 (reste-minimal-ligne M p1))
-                                (if (null p2)
-                                    (go pivot1)
-                                    (go op-col1)))
-                         (go op-lig1)))))
-    op-lig1
-      (op-lig-n M (ilig p1) (ilig p2) (diviseur (val p2) (val p1)))
-      (setf p1 p2)
-      (go loop1)
-    op-col1
-      (setf div (diviseur (val p2) (val p1)))
-      (op-col-n M (icol p1) (icol p2) div)
-      (op-col-n B (icol p1) (icol p2) div)
-      (op-lig-n N (icol p2) (icol p1) (- div))
-      (setf p1 p2)
-      (go loop1)
-    pivot1
-      (tuer-ligne N (icol p1))
-      (pivot-parallele M B p1)
-      (pivot M p1)
-      (go depart1)
+   depart1
+   (setf p1 (terme-minimal-matrice M))
+   loop1
+   (if (null p1)
+       (go depart2)
+       (if (= 1 (abs (val p1)))
+	   (go pivot1)
+	   (progn (setf p2 (reste-minimal-colonne M p1))
+		  (if (null p2)
+		      (progn (setf p2 (reste-minimal-ligne M p1))
+			     (if (null p2)
+				 (go pivot1)
+				 (go op-col1)))
+		      (go op-lig1)))))
+   op-lig1
+   (op-lig-n M (ilig p1) (ilig p2) (diviseur (val p2) (val p1)))
+   (setf p1 p2)
+   (go loop1)
+   op-col1
+   (setf div (diviseur (val p2) (val p1)))
+   (op-col-n M (icol p1) (icol p2) div)
+   (op-col-n B (icol p1) (icol p2) div)
+   (op-lig-n N (icol p2) (icol p1) (- div))
+   (setf p1 p2)
+   (go loop1)
+   pivot1
+   (tuer-ligne N (icol p1))
+   (pivot-parallele M B p1)
+   (pivot M p1)
+   (go depart1)
 
-    depart2
-      (setf p1 (terme-minimal-matrice N))
-    loop2
-      (if (null p1)
-          (go depart3)
-          (if (= 1 (abs (val p1)))
-              (go pivot2)
-              (progn (setf p2 (reste-minimal-ligne N p1))
-                     (if (null p2)
-                         (progn (setf p2 (reste-minimal-colonne N p1))
-                                (if (null p2)
-                                    (go pivot2-torsion)
-                                    (go op-lig2)))
-                         (go op-col2)))))
-    op-lig2
-      (setf div (diviseur (val p2) (val p1)))
-      (op-col-n B (ilig p2) (ilig p1) (- div))
-      (op-lig-n N (ilig p1) (ilig p2) div)
-      (setf p1 p2)
-      (go loop2)
-    op-col2
-      (op-col-n N (icol p1) (icol p2) (diviseur (val p2) (val p1)))
-      (setf p1 p2)
-      (go loop2)
-    pivot2-torsion
-      (setf res (cons (generateur-torsion-H* B N p1) res))
-    pivot2
-      (tuer-colonne B (ilig p1))
-      (pivot N p1)
-      (go depart2)
+   depart2
+   (setf p1 (terme-minimal-matrice N))
+   loop2
+   (if (null p1)
+       (go depart3)
+       (if (= 1 (abs (val p1)))
+	   (go pivot2)
+	   (progn (setf p2 (reste-minimal-ligne N p1))
+		  (if (null p2)
+		      (progn (setf p2 (reste-minimal-colonne N p1))
+			     (if (null p2)
+				 (go pivot2-torsion)
+				 (go op-lig2)))
+		      (go op-col2)))))
+   op-lig2
+   (setf div (diviseur (val p2) (val p1)))
+   (op-col-n B (ilig p2) (ilig p1) (- div))
+   (op-lig-n N (ilig p1) (ilig p2) div)
+   (setf p1 p2)
+   (go loop2)
+   op-col2
+   (op-col-n N (icol p1) (icol p2) (diviseur (val p2) (val p1)))
+   (setf p1 p2)
+   (go loop2)
+   pivot2-torsion
+   (setf res (cons (generateur-torsion-H* B N p1) res))
+   pivot2
+   (tuer-colonne B (ilig p1))
+   (pivot N p1)
+   (go depart2)
 
-    depart3
-      (return (append res (terminer-H* B)))))
+   depart3
+   (return (append res (terminer-H* B)))))
 
 
 (DEFUN CHCM-MAT (chcm n)
@@ -551,7 +551,7 @@
      (type cmprf cmpr))
     (format t "~%Computing boundary-matrix in dimension ~D.
 Rank of the source-module : ~D.~2%"
-      n (length sorc))
+	    n (length sorc))
     (let ((sorcl (length sorc))
           (mat (creer-matrice (length trgt) (length sorc)))
           (test #'(lambda (gnrt1 gnrt2)
@@ -569,47 +569,33 @@ Rank of the source-module : ~D.~2%"
         (when *homology-verbose*
           (clock)
           (format t "Computing the boundary of the generator ~D/~D (dimension ~D) :"
-            i sorcl n)
+		  i sorcl n)
           (print (car mark)))
-          (maj-colonne mat i
-             (mapcar #'(lambda (term)
-                          (declare (type term term))
-                          (list
-                             (1+ (position (gnrt term) trgt :test test))
-                             (cffc term)))
-               (cmbn-list (? chcm n (car mark)))))
+	(maj-colonne mat i
+		     (mapcar #'(lambda (term)
+				 (declare (type term term))
+				 (list
+				  (1+ (position (gnrt term) trgt :test test))
+				  (cffc term)))
+			     (cmbn-list (? chcm n (car mark)))))
         (when *homology-verbose*
           (format t "~%End of computing.~2%")))
-       mat)))
+      mat)))
 
-#|
-()
-(setf d (delta 3))
-(chcm-mat d 2)
-(chcm-mat d 3)
-(chcm-mat d 4)
-|#
 
 (defun chcm-homology (cc n)
   (declare (type chain-complex cc) (type fixnum n))
   (let ((rsl (homologie (chcm-mat cc n) (chcm-mat cc (1+ n)))))
-    (declare (type list rsl))    
+    (declare (type list rsl))
     (format t "~3%Homology in dimension ~D :~%" n)
     (dolist (item rsl)
       (declare (type list item))
       (format t "~2%Component Z")
-      (unless (zerop (first item)) 
+      (unless (zerop (first item))
 	(format t "/~DZ" (first item)))))
   (terpri) (terpri)
   (done))
 
-#|
-()
-(setf d (sphere 3))
-(chcm-homology d 2)
-(chcm-homology d 3)
-(chcm-homology d 4)
-|#
 
 (defun chcm-homology-gen (cc n)
   (declare (type chain-complex cc) (type fixnum n))
@@ -620,7 +606,7 @@ Rank of the source-module : ~D.~2%"
     (dolist (item rsl)
       (declare (type list item))
       (format t "~%Component Z")
-      (unless (zerop (first item)) 
+      (unless (zerop (first item))
         (format t "/~DZ" (first item))))
     (terpri) (terpri)
     (setf rsl (mapcar #'cdr rsl))
@@ -629,22 +615,14 @@ Rank of the source-module : ~D.~2%"
                           (mapcar #'(lambda (term)
                                       (declare (type term term))
                                       (term (car term) (nth (cdr term) src)))
-                            item))
-                rsl))
+				  item))
+		      rsl))
     (setf rsl (mapcar #'(lambda (item)
                           (declare (type list item))
                           (make-cmbn :degr n :list item))
-                rsl))
-    rsl))    
-    
-#|
-()
-(setf d (sphere 3))
-(chcm-homology-gen d 2)
-(chcm-homology-gen d 3)
-(chcm-homology-gen d 4)
+		      rsl))
+    rsl))
 
-|#
 
 (defun chcm-homology-gen-old (cc n)
   (declare (type chain-complex cc) (type fixnum n))
@@ -655,18 +633,10 @@ Rank of the source-module : ~D.~2%"
     (dolist (item rsl)
       (declare (type list item))
       (format t "~2%Component Z")
-      (unless (zerop (first item)) 
+      (unless (zerop (first item))
 	(format t "/~DZ" (first item)))
       (format t "~2%Generator :")
       (dolist (item2 (rest item))
 	(declare (type cons item2))
 	(format t "~%~D~6T*  ~S" (car item2) (nth (cdr item2) src)))))
   (done))
-
-#|
-()
-(setf d (sphere 3))
-(chcm-homology-gen-old d 2)
-(chcm-homology-gen-old d 3)
-(chcm-homology-gen-old d 4)
-|#
diff --git a/src/searching-homology.lisp b/src/searching-homology.lisp
index a1d4faf..52566e4 100644
--- a/src/searching-homology.lisp
+++ b/src/searching-homology.lisp
@@ -7,38 +7,37 @@
 (PROVIDE "searching-homology")
 
 (DEFUN ECHCM (chcm)
-   (rbcc (efhm chcm)))
+  (rbcc (efhm chcm)))
+
 
 (DEFGENERIC HOMOLOGY (chcm degr1 &optional degr2))
 
+
 (DEFMETHOD HOMOLOGY ((chcm chain-complex) degr1 &optional (degr2 (1+ degr1)))
-   (declare (fixnum degr1 degr2))
-   (do ((degr degr1 (1+ degr)))
-       ((>= degr degr2))
-      (declare (fixnum degr))
-      (chcm-homology (echcm chcm) degr)
-      (terpri) (clock) (terpri)))
+  (declare (fixnum degr1 degr2))
+  (do ((degr degr1 (1+ degr)))
+      ((>= degr degr2))
+    (declare (fixnum degr))
+    (chcm-homology (echcm chcm) degr)
+    (terpri) (clock) (terpri)))
+
 
 (DEFGENERIC SEARCH-EFHM (chcm orgn))
 
+
 (DEFMETHOD SEARCH-EFHM (chcm orgn)
   (declare (ignore chcm orgn))
   nil)
 
+
 (DEFMETHOD SLOT-UNBOUND (class (chcm chain-complex) (slot-name (eql 'efhm)))
-   (declare (ignore class))
-   (the homotopy-equivalence
-     (let ((efhm (search-efhm chcm (first (orgn chcm)))))
-       (setf (efhm chcm)
-	     (or efhm
-		 (when (functionp (basis chcm))
-		       (trivial-hmeq chcm))
-		 (error "I don't know how to determine ~
+  (declare (ignore class))
+  (the homotopy-equivalence
+       (let ((efhm (search-efhm chcm (first (orgn chcm)))))
+	 (setf (efhm chcm)
+	       (or efhm
+		   (when (functionp (basis chcm))
+		     (trivial-hmeq chcm))
+		   (error "I don't know how to determine ~
                          the effective homology of:~@
                          ~A (Origin: ~A)." chcm (orgn chcm)))))))
-
-#|
-  (cat-init)
-  (setf d (delta 3))
-  (homology d 0)
-|#
diff --git a/test/homology-groups-test.lisp b/test/homology-groups-test.lisp
new file mode 100644
index 0000000..393ce0a
--- /dev/null
+++ b/test/homology-groups-test.lisp
@@ -0,0 +1,34 @@
+
+(in-package :kenzo-test)
+
+(in-suite :kenzo)
+
+(test chcm-mat
+      (progn
+	(let ((d (cat:delta 3)))
+	  (princ (cat:chcm-mat d 2))
+	  (princ (cat:chcm-mat d 3))
+	  (princ (cat:chcm-mat d 4)))))
+
+(test chcm-homology
+      (progn
+	(let ((d (cat:sphere 3)))
+	  (princ (cat:chcm-homology d 2))
+	  (princ (cat:chcm-homology d 3))
+	  (princ (cat:chcm-homology d 4)))))
+
+(test chcm-homology-gen
+      (progn
+	(let ((d (cat:sphere 3)))
+	  (princ (cat:chcm-homology-gen d 2))
+	  (princ (cat:chcm-homology-gen d 3))
+	  (princ (cat:chcm-homology-gen d 4)))))
+
+
+#|
+()
+(setf d (sphere 3))
+(chcm-homology-gen-old d 2)
+(chcm-homology-gen-old d 3)
+(chcm-homology-gen-old d 4)
+|#
diff --git a/test/searching-homology-test.lisp b/test/searching-homology-test.lisp
new file mode 100644
index 0000000..efeb17e
--- /dev/null
+++ b/test/searching-homology-test.lisp
@@ -0,0 +1,10 @@
+
+(in-package :kenzo-test)
+
+(in-suite :kenzo)
+
+(test homology
+      (progn
+	(cat:cat-init)
+	(let ((d (cat:delta 3)))
+	  (princ (cat:homology d 0)))))