Extracted all tests from delta.lisp.

package.lisp

@@ -71,6 +71,7 @@
 	   DEGR
 	   DFFR1
 	   F
+	   FACE
 	   G
 	   GMSM
 	   H
@@ -108,10 +109,20 @@
 	   ;; delta.lisp
 
 	   DELTA
+	   DELTA-BNDR
+	   DELTA-DGNL
 	   DELTA-FACE
+	   DELTA-INFINITY
 	   DELTA-N-BASIS
+	   DELTAB2-BNDR
+	   DELTAB2-DGNL
+	   SOFT-DELTA
+	   SOFT-DELTA-BNDR
 	   SOFT-DELTA-CMPR
+	   SOFT-DELTA-DGNL
 	   SOFT-DELTA-FACE
+	   SOFT-DELTA-INFINITY
+	   SOFT-DELTA-N-BASIS
 
 	   ;; effective-homology.lisp
 
@@ -146,12 +157,15 @@
 	   BCNC
 	   BCND
 	   BINOMIAL-P-Q
+	   BNDR
 	   CFFC
 	   CMBN-NON-ZERO-P
 	   CMBN-ZERO-P
 	   CMPR
+	   CPRD
 	   D
 	   DFFR
+	   DGNL
 	   GNRT
 	   I-SBTR
 	   MASK

src/delta.lisp

@@ -56,6 +56,7 @@
 		      (push (term sign (logxor gmsm pmark)) rslt)
 		      (setf sign (- sign))))))))
 
+
 (DEFUN SOFT-DELTA-BNDR (dmns gmsm)
   (declare
    (fixnum dmns)
@@ -67,16 +68,6 @@
 				(term cffc (d gmsm))))
 		 (cmbn-list (delta-bndr dmns (cdr gmsm))))))
 
-#|
-()
-(delta-bndr 0 4)
-(delta-bndr 1 3)
-(delta-bndr 1 5)
-(delta-bndr 1 10)
-(delta-bndr 5 63)
-(soft-delta-bndr 5 (d (mask 6)))
-|#
-
 
 (DEFUN DELTA-DGNL (dmns gmsm)
   (declare (fixnum dmns gmsm))
@@ -98,6 +89,7 @@
 		  (when (minusp (decf ldegr))
 		    (return rslt)))))))
 
+
 (DEFUN SOFT-DELTA-DGNL (dmns gmsm)
   (declare
    (fixnum dmns)
@@ -112,14 +104,7 @@
 							  degr2 (d gmsm2))))))
 		    (cmbn-list (delta-dgnl dmns (cdr gmsm))))))
 
