Extracted simplicial morphism tests.

This commit is contained in:
Gerd Heber 2015-07-13 19:20:30 -05:00
parent 3fb780645b
commit 682b7ad2f8
4 changed files with 119 additions and 91 deletions

View File

@ -27,6 +27,8 @@
(:file "k-pi-n-test")
(:file "kan-test")
(:file "searching-homology-test")
(:file "simplicial-mrphs-test")
(:file "simplicial-sets-test")
(:file "tensor-products-test")
(:file "various-test")))
(:file "various-test")
))

View File

@ -283,6 +283,10 @@
HOMOLOGY
;; simplicial-mrphs.lisp
BUILD-SMMR
;; simplicial-sets.lisp
1DGNR

View File

@ -20,6 +20,7 @@
(otherwise
(funcall (sintr smmr) dmns absm-or-gmsm))))
#+clisp(eval-when (:compile-toplevel :load-toplevel :execute)
(setf (ext:package-lock :clos) nil))
(DEFMETHOD PRINT-OBJECT ((smmr simplicial-mrph) stream)
@ -40,6 +41,7 @@
(the (or null simplicial-mrph)
(find idnm *smmr-list* :key #'idnm)))
(DEFUN SINTR-INTR (sintr)
(declare (type sintr sintr))
(flet ((rslt (dmns gmsm)
@ -55,6 +57,7 @@
(term-cmbn dmns 1 (gmsm rslt))))))
(the intr-mrph #'rslt)))
(DEFUN BUILD-SMMR (&key sorc trgt degr sintr intr strt orgn)
(declare
(type simplicial-set sorc trgt)

View File

@ -0,0 +1,19 @@
(in-package :kenzo-test)
(in-suite :kenzo)
(test build-smmr
(let* ((d (cat:delta 3))
(m (cat:build-smmr
:sorc d :trgt d :degr 0
:sintr #'(lambda (dmns gmsm) (cat:absm 0 gmsm))
:orgn '(identity delta-3)))
(m2 (cat:build-smmr
:sorc d :trgt d :degr 0
:sintr #'(lambda (dmns gmsm) (cat:absm (cat:mask dmns) 1))
:orgn '(null delta-3))))
(cat:? m2 2 7)
;; (s? m2 2 7)
))