mmarco/kenzo
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

Extracted simplicial set tests.

Browse Source
This commit is contained in:
Gerd Heber 2015-07-12 19:35:13 -05:00
parent e31bbd56f7
commit c177ef36f4
5 changed files with 571 additions and 507 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

3
kenzo-test.asd
View File

@ -9,6 +9,7 @@
:pathname #P"test/" :pathname #P"test/"
:components ((:file "package") :components ((:file "package")
(:file "common") (:file "common")
#|
(:file "combinations-test") (:file "combinations-test")
(:file "various-test") (:file "various-test")
(:file "chain-complexes-test") (:file "chain-complexes-test")
@ -27,4 +28,6 @@
;;(:file "cl-space-efhm-test") ;;(:file "cl-space-efhm-test")
(:file "tensor-products-test") (:file "tensor-products-test")
(:file "k-pi-n-test") (:file "k-pi-n-test")
|#
(:file "simplicial-sets-test")
)) ))

24
package.lisp
View File

@ -107,6 +107,7 @@
CMBN-DEGR CMBN-DEGR
CMBN-LIST CMBN-LIST
DEGR DEGR
DGOP
DFFR1 DFFR1
EFHM EFHM
F F
@ -272,9 +273,27 @@
;; simplicial-sets.lisp ;; simplicial-sets.lisp
1DGNR
1DGOP*DGOP
1DLOP-DGOP
A-CMPR3
A-FACE4
BSPN-P
CHECK-FACES
CHECK-SMST
DGOP*DGOP DGOP*DGOP
DGOP/DGOP
DGOP-EXT-INT
DGOP-INT-EXT
DLOP-EXT-INT DLOP-EXT-INT
DLOP-INT-EXT DLOP-INT-EXT
FACE-BNDR
FACE*-BNDR
HYPHENIZE-LIST
INTR-DIAGONAL
NDGNR
NFACE
REMOVE-BIT
;; smith.lisp ;; smith.lisp
@ -282,8 +301,11 @@
;; special-smsts.lisp ;; special-smsts.lisp
SPHERE
BUILD-FINITE-SS BUILD-FINITE-SS
MOORE
R-PROJ-SPACE
SPHERE
SPHERE-FACE
;; tensor-products.lisp ;; tensor-products.lisp

1
src/abbreviations.lisp
View File

@ -17,6 +17,7 @@
:BNDR "BouNDaRy" :BNDR "BouNDaRy"
:BRGN "BaR-GeNerator" :BRGN "BaR-GeNerator"
:BSGN "BaSe GeNerator" :BSGN "BaSe GeNerator"
:BSPN "BaSe-PoiNt"
;; C ;; C
:CBGN "CoBar-GeNerator" :CBGN "CoBar-GeNerator"

186
src/simplicial-sets.lisp
View File

