diff --git a/package.lisp b/package.lisp index 66ab63f..4e49a9a 100644 --- a/package.lisp +++ b/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 diff --git a/src/delta.lisp b/src/delta.lisp index 769a8b9..fed9f6b 100644 --- a/src/delta.lisp +++ b/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 ( 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 diff --git a/test/delta-test.lisp b/test/delta-test.lisp index 284c477..5d3da19 100644 --- a/test/delta-test.lisp +++ b/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))) - (princ (cat:homology d 0))))) + (cat:cmpr (cat:soft-delta-infinity) (cat:d 2) (cat:d 4)) + (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))