-#|
+
-()
-(delta-dgnl 3 15)
-(delta-dgnl 3 170)
-(soft-delta-dgnl 3 (d (dlop-ext-int '(1 3 5 7))))
-(delta-dgnl 0 64)
-|#
-                                        
 (DEFUN DELTA-INFINITY ()
   (the simplicial-set
        (build-smst
@@ -133,17 +118,6 @@
 	:bndr-strt :gnrt
 	:orgn '(delta-infinity))))
 
-#|
-()
-(cmpr (delta-infinity) 2 4)
-(cmpr (delta-infinity) 4 4)
-(cmpr (delta-infinity) 8 4)
-(basis (delta-infinity) 1)   ;;; => error
-(face (delta-infinity) 1 2 21)
-(cprd (delta-infinity) 3 15)
-(dgnl (delta-infinity) 3 15)
-(? (delta-infinity) 2 21)
-|#
 
 (DEFUN SOFT-DELTA-INFINITY ()
   (the simplicial-set
@@ -156,15 +130,6 @@
 	:intr-bndr #'soft-delta-bndr :bndr-strt :gnrt
 	:orgn '(soft-delta-infinity))))
 
-#|
-()
-(cat-init)
-(cmpr (soft-delta-infinity) (d 2) (d 4))
-(face (soft-delta-infinity) 1 2 (d (dlop-ext-int '(1 3 5))))
-(cprd (soft-delta-infinity) 3 (d 15))
-(dgnl (soft-delta-infinity) 3 (d 15))
-(? (soft-delta-infinity) 2 (d (dlop-ext-int '(0 2 4))))
-|#
 
 (DEFUN DELTA-N-BASIS (n)
   (declare (fixnum n))
@@ -182,6 +147,7 @@
 	       (decf count)))))
     (the basis #'rslt)))
 
+
 (DEFUN SOFT-DELTA-N-BASIS (n)
   (declare (fixnum n))
   (flet ((rslt (dmns)
@@ -198,16 +164,6 @@
     (the basis #'rslt)))
 
 
-#|
-()
-(setf basis (delta-n-basis 3))
-(setf soft-basis (soft-delta-n-basis 3))
-(dotimes (i 5)
-  (print (funcall basis i)))
-(dotimes (i 5)
-  (print (funcall soft-basis i)))
-|#   
-
 (DEFUN DELTA (dmns)
   (declare (fixnum dmns))
   (the simplicial-set
@@ -222,21 +178,6 @@
 	:bndr-strt :gnrt
 	:orgn `(delta ,dmns))))
 
-#|
-()
-(cat-init)
-(setf d3 (delta 3))
-(cmpr d3 2 4)
-(cmpr d3 4 4)
-(cmpr d3 8 4)
-(basis d3 1)
-(dgnl d3 3 15)
-(face d3 1 2 21)
-(? d3 2 13)
-(setf d (delta-infinity))
-(basis d)
-(setf d (delta-infinity)))
-|#
 
 (DEFUN SOFT-DELTA (dmns)
   (declare (fixnum dmns))
@@ -250,41 +191,6 @@
 	:intr-bndr #'soft-delta-bndr :bndr-strt :gnrt
 	:orgn `(soft-delta ,dmns))))
 
-#|
-()
-(cat-init)
-(setf d3 (soft-delta 3))
-(cmpr d3 (d 2) (d 4))
-(basis d3 1)
-(dgnl d3 3 (d 15))
-(face d3 1 2 (d 21))
-(? d3 2 (d 13))
-|#
-
-#| For comparison with EAT.
-In 
-(setf delta (delta-infinity))
-(setf d (bndr delta))
-(setf s14 (mask 15))
-(cmbn-? d (gnrt-? d 14 s14))
-(defun t1 (n)
-  (time (dotimes (i n) (cmbn-? d (gnrt-? d 14 s14)))))
-(compile 't1)
-(t1 500)
-(setf +too-much-time+ -1)
-(t1 500)
-|#
-#|
-In EAT:
-(setf delta *delta*)
-(setf d (cc-d (ss-cc delta)))
-(setf s14 (<a-b> 0 14))
-(??? d (? d 14 s14))
-(defun t1 (n)
-  (time (dotimes (i n) (??? d (? d 14 s14)))))
-(compile 't1)
-(t1 500)
-|#
 
 (DEFUN DELTAB-CMPR (gmsm1 gmsm2)
   (declare (fixnum gmsm1 gmsm2))
@@ -292,6 +198,7 @@ In EAT:
       :equal
       (f-cmpr gmsm1 gmsm2)))
 
+
 (DEFUN DELTAB-BNDR (dmns gmsm)
   (declare (fixnum dmns gmsm))
   (the cmbn
@@ -311,6 +218,7 @@ In EAT:
 		      (push (term sign (logxor gmsm pmark)) rslt)
 		      (setf sign (- sign))))))))
 
+
 (DEFUN DELTAB2-FACE (indx dmns gmsm)
   (declare
    (fixnum indx dmns gmsm))
@@ -327,6 +235,7 @@ In EAT:
 	     (when (minusp (decf bmark))
 	       (return-from deltab2-face (absm 0 (logxor gmsm pmark)))))))))
 
+
 (DEFUN DELTAB2-DGNL (dmns gmsm)
   (declare (fixnum dmns gmsm))
   (the cmbn
@@ -352,12 +261,6 @@ In EAT:
 				    1))
 			(return (delete 1 rslt :key #'cadddr)))))))))
 
-#|
-()
-(dotimes (i 7)
-  (print (deltab2-dgnl i (mask (1+ i)))))
-|#
-
 
 (DEFUN DELTAB2-BNDR (dmns gmsm)
   (declare (fixnum dmns gmsm))
@@ -378,10 +281,6 @@ In EAT:
 		      (push (term sign (logxor gmsm pmark)) rslt)
 		      (setf sign (- sign))))))))
 
-#|
-(deltab-bndr 1 5)
-(deltab-bndr 3 15)
-|#
 
 (DEFUN DELTAB ()
   (the simplicial-set
@@ -394,6 +293,7 @@ In EAT:
 	:dgnl-strt :gnrt
 	:orgn '(deltab))))
 
+
 (DEFUN DELTAB2 ()
   (the simplicial-set
        (build-smst

test/delta-test.lisp

@@ -28,10 +28,103 @@
 	(print (cat:soft-delta-face i 3 (cat:d
 					  (cat:dlop-ext-int '(0 2 4 6)))))))
 
-#|
+
-(test homology
+(test delta-bndr
+      (is (cat:cmbn-zero-p (cat:delta-bndr 0 4)))
+      (is (cat:cmbn-non-zero-p (cat:delta-bndr 1 3)))
+      (is (cat:cmbn-non-zero-p (cat:delta-bndr 1 5)))
+      (is (cat:cmbn-non-zero-p (cat:delta-bndr 1 10)))
+      (is (cat:cmbn-non-zero-p (cat:delta-bndr 5 63)))
+      (is (cat:cmbn-non-zero-p (cat:soft-delta-bndr 5 (cat:d (cat:mask 6))))))
+
+(test delta-dgnl
+      (is (cat:cmbn-non-zero-p (cat:delta-dgnl 3 15)))
+      (is (cat:cmbn-non-zero-p (cat:delta-dgnl 3 170)))
+      (is (cat:cmbn-non-zero-p
+	   (cat:soft-delta-dgnl 3 (cat:d (cat:dlop-ext-int '(1 3 5 7))))))
+      (is (cat:cmbn-non-zero-p (cat:delta-dgnl 0 64))))
+
+
+(test delta-infinity
+      (is (equal :less (cat:cmpr (cat:delta-infinity) 2 4)))
+      (is (equal :equal (cat:cmpr (cat:delta-infinity) 4 4)))
+      (is (equal :greater (cat:cmpr (cat:delta-infinity) 8 4)))
+      (signals simple-error (cat:basis (cat:delta-infinity) 1))
+      (cat:face (cat:delta-infinity) 1 2 21)
+      (cat:cprd (cat:delta-infinity) 3 15)
+      (cat:dgnl (cat:delta-infinity) 3 15)
+      (is (cat:cmbn-non-zero-p (cat:? (cat:delta-infinity) 2 21))))
+
+
+(test soft-delta-infinity
       (progn
 	(cat:cat-init)
-	(let ((d (cat:delta 3)))
+	(cat:cmpr (cat:soft-delta-infinity) (cat:d 2) (cat:d 4))
-	  (princ (cat:homology d 0)))))
+	(cat:face (cat:soft-delta-infinity) 1 2
+		  (cat:d (cat:dlop-ext-int '(1 3 5))))
+	(cat:cprd (cat:soft-delta-infinity) 3 (cat:d 15))
+	(cat:dgnl (cat:soft-delta-infinity) 3 (cat:d 15))
+	(cat:? (cat:soft-delta-infinity) 2
+	       (cat:d (cat:dlop-ext-int '(0 2 4))))))
+
+(test basis
+      (let ((basis (cat:delta-n-basis 3))
+	    (soft-basis (cat:soft-delta-n-basis 3)))
+	(dotimes (i 5)
+	  (print (funcall basis i)))
+	(dotimes (i 5)
+	  (print (funcall soft-basis i)))))
+
+(test delta
+      (progn
+	(cat:cat-init)
+	(let ((d3 (cat:delta 3))
+	      (d))
+	  (is (equal :less (cat:cmpr d3 2 4)))
+	  (is (equal :equal (cat:cmpr d3 4 4)))
+	  (is (equal :greater (cat:cmpr d3 8 4)))
+	  (cat:basis d3 1)
+	  (cat:dgnl d3 3 15)
+	  (cat:face d3 1 2 21)
+	  (cat:? d3 2 13)
+	  (setf d (cat:delta-infinity))
+	  (cat:basis d))))
+
+(test soft-delta
+      (progn
+	(cat:cat-init)
+	(let ((d3 (cat:soft-delta 3)))
+	  (cat:cmpr d3 (cat:d 2) (cat:d 4))
+	  (cat:basis d3 1)
+	  (cat:dgnl d3 3 (cat:d 15))
+	  (cat:face d3 1 2 (cat:d 21))
+	  (cat:? d3 2 (cat:d 13)))))
+
+(test eat
+      (let* ((delta (cat:delta-infinity))
+	     (d (cat:bndr delta))
+	     (s14 (cat:mask 15)))
+	(cat:cmbn-? d (cat:gnrt-? d 14 s14))
+	(defun t1 (n)
+	  (time (dotimes (i n) (cat:cmbn-? d (cat:gnrt-? d 14 s14)))))
+	(compile 't1)
+	(t1 500)
+	(setf cat:+too-much-time+ -1)
+	(t1 500)))
+
+
+#|
+()
+(dotimes (i 7)
+  (print (deltab2-dgnl i (mask (1+ i)))))
+
+(test deltab2-dgnl
+      (dotimes (i 7)
+	(print (cat:deltab2-dgnl i (cat:mask (1+ i))))))
+
 |#
+
+
+(test deltab2-bndr
+      (cat:deltab2-bndr 1 5)
+      (cat:deltab2-bndr 3 15))