@ -20,11 +20,6 @@
(the fixnum (2-exp item))) (the fixnum (2-exp item)))
ext-dgop)))) ext-dgop))))
#|
(dgop-ext-int '())
(dgop-ext-int '(2 2))
(dgop-ext-int '(4 0))
|#
(DEFUN DGOP-INT-EXT (dgop) (DEFUN DGOP-INT-EXT (dgop)
(declare (fixnum dgop)) (declare (fixnum dgop))
@ -41,13 +36,6 @@
(when (oddp dgop) (when (oddp dgop)
(push bmark rslt))))) (push bmark rslt)))))
#|
(dgop-int-ext 0)
(dgop-int-ext 4)
(dgop-int-ext 63)
(dotimes (i 33)
(print (dgop-ext-int (dgop-int-ext i)))))
|#
(DEFUN HYPHENIZE-LIST (list) (DEFUN HYPHENIZE-LIST (list)
(declare (list list)) (declare (list list))
@ -55,11 +43,6 @@
(format nil "~D~{-~D~}" (first list) (rest list)) (format nil "~D~{-~D~}" (first list) (rest list))
(format nil "-"))) (format nil "-")))
#|
(hyphenize-list '())
(hyphenize-list '(3))
(hyphenize-list '(5 3 1)))
|#
(DEFUN ABSM-PRINT (absm stream depth) (DEFUN ABSM-PRINT (absm stream depth)
(declare (declare
@ -72,11 +55,13 @@
(gmsm absm)) (gmsm absm))
absm) absm)
(DEFUN FACE4 (smst indx dmns gmsm-or-absm) (DEFUN FACE4 (smst indx dmns gmsm-or-absm)
(if (typep gmsm-or-absm 'absm) (if (typep gmsm-or-absm 'absm)
(a-face4 (face1 smst) indx dmns gmsm-or-absm) (a-face4 (face1 smst) indx dmns gmsm-or-absm)
(funcall (face1 smst) indx dmns gmsm-or-absm))) (funcall (face1 smst) indx dmns gmsm-or-absm)))
#+clisp(eval-when (:compile-toplevel :load-toplevel :execute) #+clisp(eval-when (:compile-toplevel :load-toplevel :execute)
(setf (ext:package-lock :clos) nil)) (setf (ext:package-lock :clos) nil))
(DEFMETHOD PRINT-OBJECT ((smst simplicial-set) stream) (DEFMETHOD PRINT-OBJECT ((smst simplicial-set) stream)
@ -93,6 +78,7 @@
(the (or simplicial-set null) (the (or simplicial-set null)
(find n *smst-list* :key #'idnm))) (find n *smst-list* :key #'idnm)))
(DEFUN BUILD-SMST (DEFUN BUILD-SMST
(&key cmpr basis bspn face face* intr-bndr bndr-strt (&key cmpr basis bspn face face* intr-bndr bndr-strt
intr-dgnl dgnl-strt orgn) intr-dgnl dgnl-strt orgn)
@ -136,6 +122,7 @@
(push rslt *smst-list*) (push rslt *smst-list*)
rslt))) rslt)))
(DEFUN A-BASIS2 (basis dmns) (DEFUN A-BASIS2 (basis dmns)
(declare (declare
(type basis basis) (type basis basis)
@ -156,11 +143,6 @@
rslt))) rslt)))
((minusp dgop) rslt))))) ((minusp dgop) rslt)))))
#|
(setf m (moore 2 2))
(dotimes (i 4)
(print (basis m i :dgnr)))
|#
(DEFUN INTR-DIAGONAL (face) (DEFUN INTR-DIAGONAL (face)
(declare (type face face)) (declare (type face face))
@ -196,21 +178,6 @@
(make-cmbn :degr dmns :list rslt))))) (make-cmbn :degr dmns :list rslt)))))
(the intr-mrph #'rslt))) (the intr-mrph #'rslt)))
#|
()
(setf cmpr #'f-cmpr
face #'delta-face)
(setf diag (intr-diagonal face))
(funcall diag 4 (mask 5))
(funcall diag 0 4)
(setf cmpr #'s-cmpr
face (sphere-face 4))
(setf diag (intr-diagonal face))
(funcall diag 4 's4)
(funcall diag 0 '*)
(setf s4 (sphere 4))
(dgnl s4 4 's4)
|#
(DEFUN FACE-BNDR (cmpr face) (DEFUN FACE-BNDR (cmpr face)
(declare (declare
@ -237,26 +204,6 @@
(apply #'nterm-add cmpr (1- dmns) pre-rslt)))))) (apply #'nterm-add cmpr (1- dmns) pre-rslt))))))
(the intr-mrph #'rslt))) (the intr-mrph #'rslt)))
#|
(setf face #'(lambda (indx dmns gmsm)
(absm 0 (append
(subseq gmsm 0 indx)
(subseq gmsm (1+ indx))))))
(setf bndr (face-bndr #'l-cmpr face))
(funcall bndr 0 '(a))
(funcall bndr 1 '(a b))
(funcall bndr 2 '(a b c))
(funcall bndr 3 '(a b c d))
(funcall bndr 3 '(d c b a))
(funcall bndr 1 '(a a))
(funcall bndr 2 '(a a a))
(funcall bndr 3 '(a a a a))
(setf face #'(lambda (index dmns gmsm)
(absm (dgop-ext-int (nreverse (<a-b< 0 (1- dmns)))) 'a)))
(setf bndr (face-bndr #'s-cmpr face))
(funcall bndr 1 '(a b))
(funcall bndr 2 '(a b c)))
|#
(DEFUN FACE*-BNDR (cmpr face*) (DEFUN FACE*-BNDR (cmpr face*)
(declare (declare
@ -282,26 +229,6 @@
(apply #'nterm-add cmpr (1- dmns) pre-rslt)))))) (apply #'nterm-add cmpr (1- dmns) pre-rslt))))))
(the intr-mrph #'rslt))) (the intr-mrph #'rslt)))
#|
(setf face*
#'(lambda (indx dmns gmsm)
(if (and (= dmns 3) (evenp indx))
'm2
:degenerate)))
(setf bndr (face*-bndr #'s-cmpr face*))
(funcall bndr 3 'm3)
(funcall bndr 2 'm2)
(funcall bndr 0 '*)
(setf face*
#'(lambda (indx dmns gmsm)
(if (and (= dmns 3) (< indx 2))
'm2
:degenerate)))
(setf bndr (face*-bndr #'s-cmpr face*))
(funcall bndr 3 'm3)
(funcall bndr 2 'm2)
(funcall bndr 0 '*))
|#
(DEFUN A-CMPR3 (cmpr absm1 absm2) (DEFUN A-CMPR3 (cmpr absm1 absm2)
(declare (declare
@ -314,13 +241,6 @@
(f-cmpr dgop1 dgop2) (f-cmpr dgop1 dgop2)
(funcall cmpr gmsm1 gmsm2)))))) (funcall cmpr gmsm1 gmsm2))))))
#|
(a-cmpr3 #'s-cmpr (absm 0 'a) (absm 1 'b))
(a-cmpr3 #'s-cmpr (absm 2 'a) (absm 1 'b))
(a-cmpr3 #'s-cmpr (absm 1 'a) (absm 1 'b))
(a-cmpr3 #'s-cmpr (absm 1 'c) (absm 1 'b))
(a-cmpr3 #'s-cmpr (absm 1 'a) (absm 1 'a))
|#
(DEFUN BSPN-P (cmpr bspn dmns absm) (DEFUN BSPN-P (cmpr bspn dmns absm)
;; this function makes sense only in the simplicial context ;; this function makes sense only in the simplicial context
@ -334,13 +254,6 @@
(and (= dgop (mask dmns)) (and (= dgop (mask dmns))
(eq :equal (funcall cmpr bspn gmsm)))))) (eq :equal (funcall cmpr bspn gmsm))))))
#|
(setf d (delta-infinity))
(setf cmpr (cmpr d))
(bspn-p cmpr 1 5 (absm (mask 5) 1))
(bspn-p cmpr 1 5 (absm (mask 5) 2))
(bspn-p cmpr 1 5 (absm (mask 4) 3))
|#
(DEFUN DLOP-EXT-INT (ext-dlop) (DEFUN DLOP-EXT-INT (ext-dlop)
(declare (list ext-dlop)) (declare (list ext-dlop))
@ -354,24 +267,13 @@
(declare (fixnum item)) (declare (fixnum item))
(the fixnum (2-exp item))) (the fixnum (2-exp item)))
ext-dlop)))) ext-dlop))))
#|
(dlop-ext-int '())
(dlop-ext-int '(2 2))
(dlop-ext-int '(0 4)))
|#
(DEFUN DLOP-INT-EXT (dlop) (DEFUN DLOP-INT-EXT (dlop)
(declare (fixnum dlop)) (declare (fixnum dlop))
(the list (the list
(nreverse (dgop-int-ext dlop)))) (nreverse (dgop-int-ext dlop))))
#|
(dlop-int-ext 0)
(dlop-int-ext 4)
(dlop-int-ext 63)
(dotimes (i 33)
(print (dlop-ext-int (dlop-int-ext i)))))
|#
(DEFUN 1DGOP*DGOP (1dgop dgop) (DEFUN 1DGOP*DGOP (1dgop dgop)
(declare (fixnum 1dgop dgop)) (declare (fixnum 1dgop dgop))
@ -385,12 +287,6 @@
(2-exp 1dgop) (2-exp 1dgop)
(logandc1 share dgop))))) (logandc1 share dgop)))))
#|
(dotimes (i 20)
(dotimes (j 5)
(format t "~% (~D) o ~A = ~A"
j (dgop-int-ext i) (dgop-int-ext (1dgop*dgop j i))))))
|#
(DEFUN DGOP*DGOP (dgop1 dgop2) (DEFUN DGOP*DGOP (dgop1 dgop2)
(declare (type fixnum dgop1 dgop2)) (declare (type fixnum dgop1 dgop2))
@ -413,13 +309,6 @@
(setf dgop1 (ash dgop1 -1)) (setf dgop1 (ash dgop1 -1))
(incf bmark)))) (incf bmark))))
#|
(dotimes (i 10)
(dotimes (j 10)
(format t "~%~A o ~A = ~A"
(dgop-int-ext i) (dgop-int-ext j)
(dgop-int-ext (dgop*dgop i j))))))
|#
(DEFUN REMOVE-BIT (n indx) (DEFUN REMOVE-BIT (n indx)
(declare (fixnum n indx)) (declare (fixnum n indx))
@ -429,9 +318,6 @@
(declare (fixnum quotient remainder)) (declare (fixnum quotient remainder))
(+ (ash (ash quotient -1) indx) remainder))))) (+ (ash (ash quotient -1) indx) remainder)))))
#|
(remove-bit 107 3) ;; 51
|#
(DEFUN DGOP/DGOP (dgop1 dgop2) (DEFUN DGOP/DGOP (dgop1 dgop2)
(declare (fixnum dgop1 dgop2)) (declare (fixnum dgop1 dgop2))
@ -442,11 +328,6 @@
(when (logbitp indx dgop2) (when (logbitp indx dgop2)
(setf dgop1 (remove-bit dgop1 indx)))))) (setf dgop1 (remove-bit dgop1 indx))))))
#|
(dgop/dgop 67 0)
(dgop/dgop 68 4)
(dgop/dgop 31 5)
|#
(DEFUN 1DLOP-DGOP (1dlop dgop) (DEFUN 1DLOP-DGOP (1dlop dgop)
(declare (fixnum 1dlop dgop)) (declare (fixnum 1dlop dgop))
@ -482,14 +363,6 @@
(logxor right (logand share (ash dgop -1))) (logxor right (logand share (ash dgop -1)))
(- 1dlop (logcount right)))))))) (- 1dlop (logcount right))))))))
#|
(dotimes (i 5)
(dotimes (j 17)
(multiple-value-bind (dgop 1dlop) (1dlop-dgop i j)
(format t "~% del-~D o ~A = ~A o del-~A"
i (dgop-int-ext j) (dgop-int-ext dgop) 1dlop)))))
|#
(DEFUN A-FACE4 (face indx dmns absm) (DEFUN A-FACE4 (face indx dmns absm)
(declare (declare
@ -509,19 +382,7 @@
(declare (type absm gmsm-face)) (declare (type absm gmsm-face))
(with-absm (dgop3 gmsm3) gmsm-face (with-absm (dgop3 gmsm3) gmsm-face
(absm (dgop*dgop dgop2 dgop3) gmsm3)))))))) (absm (dgop*dgop dgop2 dgop3) gmsm3))))))))
#|
()
(require "special-smsts")
(let ((simp (dlop-ext-int '(0 1 2 3 4 5 6))))
(dotimes (i 5)
(dotimes (j 17)
(let ((face (a-face4 (face (delta-infinity))
i (+ 6 (logcount j)) (absm j simp))))
(format t "~%del-~D o ~A (0 1 2 3 4 5 6) = ~A ~A"
i (dgop-int-ext j)
(dgop-int-ext (dgop face))
(dlop-int-ext (gmsm face)))))))
|#
(DEFUN 1DGNR (indx absm) (DEFUN 1DGNR (indx absm)
(declare (declare
@ -531,9 +392,6 @@
(with-absm (dgop gmsm) absm (with-absm (dgop gmsm) absm
(absm (1dgop*dgop indx dgop) gmsm)))) (absm (1dgop*dgop indx dgop) gmsm))))
#|
(1dgnr 2 (absm 17 'a))
|#
(DEFUN NDGNR (dgop absm) (DEFUN NDGNR (dgop absm)
(declare (declare
@ -543,10 +401,6 @@
(with-absm (dgop2 gmsm) absm (with-absm (dgop2 gmsm) absm
(absm (dgop*dgop dgop dgop2) gmsm)))) (absm (dgop*dgop dgop dgop2) gmsm))))
#|
(ndgnr 2 (absm 17 'a))
|#
(DEFUN NFACE (face dlop dmns gmsm) (DEFUN NFACE (face dlop dmns gmsm)
(declare (declare
@ -579,17 +433,6 @@
dgop (dgop*dgop dgop2 dgop3))))) dgop (dgop*dgop dgop2 dgop3)))))
(setf dgop dgop2))))) (setf dgop dgop2)))))
#|
(setf f (face (delta-infinity)))
(dotimes (dlop 31)
(print (dlop-int-ext (gmsm (nface f dlop 4 31)))))
(setf p (r-proj-space))
(setf f (face p))
(dotimes (dlop 31)
(format t "~%~A ~A"
(hyphenize-list (dlop-int-ext dlop))
(nface f dlop 4 4)))
|#
(DEFUN CHECK-FACES (cmpr face dmns gmsm) (DEFUN CHECK-FACES (cmpr face dmns gmsm)
(declare (declare
@ -606,8 +449,10 @@
(declare (fixnum i)) (declare (fixnum i))
(dotimes (j (1+ i)) (dotimes (j (1+ i))
(declare (fixnum j)) (declare (fixnum j))
(let ((rslt1 (a-face4 face i dmns-1 (funcall face j dmns gmsm))) (let ((rslt1 (a-face4 face i dmns-1
(rslt2 (a-face4 face j dmns-1 (funcall face (1+ i) dmns gmsm)))) (funcall face j dmns gmsm)))
(rslt2 (a-face4 face j dmns-1
(funcall face (1+ i) dmns gmsm))))
(declare (type absm rslt1 rslt2)) (declare (type absm rslt1 rslt2))
(unless (eq (a-cmpr3 cmpr rslt1 rslt2) :equal) (unless (eq (a-cmpr3 cmpr rslt1 rslt2) :equal)
(cerror "CHECK-FACES will return NIL." (cerror "CHECK-FACES will return NIL."
@ -619,10 +464,6 @@
(return-from check-faces nil))))))) (return-from check-faces nil)))))))
t))) t)))
#|
(setf d (delta-infinity))
(check-faces #'f-cmpr (face d) 4 31)
|#
(DEFUN CHECK-SMST (smst dmns1 &optional (dmns2 (1+ dmns1))) (DEFUN CHECK-SMST (smst dmns1 &optional (dmns2 (1+ dmns1)))
(declare (declare
@ -646,10 +487,3 @@
(declare (type gmsm gmsm)) (declare (type gmsm gmsm))
(unless (check-faces cmpr face dmns gmsm) (unless (check-faces cmpr face dmns gmsm)
(setf rslt nil)))))) (setf rslt nil))))))
#|
(check-smst (delta-infinity) 5)
(check-smst (delta 3) 2)
(check-smst (delta 3) 2 4)
|#

