Extracted all tests from delta.lisp.
This commit is contained in:
Gerd Heber
parent
31d84edc1e
commit
7776c92aaf
14
package.lisp
14
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
|
||||
|
||||
116
src/delta.lisp
116
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
|
||||
|
||||
@ -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))
|
||||
|
||||
Loading…
Reference in New Issue
Block a user