Extracted simplicial set tests.
This commit is contained in:
Gerd Heber
parent
e31bbd56f7
commit
c177ef36f4
@ -9,6 +9,7 @@
|
||||
:pathname #P"test/"
|
||||
:components ((:file "package")
|
||||
(:file "common")
|
||||
#|
|
||||
(:file "combinations-test")
|
||||
(:file "various-test")
|
||||
(:file "chain-complexes-test")
|
||||
@ -27,4 +28,6 @@
|
||||
;;(:file "cl-space-efhm-test")
|
||||
(:file "tensor-products-test")
|
||||
(:file "k-pi-n-test")
|
||||
|#
|
||||
(:file "simplicial-sets-test")
|
||||
))
|
||||
|
||||
24
package.lisp
24
package.lisp
@ -107,6 +107,7 @@
|
||||
CMBN-DEGR
|
||||
CMBN-LIST
|
||||
DEGR
|
||||
DGOP
|
||||
DFFR1
|
||||
EFHM
|
||||
F
|
||||
@ -272,9 +273,27 @@
|
||||
|
||||
;; simplicial-sets.lisp
|
||||
|
||||
1DGNR
|
||||
1DGOP*DGOP
|
||||
1DLOP-DGOP
|
||||
A-CMPR3
|
||||
A-FACE4
|
||||
BSPN-P
|
||||
CHECK-FACES
|
||||
CHECK-SMST
|
||||
DGOP*DGOP
|
||||
DGOP/DGOP
|
||||
DGOP-EXT-INT
|
||||
DGOP-INT-EXT
|
||||
DLOP-EXT-INT
|
||||
DLOP-INT-EXT
|
||||
FACE-BNDR
|
||||
FACE*-BNDR
|
||||
HYPHENIZE-LIST
|
||||
INTR-DIAGONAL
|
||||
NDGNR
|
||||
NFACE
|
||||
REMOVE-BIT
|
||||
|
||||
;; smith.lisp
|
||||
|
||||
@ -282,8 +301,11 @@
|
||||
|
||||
;; special-smsts.lisp
|
||||
|
||||
SPHERE
|
||||
BUILD-FINITE-SS
|
||||
MOORE
|
||||
R-PROJ-SPACE
|
||||
SPHERE
|
||||
SPHERE-FACE
|
||||
|
||||
;; tensor-products.lisp
|
||||
|
||||
|
||||
@ -17,6 +17,7 @@
|
||||
:BNDR "BouNDaRy"
|
||||
:BRGN "BaR-GeNerator"
|
||||
:BSGN "BaSe GeNerator"
|
||||
:BSPN "BaSe-PoiNt"
|
||||
|
||||
;; C
|
||||
:CBGN "CoBar-GeNerator"
|
||||
|
||||
@ -20,11 +20,6 @@
|
||||
(the fixnum (2-exp item)))
|
||||
ext-dgop))))
|
||||
|
||||
#|
|
||||
(dgop-ext-int '())
|
||||
(dgop-ext-int '(2 2))
|
||||
(dgop-ext-int '(4 0))
|
||||
|#
|
||||
|
||||
(DEFUN DGOP-INT-EXT (dgop)
|
||||
(declare (fixnum dgop))
|
||||
@ -41,13 +36,6 @@
|
||||
(when (oddp dgop)
|
||||
(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)
|
||||
(declare (list list))
|
||||
@ -55,11 +43,6 @@
|
||||
(format nil "~D~{-~D~}" (first list) (rest list))
|
||||
(format nil "-")))
|
||||
|
||||
#|
|
||||
(hyphenize-list '())
|
||||
(hyphenize-list '(3))
|
||||
(hyphenize-list '(5 3 1)))
|
||||
|#
|
||||
|
||||
(DEFUN ABSM-PRINT (absm stream depth)
|
||||
(declare
|
||||
@ -72,11 +55,13 @@
|
||||
(gmsm absm))
|
||||
absm)
|
||||
|
||||
|
||||
(DEFUN FACE4 (smst indx dmns gmsm-or-absm)
|
||||
(if (typep gmsm-or-absm 'absm)
|
||||
(a-face4 (face1 smst) indx dmns gmsm-or-absm)
|
||||
(funcall (face1 smst) indx dmns gmsm-or-absm)))
|
||||
|
||||
|
||||
#+clisp(eval-when (:compile-toplevel :load-toplevel :execute)
|
||||
(setf (ext:package-lock :clos) nil))
|
||||
(DEFMETHOD PRINT-OBJECT ((smst simplicial-set) stream)
|
||||
@ -93,6 +78,7 @@
|
||||
(the (or simplicial-set null)
|
||||
(find n *smst-list* :key #'idnm)))
|
||||
|
||||
|
||||
(DEFUN BUILD-SMST
|
||||
(&key cmpr basis bspn face face* intr-bndr bndr-strt
|
||||
intr-dgnl dgnl-strt orgn)
|
||||
@ -136,6 +122,7 @@
|
||||
(push rslt *smst-list*)
|
||||
rslt)))
|
||||
|
||||
|
||||
(DEFUN A-BASIS2 (basis dmns)
|
||||
(declare
|
||||
(type basis basis)
|
||||
@ -156,11 +143,6 @@
|
||||
rslt)))
|
||||
((minusp dgop) rslt)))))
|
||||
|
||||
#|
|
||||
(setf m (moore 2 2))
|
||||
(dotimes (i 4)
|
||||
(print (basis m i :dgnr)))
|
||||
|#
|
||||
|
||||
(DEFUN INTR-DIAGONAL (face)
|
||||
(declare (type face face))
|
||||
@ -196,21 +178,6 @@
|
||||
(make-cmbn :degr dmns :list 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)
|
||||
(declare
|
||||
@ -237,26 +204,6 @@
|
||||
(apply #'nterm-add cmpr (1- dmns) pre-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*)
|
||||
(declare
|
||||
@ -282,26 +229,6 @@
|
||||
(apply #'nterm-add cmpr (1- dmns) pre-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)
|
||||
(declare
|
||||
@ -314,13 +241,6 @@
|
||||
(f-cmpr dgop1 dgop2)
|
||||
(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)
|
||||
;; this function makes sense only in the simplicial context
|
||||
@ -334,13 +254,6 @@
|
||||
(and (= dgop (mask dmns))
|
||||
(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)
|
||||
(declare (list ext-dlop))
|
||||
@ -354,24 +267,13 @@
|
||||
(declare (fixnum item))
|
||||
(the fixnum (2-exp item)))
|
||||
ext-dlop))))
|
||||
#|
|
||||
(dlop-ext-int '())
|
||||
(dlop-ext-int '(2 2))
|
||||
(dlop-ext-int '(0 4)))
|
||||
|#
|
||||
|
||||
|
||||
(DEFUN DLOP-INT-EXT (dlop)
|
||||
(declare (fixnum dlop))
|
||||
(the list
|
||||
(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)
|
||||
(declare (fixnum 1dgop dgop))
|
||||
@ -385,12 +287,6 @@
|
||||
(2-exp 1dgop)
|
||||
(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)
|
||||
(declare (type fixnum dgop1 dgop2))
|
||||
@ -413,13 +309,6 @@
|
||||
(setf dgop1 (ash dgop1 -1))
|
||||
(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)
|
||||
(declare (fixnum n indx))
|
||||
@ -429,9 +318,6 @@
|
||||
(declare (fixnum quotient remainder))
|
||||
(+ (ash (ash quotient -1) indx) remainder)))))
|
||||
|
||||
#|
|
||||
(remove-bit 107 3) ;; 51
|
||||
|#
|
||||
|
||||
(DEFUN DGOP/DGOP (dgop1 dgop2)
|
||||
(declare (fixnum dgop1 dgop2))
|
||||
@ -442,11 +328,6 @@
|
||||
(when (logbitp indx dgop2)
|
||||
(setf dgop1 (remove-bit dgop1 indx))))))
|
||||
|
||||
#|
|
||||
(dgop/dgop 67 0)
|
||||
(dgop/dgop 68 4)
|
||||
(dgop/dgop 31 5)
|
||||
|#
|
||||
|
||||
(DEFUN 1DLOP-DGOP (1dlop dgop)
|
||||
(declare (fixnum 1dlop dgop))
|
||||
@ -482,14 +363,6 @@
|
||||
(logxor right (logand share (ash dgop -1)))
|
||||
(- 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)
|
||||
(declare
|
||||
@ -509,19 +382,7 @@
|
||||
(declare (type absm gmsm-face))
|
||||
(with-absm (dgop3 gmsm3) gmsm-face
|
||||
(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)
|
||||
(declare
|
||||
@ -531,9 +392,6 @@
|
||||
(with-absm (dgop gmsm) absm
|
||||
(absm (1dgop*dgop indx dgop) gmsm))))
|
||||
|
||||
#|
|
||||
(1dgnr 2 (absm 17 'a))
|
||||
|#
|
||||
|
||||
(DEFUN NDGNR (dgop absm)
|
||||
(declare
|
||||
@ -543,10 +401,6 @@
|
||||
(with-absm (dgop2 gmsm) absm
|
||||
(absm (dgop*dgop dgop dgop2) gmsm))))
|
||||
|
||||
#|
|
||||
(ndgnr 2 (absm 17 'a))
|
||||
|#
|
||||
|
||||
|
||||
(DEFUN NFACE (face dlop dmns gmsm)
|
||||
(declare
|
||||
@ -579,17 +433,6 @@
|
||||
dgop (dgop*dgop dgop2 dgop3)))))
|
||||
(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)
|
||||
(declare
|
||||
@ -606,8 +449,10 @@
|
||||
(declare (fixnum i))
|
||||
(dotimes (j (1+ i))
|
||||
(declare (fixnum j))
|
||||
(let ((rslt1 (a-face4 face i dmns-1 (funcall face j dmns gmsm)))
|
||||
(rslt2 (a-face4 face j dmns-1 (funcall face (1+ i) dmns gmsm))))
|
||||
(let ((rslt1 (a-face4 face i dmns-1
|
||||
(funcall face j dmns gmsm)))
|
||||
(rslt2 (a-face4 face j dmns-1
|
||||
(funcall face (1+ i) dmns gmsm))))
|
||||
(declare (type absm rslt1 rslt2))
|
||||
(unless (eq (a-cmpr3 cmpr rslt1 rslt2) :equal)
|
||||
(cerror "CHECK-FACES will return NIL."
|
||||
@ -619,10 +464,6 @@
|
||||
(return-from check-faces nil)))))))
|
||||
t)))
|
||||
|
||||
#|
|
||||
(setf d (delta-infinity))
|
||||
(check-faces #'f-cmpr (face d) 4 31)
|
||||
|#
|
||||
|
||||
(DEFUN CHECK-SMST (smst dmns1 &optional (dmns2 (1+ dmns1)))
|
||||
(declare
|
||||
@ -646,10 +487,3 @@
|
||||
(declare (type gmsm gmsm))
|
||||
(unless (check-faces cmpr face dmns gmsm)
|
||||
(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
204
test/simplicial-sets-test.lisp
Normal 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)))
|
||||
Loading…
Reference in New Issue
Block a user