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

Extracted simplicial morphism tests.

Browse Source
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
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

4
kenzo-test.asd
View File

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

4
package.lisp
View File

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

11
src/simplicial-mrphs.lisp
View File

@ -20,6 +20,7 @@
(otherwise (otherwise
(funcall (sintr smmr) dmns absm-or-gmsm)))) (funcall (sintr smmr) dmns absm-or-gmsm))))
#+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 ((smmr simplicial-mrph) stream) (DEFMETHOD PRINT-OBJECT ((smmr simplicial-mrph) stream)
@ -40,6 +41,7 @@
(the (or null simplicial-mrph) (the (or null simplicial-mrph)
(find idnm *smmr-list* :key #'idnm))) (find idnm *smmr-list* :key #'idnm)))
(DEFUN SINTR-INTR (sintr) (DEFUN SINTR-INTR (sintr)
(declare (type sintr sintr)) (declare (type sintr sintr))
(flet ((rslt (dmns gmsm) (flet ((rslt (dmns gmsm)
@ -55,6 +57,7 @@
(term-cmbn dmns 1 (gmsm rslt)))))) (term-cmbn dmns 1 (gmsm rslt))))))
(the intr-mrph #'rslt))) (the intr-mrph #'rslt)))
(DEFUN BUILD-SMMR (&key sorc trgt degr sintr intr strt orgn) (DEFUN BUILD-SMMR (&key sorc trgt degr sintr intr strt orgn)
(declare (declare
(type simplicial-set sorc trgt) (type simplicial-set sorc trgt)
@ -87,18 +90,18 @@
rslt)))) rslt))))
#| #|
(setf d (delta 3)) (setf d (delta 3))
(setf m (build-smmr (setf m (build-smmr
:sorc d :trgt d :degr 0 :sorc d :trgt d :degr 0
:sintr #'(lambda (dmns gmsm) :sintr #'(lambda (dmns gmsm)
(absm 0 gmsm)) (absm 0 gmsm))
:orgn '(identity delta-3))) :orgn '(identity delta-3)))
(setf m2 (build-smmr (setf m2 (build-smmr
:sorc d :trgt d :degr 0 :sorc d :trgt d :degr 0
:sintr #'(lambda (dmns gmsm) :sintr #'(lambda (dmns gmsm)
(absm (mask dmns) 1)) (absm (mask dmns) 1))
:orgn '(null delta-3))) :orgn '(null delta-3)))
(? m2 2 7) (? m2 2 7)
;; (s? m2 2 7) ;; (s? m2 2 7)
|# |#

19
test/simplicial-mrphs-test.lisp Normal file
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)
))