204
test/simplicial-sets-test.lisp Normal file
View File

@ -0,0 +1,204 @@
(in-package :kenzo-test)
(in-suite :kenzo)
(test dgop-ext-int
(is (= 0 (cat:dgop-ext-int '())))
(signals simple-error (cat:dgop-ext-int '(2 2)))
(is (= 17 (cat:dgop-ext-int '(4 0)))))
(test dgop-int-ext
(is (null (cat:dgop-int-ext 0)))
(is (equal '(2) (cat:dgop-int-ext 4)))
(is (equal '(5 4 3 2 1 0) (cat:dgop-int-ext 63)))
(dotimes (i 33)
(is (= i (cat:dgop-ext-int (cat:dgop-int-ext i))))))
(test hyphenize-list
(is (string= "-" (cat:hyphenize-list '())))
(is (string= "3" (cat:hyphenize-list '(3))))
(is (string= "5-3-1" (cat:hyphenize-list '(5 3 1)))))
(test moore
(let ((m (cat:moore 2 2)))
(dotimes (i 4)
(print (cat:basis m i :dgnr)))))
#|
(test intr-diagonal
(let* ((cmpr #'cat:f-cmpr)
(face #'cat:delta-face)
(diag (cat:intr-diagonal face)))
(funcall diag 4 (cat:mask 5))
(funcall diag 0 4)
(setf cmpr #'cat:s-cmpr face (cat:sphere-face 4))
(setf diag (cat:intr-diagonal face))
(funcall diag 4 's4)
(funcall diag 0 '*)
(setf s4 (cat:sphere 4))
(cat:dgnl s4 4 's4)))
|#
(test face-bndr
(let* ((face #'(lambda (indx dmns gmsm)
(cat:absm 0 (append
(subseq gmsm 0 indx)
(subseq gmsm (1+ indx))))))
(bndr (cat:face-bndr #'cat:l-cmpr face)))
(funcall bndr 0 '(a))
(funcall bndr 1 '(a b))
(funcall bndr 2 '(a b c))
(funcall bndr 3 '(a b c d))
(funcall bndr 3 '(d c b a))
(funcall bndr 1 '(a a))
(funcall bndr 2 '(a a a))
(funcall bndr 3 '(a a a a))
(setf face #'(lambda (index dmns gmsm)
(cat:absm (cat:dgop-ext-int
(nreverse (cat:<a-b< 0 (1- dmns)))) 'a)))
(setf bndr (cat:face-bndr #'cat:s-cmpr face))
(funcall bndr 1 '(a b))
(funcall bndr 2 '(a b c))))
(test face*-bndr
(let* ((face* #'(lambda (indx dmns gmsm)
(if (and (= dmns 3) (evenp indx))
'm2
:degenerate)))
(bndr (cat:face*-bndr #'cat:s-cmpr face*)))
(funcall bndr 3 'm3)
(funcall bndr 2 'm2)
(funcall bndr 0 '*)
(setf face* #'(lambda (indx dmns gmsm)
(if (and (= dmns 3) (< indx 2))
'm2
:degenerate)))
(setf bndr (cat:face*-bndr #'cat:s-cmpr face*))
(funcall bndr 3 'm3)
(funcall bndr 2 'm2)
(funcall bndr 0 '*)))
(test a-cmpr3
(is (equal :less (cat:a-cmpr3 #'cat:s-cmpr
(cat:absm 0 'a)
(cat:absm 1 'b))))
(is (equal :greater (cat:a-cmpr3 #'cat:s-cmpr
(cat:absm 2 'a)
(cat:absm 1 'b))))
(is (equal :less (cat:a-cmpr3 #'cat:s-cmpr
(cat:absm 1 'a)
(cat:absm 1 'b))))
(is (equal :greater (cat:a-cmpr3 #'cat:s-cmpr
(cat:absm 1 'c)
(cat:absm 1 'b))))
(is (equal :equal (cat:a-cmpr3 #'cat:s-cmpr
(cat:absm 1 'a)
(cat:absm 1 'a)))))
(test bspn-p
(let* ((d (cat:delta-infinity))
(cmpr (cat:cmpr d)))
(is (cat:bspn-p cmpr 1 5 (cat:absm (cat:mask 5) 1)))
(is (not (cat:bspn-p cmpr 1 5 (cat:absm (cat:mask 5) 2))))
(is (not (cat:bspn-p cmpr 1 5 (cat:absm (cat:mask 4) 3))))))
(test dlop-ext-int
(is (= 0 (cat:dlop-ext-int '())))
(signals simple-error (cat:dlop-ext-int '(2 2)))
(is (= 17 (cat:dlop-ext-int '(0 4)))))
(test dlop-ext-int
(is (null (cat:dlop-int-ext 0)))
(is (equal '(2) (cat:dlop-int-ext 4)))
(is (equal '(0 1 2 3 4 5) (cat:dlop-int-ext 63)))
(dotimes (i 33)
(is (= i (cat:dlop-ext-int (cat:dlop-int-ext i))))))
(test 1dgop*dgop
(dotimes (i 20)
(dotimes (j 5)
(format t "~% (~D) o ~A = ~A"
j (cat:dgop-int-ext i)
(cat:dgop-int-ext (cat:1dgop*dgop j i))))))
(test dgop*dgop
(dotimes (i 10)
(dotimes (j 10)
(format t "~%~A o ~A = ~A"
(cat:dgop-int-ext i) (cat:dgop-int-ext j)
(cat:dgop-int-ext (cat:dgop*dgop i j))))))
(test remove-bit
(is (= 51 (cat:remove-bit 107 3))))
(test dgop/dgop
(is (= 67 (cat:dgop/dgop 67 0)))
(is (= 32 (cat:dgop/dgop 68 4)))
(is (= 7 (cat:dgop/dgop 31 5))))
(test 1dlop-dgop
(dotimes (i 5)
(dotimes (j 17)
(multiple-value-bind (dgop 1dlop) (cat:1dlop-dgop i j)
(format t "~% del-~D o ~A = ~A o del-~A"
i (cat:dgop-int-ext j) (cat:dgop-int-ext dgop) 1dlop)))))
#|
(test a-face4
(let ((simp (cat:dlop-ext-int '(0 1 2 3 4 5 6))))
(dotimes (i 5)
(dotimes (j 17)
(let ((face (cat:a-face4 (cat:face (cat:delta-infinity))
i (+ 6 (logcount j))
(cat:absm j simp))))
(format t "~%del-~D o ~A (0 1 2 3 4 5 6) = ~A ~A"
i (cat:dgop-int-ext j)
(cat:dgop-int-ext (cat:dgop face))
(cat:dlop-int-ext (cat:gmsm face))))))))
|#
(test 1dgnr
(print (cat:1dgnr 2 (cat:absm 17 'a))))
(test ndgnr
(print (cat:ndgnr 2 (cat:absm 17 'a))))
(test nface
(let ((f (cat:face (cat:delta-infinity)))
p)
(dotimes (dlop 31)
(print (cat:dlop-int-ext (cat:gmsm (cat:nface f dlop 4 31)))))
(setf p (cat:r-proj-space))
(setf f (cat:face p))
(dotimes (dlop 31)
(format t "~%~A ~A"
(cat:hyphenize-list (cat:dlop-int-ext dlop))
(cat:nface f dlop 4 4)))))
(test check-faces
(let ((d (cat:delta-infinity)))
(is (cat:check-faces #'cat:f-cmpr (cat:face d) 4 31))))
(test check-smst
(signals simple-error (cat:check-smst (cat:delta-infinity) 5))
(is (cat:check-smst (cat:delta 3) 2))
(is (cat:check-smst (cat:delta 3) 2 4)))