From 6a9a2f60b954a5a13be8b8cff672cdd8a7138609 Mon Sep 17 00:00:00 2001 From: Gerd Heber Date: Thu, 9 Jul 2015 19:54:03 -0500 Subject: [PATCH] Extracted cones tests. --- kenzo-test.asd | 3 +- package.lisp | 20 ++++++++ src/cones.lisp | 120 +++---------------------------------------- test/cones-test.lisp | 111 +++++++++++++++++++++++++++++++++++++++ 4 files changed, 140 insertions(+), 114 deletions(-) create mode 100644 test/cones-test.lisp diff --git a/kenzo-test.asd b/kenzo-test.asd index e93c27b..65fa90e 100644 --- a/kenzo-test.asd +++ b/kenzo-test.asd @@ -22,4 +22,5 @@ (:file "searching-homology-test") (:file "delta-test") (:file "bar-test") - (:file "cartesian-products-test"))) + (:file "cartesian-products-test") + (:file "cones-test"))) diff --git a/package.lisp b/package.lisp index e793ac7..fb815e9 100644 --- a/package.lisp +++ b/package.lisp @@ -135,6 +135,24 @@ ZERO-CMBN ZERO-INTR-DFFR + ;; cones.lisp + + CMBN-CON0 + CMBN-CON1 + CONE + CONE-2CMBN-APPEND + CONE-2MRPH-DIAG + CONE-2MRPH-DIAG-IMPL + CONE-3MRPH-TRIANGLE + CONE-3MRPH-TRIANGLE-IMPL + CONE-BASIS + CONE-CMBN-SPLIT + CONE-CMPR + TERM-CON0 + TERM-CON1 + TERM-UNCON + + ;; delta.lisp DELTA @@ -199,6 +217,8 @@ CMBN-NON-ZERO-P CMBN-ZERO-P CMPR + CON0 + CON1 CPRD CRPR D diff --git a/src/cones.lisp b/src/cones.lisp index b80ad58..e36a334 100644 --- a/src/cones.lisp +++ b/src/cones.lisp @@ -23,16 +23,6 @@ (setf mark icon))) cone))) -#| -() -(con0 'a) -(con1 'a) -(con0 (con0 'a)) -(con0 (con1 'a)) -(con1 (con0 'a)) -(con1 (con1 'a)) -(con0 (con1 (con0 (con1 'a)))) -|# (DEFUN CONE-CMPR (cmpr0 cmpr1) (declare (type cmprf cmpr0 cmpr1)) @@ -57,18 +47,6 @@ (declare (ftype (function (cone cone) cmpr) rslt)) #'rslt))) -#| -() -(setf cmpr (cone-cmpr #'s-cmpr #'f-cmpr)) -(funcall cmpr (con0 'a) (con0 'b)) -(funcall cmpr (con0 'b) (con0 'b)) -(funcall cmpr (con0 'b) (con0 'a)) -(funcall cmpr (con0 'b) (con1 '2)) -(funcall cmpr (con1 '2) (con0 'b)) -(funcall cmpr (con1 '1) (con1 '2)) -(funcall cmpr (con1 '2) (con1 '2)) -(funcall cmpr (con1 '2) (con1 '1)) -|# (DEFUN CONE-BASIS (basis0 basis1) (declare (type basis basis0 basis1)) @@ -88,35 +66,26 @@ (declare (ftype (function (fixnum) list) rslt)) #'rslt)))) -#| -() -(setf basis (cone-basis - #'(lambda (n) (list n)) - #'(lambda (n) (list n)))) -(funcall basis 4) -|# (DEFUN TERM-CON0 (term) (declare (type term term)) (the term (term (cffc term) (con0 (gnrt term))))) + + (DEFUN TERM-CON1 (term) (declare (type term term)) (the term (term (cffc term) (con1 (gnrt term))))) + + (DEFUN TERM-UNCON (term) (declare (type term term)) (the term (term (cffc term) (icon (gnrt term))))) -#| -() -(term-con0 (term 2 'a)) -(term-con1 (term 2 'a)) -(term-uncon (term 2 (con0 'a))) -|# (DEFUN CMBN-CON0 (cmbn) (declare (type cmbn cmbn)) @@ -125,6 +94,7 @@ :degr (cmbn-degr cmbn) :list (mapcar #'term-con0 (cmbn-list cmbn))))) + (DEFUN CMBN-CON1 (cmbn) (declare (type cmbn cmbn)) (the cmbn @@ -132,11 +102,6 @@ :degr (cmbn-degr cmbn) :list (mapcar #'term-con1 (cmbn-list cmbn))))) -#| -() -(cmbn-con0 (cmbn 3 1 'a 2 'b)) -(cmbn-con1 (cmbn 3 1 'a 2 'b)) -|# (DEFUN CONE-CMBN-SPLIT (cmbn) (declare (type cmbn cmbn)) @@ -158,13 +123,6 @@ (values (make-cmbn :degr degr :list list0) (make-cmbn :degr (1- degr) :list list1)))))) -#| -() -(cone-cmbn-split - (cmbn 3 4 (con0 'a) 5 (con1 'b))) -(cone-cmbn-split (cmbn 3 4 (con0 'a))) -(cone-cmbn-split (cmbn 3 4 (con1 'a))) -|# (DEFUN CONE-2CMBN-APPEND (cmbn0 cmbn1) (declare (type cmbn cmbn0 cmbn1)) @@ -174,11 +132,7 @@ :list (append (mapcar #'term-con0 (cmbn-list cmbn0)) (mapcar #'term-con1 (cmbn-list cmbn1)))))) -#| -() -(cone-2cmbn-append (cmbn 3 4 'a) (cmbn 2 5 'b)) -|# - + (DEFUN CONE-2MRPH-DIAG-IMPL (mrph0 mrph1) (declare (type morphism mrph0 mrph1)) (the intr-mrph @@ -192,13 +146,7 @@ (? mrph1 cmbn1)))))) #'rslt))) -#| -() -(setf mrph (dffr (delta 4))) -(setf rslt (cone-2mrph-diag-impl mrph mrph)) -(funcall rslt (cmbn 3 4 (con0 15) 5 (con1 7))) -|# - + (DEFUN CONE-3MRPH-TRIANGLE-IMPL (cmpr0 mrph0 mrph1 phi) (declare (ignore cmpr0) (type morphism mrph0 mrph1 phi)) (the intr-mrph @@ -215,17 +163,6 @@ (? mrph1 (1- degr) gnrt)))))))) #'rslt))) -#| -() -(setf rslt (cone-3mrph-triangle-impl #'f-cmpr - (dffr (delta 4)) - (dffr (delta 4)) - (idnt-mrph (delta 4)))) -(funcall rslt 4 (con0 '31)) -(funcall rslt 5 (con1 '31)) -(funcall rslt 4 (con1 '15)) -; (funcall rslt (cmbn 4 1 (con0 '31) 1 (con1 '15))) ; -|# (DEFUN CONE (mrph) (declare (type morphism mrph)) @@ -244,25 +181,6 @@ :strt :gnrt :orgn `(cone ,mrph))))) -#| -() -(cat-init) -(setf k (k-z 1)) -(setf u (idnt-mrph k)) -(setf c (cone u)) -(setf *tc* (cmbn 4 1 (con0 '(1 2 3 4)))) -(? c 4 (con0 '(1 2 3 4))) -(? c *tc*) -|# - - -#| -() -(setf cone (cone (idnt-mrph (delta 4)))) -(? cone (cmbn 4 1 (con0 '31) -1 (con1 '15))) -(? cone *) -|# - (DEFUN CONE-2MRPH-DIAG (sorc-cone trgt-cone mrph0 mrph1) (declare @@ -280,13 +198,6 @@ :strt :cmbn :orgn `(cone-2mrph-diag ,sorc-cone ,trgt-cone ,mrph0 ,mrph1))))) -#| -() -(setf idnt (idnt-mrph (delta 4))) -(setf cone (cone idnt)) -(setf ff (cone-2mrph-diag cone cone idnt idnt)) -(? ff (cmbn 4 1 (con0 '31) 10 (con1 '15))) -|# (DEFUN CONE-3MRPH-TRIANGLE (sorc-cone trgt-cone mrph0 mrph1 phi) (declare @@ -309,23 +220,6 @@ :orgn `(cone-3mrph-triangle ,sorc-cone ,trgt-cone ,mrph0 ,mrph1 ,phi))))) -#| -() -(cat-init) -(setf d (delta 4)) -(setf df (dffr (delta 4))) -(setf n (idnt-mrph d)) -(setf c (cone n)) -(setf z (sbtr (dffr c) - (cone-3mrph-triangle c c df (n-mrph -1 df) n))) -(? z 0 (con0 '1)) -(? z 1 (con1 '1)) -(? z 1 (con0 '3)) -(? z 2 (con1 '3)) -(? z 4 (con0 '31)) -(? z 5 (con1 '31)) -|# - (DEFUN CONE-EFHM (cone) (declare (type chain-complex cone)) diff --git a/test/cones-test.lisp b/test/cones-test.lisp new file mode 100644 index 0000000..bd039eb --- /dev/null +++ b/test/cones-test.lisp @@ -0,0 +1,111 @@ + +(in-package :kenzo-test) + +(in-suite :kenzo) + +(test con-test + (cat:con0 'a) + (cat:con1 'a) + (cat:con0 (cat:con0 'a)) + (cat:con0 (cat:con1 'a)) + (cat:con1 (cat:con0 'a)) + (cat:con1 (cat:con1 'a)) + (cat:con0 (cat:con1 (cat:con0 (cat:con1 'a))))) + + +(test cone-cmpr + (let ((cmpr (cat:cone-cmpr #'cat:s-cmpr #'cat:f-cmpr))) + (is (equal :less (funcall cmpr (cat:con0 'a) (cat:con0 'b)))) + (is (equal :equal (funcall cmpr (cat:con0 'b) (cat:con0 'b)))) + (is (equal :greater (funcall cmpr (cat:con0 'b) (cat:con0 'a)))) + (is (equal :less (funcall cmpr (cat:con0 'b) (cat:con1 '2)))) + (is (equal :greater (funcall cmpr (cat:con1 '2) (cat:con0 'b)))) + (is (equal :less (funcall cmpr (cat:con1 '1) (cat:con1 '2)))) + (is (equal :equal (funcall cmpr (cat:con1 '2) (cat:con1 '2)))) + (is (equal :greater (funcall cmpr (cat:con1 '2) (cat:con1 '1)))))) + + +(test cone-basis + (let ((basis (cat:cone-basis #'(lambda (n) (list n)) + #'(lambda (n) (list n))))) + (funcall basis 4))) + + +(test term-con + (cat:term-con0 (cat:term 2 'a)) + (cat:term-con1 (cat:term 2 'a)) + (cat:term-uncon (cat:term 2 (cat:con0 'a)))) + + +(test cmbn-con + (cat:cmbn-con0 (cat:cmbn 3 1 'a 2 'b)) + (cat:cmbn-con1 (cat:cmbn 3 1 'a 2 'b))) + + +(test cone-cmbn-split + (cat:cone-cmbn-split (cat:cmbn 3 4 (cat:con0 'a) 5 (cat:con1 'b))) + (cat:cone-cmbn-split (cat:cmbn 3 4 (cat:con0 'a))) + (cat:cone-cmbn-split (cat:cmbn 3 4 (cat:con1 'a)))) + + +(test cone-2cmbn-append + (cat:cone-2cmbn-append (cat:cmbn 3 4 'a) (cat:cmbn 2 5 'b))) + + +(test cone-2mrph-diag-impl + (let* ((mrph (cat:dffr (cat:delta 4))) + (rslt (cat:cone-2mrph-diag-impl mrph mrph))) + (funcall rslt (cat:cmbn 3 4 (cat:con0 15) 5 (cat:con1 7))))) + + +(test cone-3mrph-triangle-impl + (let ((rslt (cat:cone-3mrph-triangle-impl #'cat:f-cmpr + (cat:dffr (cat:delta 4)) + (cat:dffr (cat:delta 4)) + (cat:idnt-mrph (cat:delta 4))))) + (funcall rslt 4 (cat:con0 '31)) + (funcall rslt 5 (cat:con1 '31)) + (funcall rslt 4 (cat:con1 '15)))) + + +(test cone + (progn + (cat:cat-init) + (let* ((k (cat:k-z 1)) + (u (cat:idnt-mrph k)) + (c (cat:cone u)) + (cone)) + (setf cat:*tc* (cat:cmbn 4 1 (cat:con0 '(1 2 3 4)))) + (cat:? c 4 (cat:con0 '(1 2 3 4))) + (cat:? c cat:*tc*) + + (setf cone (cat:cone (cat:idnt-mrph (cat:delta 4)))) + (cat:? cone (cat:cmbn 4 1 (cat:con0 '31) -1 (cat:con1 '15))) + (cat:? cone + (cat:? cone (cat:cmbn 4 + 1 (cat:con0 '31) -1 (cat:con1 '15))))))) + + +(test cone-2mrph-diag + (let* ((idnt (cat:idnt-mrph (cat:delta 4))) + (cone (cat:cone idnt)) + (ff (cat:cone-2mrph-diag cone cone idnt idnt))) + (cat:? ff (cat:cmbn 4 1 (cat:con0 '31) 10 (cat:con1 '15))))) + + +(test cone-3mrph-triangle + (progn + (cat:cat-init) + (let* ((d (cat:delta 4)) + (df (cat:dffr (cat:delta 4))) + (n (cat:idnt-mrph d)) + (c (cat:cone n)) + (z (cat:sbtr (cat:dffr c) + (cat:cone-3mrph-triangle c c df + (cat:n-mrph -1 df) n)))) + (cat:? z 0 (cat:con0 '1)) + (cat:? z 1 (cat:con1 '1)) + (cat:? z 1 (cat:con0 '3)) + (cat:? z 2 (cat:con1 '3)) + (cat:? z 4 (cat:con0 '31)) + (cat:? z 5 (cat:con1 '31)))))