From 0351445e4933738101f57f4950b14ccc7cdc81e7 Mon Sep 17 00:00:00 2001 From: gheber Date: Fri, 26 Dec 2014 18:10:33 -0600 Subject: [PATCH] Added chcm-elementary-op tests. --- kenzo-test.asd | 1 + package.lisp | 33 ++++++ src/chcm-elementary-op.lisp | 155 +------------------------ test/chcm-elementary-op-test.lisp | 187 ++++++++++++++++++++++++++++++ 4 files changed, 222 insertions(+), 154 deletions(-) create mode 100644 test/chcm-elementary-op-test.lisp diff --git a/kenzo-test.asd b/kenzo-test.asd index 4976755..d4bb497 100644 --- a/kenzo-test.asd +++ b/kenzo-test.asd @@ -9,5 +9,6 @@ (:file "combinations-test") (:file "various-test") (:file "chain-complexes-test") + (:file "chcm-elementary-op-test") (:file "diabolo") (:file "circle"))) diff --git a/package.lisp b/package.lisp index f316a8f..eb7a166 100644 --- a/package.lisp +++ b/package.lisp @@ -17,6 +17,15 @@ ;; chcm-elementary-op.lisp + ADD + CMPS + IDNT-MRPH + N-MRPH + OPPS + SBTR + Z-CHCM + ZERO-MRPH + ;; classes.lisp CHAIN-COMPLEX @@ -44,6 +53,14 @@ ZERO-CMBN ZERO-INTR-DFFR + ;; fibrations.lisp + + FIBRATION-TOTAL + + ;; k-pi-n.lisp + + K-Z + ;; macros.lisp BASIS @@ -57,6 +74,18 @@ TERM TERM-CMBN + ;; searching-homology.lisp + + HOMOLOGY + + ;; smith.lisp + + CHML-CLSS + + ;; special-smsts.lisp + + SPHERE + ;; various.lisp +EMPTY-LIST+ @@ -70,5 +99,9 @@ SRANDOM V + ;; whitehead.lisp + + Z-WHITEHEAD + )) diff --git a/src/chcm-elementary-op.lisp b/src/chcm-elementary-op.lisp index 5322fa5..72c0f41 100644 --- a/src/chcm-elementary-op.lisp +++ b/src/chcm-elementary-op.lisp @@ -35,19 +35,6 @@ :strt :cmbn :orgn `(zero-mrph ,chcm1 ,chcm2 ,degr)))) -#| - (cat-init) - (setf z (zero-mrph (Z-chcm) (Z-chcm) 2)) - (gnrt-? z 0 :z-gnrt) - (cmbn-? z (cmbn 3)) - (setf z2 (zero-mrph (Z-chcm) (Z-chcm) 2)) - (eq z z2) - (setf z3 (zero-mrph (Z-chcm) (Z-chcm) 3)) - (gnrt-? z3 0 :z-gnrt) - (eq z z3)) -|# - - (DEFUN IDNT-MRPH (chcm) (declare (type chain-complex chcm)) @@ -58,12 +45,6 @@ :strt :cmbn :orgn `(idnt-mrph ,chcm)))) -#| - (setf zi (idnt-mrph (Z-chcm))) - (gnrt-? zi 0 :z-gnrt) - (setf zi2 (idnt-mrph (Z-chcm))) - (eq zi zi2)) -|# (DEFUN OPPS (mrph) (declare (type morphism mrph)) @@ -77,13 +58,6 @@ :strt :cmbn :orgn `(opps ,mrph))))) -#| - (cat-init) - (setf -zi (opps (idnt-mrph (Z-chcm)))) - (gnrt-? -zi 0 :z-gnrt) - (setf -zi2 (opps (idnt-mrph (Z-chcm)))) - (eq -zi -zi2)) -|# (DEFMETHOD CMPS ((chcm1 chain-complex) (chcm2 chain-complex) &optional strt) (declare (type (or strt null) strt)) @@ -146,45 +120,7 @@ (the cmbn (cmbn-? mrph1 (gnrt-? mrph2 degr gnrt)))) :strt :gnrt :orgn `(2mrph-cmps ,mrph1 ,mrph2 ,strt)))))))) - -#| - (cat-init) - (setf cc (build-chcm :cmpr #'f-cmpr - :basis :locally-effective - :bsgn 0 - :intr-dffr #'(lambda (cmbn) - (cmbn (1- (cmbn-degr cmbn)))) - :strt :cmbn - :orgn '(Z of Z))) - (setf *n* 5) - (defun ff (degr i) - (do ((*2n* (ash *n* 1)) - (rslt +empty-list+ - (cons (cons (let ((cffc (- (random *2n*) *n*))) - (if (minusp cffc) cffc (1+ cffc))) - (decf gnrt (1+ (random *n*)))) - rslt)) - (gnrt i) - (k 0 (1+ k))) - ((= k *n*) - (make-cmbn - :degr 0 - :list rslt)))) - (setf mrph (build-mrph :sorc cc :trgt cc :degr 0 - :intr #'ff :strt :gnrt :orgn '(test))) - (setf mrph2 (2mrph-cmps mrph mrph :gnrt)) - (gnrt-? mrph2 0 0) - (dotimes (i 5) - (print (gnrt-? mrph2 0 i))) - (setf mrph (build-mrph :sorc cc :trgt cc :degr 0 - :intr #'ff :strt :gnrt :orgn '(test))) - (setf mrph3 (cmps mrph mrph :cmbn)) - (gnrt-? mrph3 0 0) - (dotimes (i 5) - (print (gnrt-? mrph3 0 i))) - (setf mrph33 (cmps mrph mrph :cmbn)) - (eq mrph3 mrph33)) -|# + (DEFUN N-MRPH-INTR (n mrph) (declare @@ -209,20 +145,6 @@ :intr (n-mrph-intr n mrph) :strt :cmbn :orgn `(n-mrph ,n ,mrph))))) -#| - (setf s3 (sphere 3)) - (setf ch3 (chml-clss s3 3)) - (setf 2ch3 (n-mrph 2 ch3)) - (setf f3 (z-whitehead s3 2ch3)) - (setf x (fibration-total f3)) - (homology x 0 10) - (setf k (k-z 3)) - (setf ch3 (chml-clss k 3)) - (setf 2ch3 (n-mrph 2 ch3)) - (setf f3 (z-whitehead k 2ch3)) - (setf x (fibration-total f3)) - (homology x 0 10) -|# (DEFMETHOD ADD ((mrph1 morphism) (mrph2 morphism) &optional strt) (declare (type (or null strt) strt)) @@ -276,43 +198,6 @@ :strt :cmbn :orgn `(2mrph-add ,mrph1 ,mrph2 ,strt))))))))) -#| - (cat-init) - (setf cc (build-chcm :cmpr #'f-cmpr - :basis :locally-effective - :bsgn 0 - :intr-dffr #'(lambda (cmbn) - (cmbn (1- (cmbn-degr cmbn)))) - :strt :cmbn - :orgn '(Z of Z))) - (setf *n* 10) - (defun ff (degr i) - (do ((*2n* (ash *n* 1)) - (rslt +empty-list+ - (cons (cons (let ((cffc (- (random *2n*) *n*))) - (if (minusp cffc) cffc (1+ cffc))) - (decf gnrt (1+ (random *n*)))) - rslt)) - (gnrt i) - (k 0 (1+ k))) - ((= k *n*) - (make-cmbn - :degr 0 - :list rslt)))) - (setf mrph1 (build-mrph :sorc cc :trgt cc :degr 0 - :intr #'ff :strt :gnrt :orgn '(test))) - (setf mrph2 (build-mrph :sorc cc :trgt cc :degr 0 - :intr #'ff :strt :gnrt :orgn '(test2))) - (setf mrph3 (add mrph1 mrph2 :gnrt)) - (setf +too-much-time+ -1) - (gnrt-? mrph1 0 0) - (gnrt-? mrph2 0 0) - (gnrt-? mrph3 0 0) - (setf mrph4 (add mrph1 mrph2 :cmbn)) - (gnrt-? mrph4 0 0) - (setf mrph44 (add mrph1 mrph2 :cmbn)) - (eq mrph4 mrph44)) -|# (DEFMETHOD SBTR ((mrph1 morphism) (mrph2 morphism) &optional strt) (declare (type (or null strt) strt)) @@ -366,44 +251,6 @@ :strt :cmbn :orgn `(2mrph-sbtr ,mrph1 ,mrph2 ,strt))))))))) -#| -() -(cat-init) -(setf cc (build-chcm :cmpr #'f-cmpr - :basis :locally-effective - :bsgn 0 - :intr-dffr #'(lambda (cmbn) - (cmbn (1- (cmbn-degr cmbn)))) - :strt :cmbn - :orgn '(Z of Z))) -(setf *n* 10) -(defun ff (degr i) - (do ((*2n* (ash *n* 1)) - (rslt +empty-list+ - (cons (cons (let ((cffc (- (random *2n*) *n*))) - (if (minusp cffc) cffc (1+ cffc))) - (decf gnrt (1+ (random *n*)))) - rslt)) - (gnrt i) - (k 0 (1+ k))) - ((= k *n*) - (make-cmbn - :degr 0 - :list rslt)))) -(setf mrph1 (build-mrph :sorc cc :trgt cc :degr 0 - :intr #'ff :strt :gnrt :orgn '(test))) -(setf mrph2 (build-mrph :sorc cc :trgt cc :degr 0 - :intr #'ff :strt :gnrt :orgn '(test2))) -(setf mrph3 (sbtr mrph1 mrph2 :gnrt)) -(setf +too-much-time+ -1) -(gnrt-? mrph1 0 0) -(gnrt-? mrph2 0 0) -(gnrt-? mrph3 0 0) -(setf mrph4 (sbtr mrph1 mrph2 :cmbn)) -(gnrt-? mrph4 0 0) -(setf mrph44 (sbtr mrph1 mrph2 :cmbn)) -(eq mrph4 mrph44)) -|# (DEFUN CHANGE-SORC-TRGT (mrph &key new-sorc new-trgt) (declare diff --git a/test/chcm-elementary-op-test.lisp b/test/chcm-elementary-op-test.lisp new file mode 100644 index 0000000..04bdda0 --- /dev/null +++ b/test/chcm-elementary-op-test.lisp @@ -0,0 +1,187 @@ + +(in-package :kenzo-test) + +(in-suite :kenzo) + +(test zero-mrph + (progn + (cat:cat-init) + (let* ((z (cat:zero-mrph (cat:Z-chcm) (cat:Z-chcm) 2)) + (z2 (cat:zero-mrph (cat:Z-chcm) (cat:Z-chcm) 2)) + (z3 (cat:zero-mrph (cat:Z-chcm) (cat:Z-chcm) 3)) + (comb (cat:gnrt-? z 0 :z-gnrt)) + (comb1 (cat:cmbn-? z (cat:cmbn 3))) + (comb2 (cat:gnrt-? z3 0 :z-gnrt))) + (is (equal (cat:cmbn-degr comb) 2)) + (is (equal (cat:cmbn-list comb) nil)) + (is (equal (cat:cmbn-degr comb1) 5)) + (is (equal (cat:cmbn-list comb1) nil)) + (is (eq z z2)) + (is (equal (cat:cmbn-degr comb2) 3)) + (is (equal (cat:cmbn-list comb2) nil)) + (is (not (eq z z3)))))) + + +(test idnt-mrph + (progn + (cat:cat-init) + (let* ((zi (cat:idnt-mrph (cat:Z-chcm))) + (comb (cat:gnrt-? zi 0 :z-gnrt)) + (zi2 (cat:idnt-mrph (cat:Z-chcm)))) + (is (equal (cat:cmbn-degr comb) 0)) + (is (equal (cat:cmbn-list comb) (cons (cons 1 :z-gnrt) nil))) + (is (eq zi zi2))))) + + +(test opps + (progn + (cat:cat-init) + (let* ((-zi (cat:opps (cat:idnt-mrph (cat:Z-chcm)))) + (comb (cat:gnrt-? -zi 0 :z-gnrt)) + (-zi2 (cat:opps (cat:idnt-mrph (cat:Z-chcm))))) + (is (equal (cat:cmbn-degr comb) 0)) + (is (equal (cat:cmbn-list comb) (cons (cons -1 :z-gnrt) nil))) + (is (eq -zi -zi2))))) + + +(defparameter *n* 5) +(defun ff (degr i) + (do ((*2n* (ash *n* 1)) + (rslt cat:+empty-list+ + (cons (cons (let ((cffc (- (random *2n*) *n*))) + (if (minusp cffc) cffc (1+ cffc))) + (decf gnrt (1+ (random *n*)))) + rslt)) + (gnrt i) + (k 0 (1+ k))) + ((= k *n*) + (cat:make-cmbn + :degr 0 + :list rslt)))) + +(test cmps + (progn + (cat:cat-init) + (let* ((cc (cat:build-chcm :cmpr #'cat:f-cmpr + :basis :locally-effective + :bsgn 0 + :intr-dffr #'(lambda (cmbn) + (cat:cmbn + (1- (cat:cmbn-degr cmbn)))) + :strt :cmbn + :orgn '(Z of Z))) + (mrph (cat:build-mrph :sorc cc :trgt cc :degr 0 + :intr #'ff :strt :gnrt :orgn '(test))) + (mrph2 (cat:cmps mrph mrph :gnrt)) + (comb (cat:gnrt-? mrph2 0 0)) + (mrph3 (cat:cmps mrph mrph :cmbn)) + (comb1 (cat:gnrt-? mrph3 0 0)) + (mrph33 (cat:cmps mrph mrph :cmbn))) + (dotimes (i 5) + (setq comb (cat:gnrt-? mrph2 0 i)) + (is (equal (cat:cmbn-degr comb) 0))) + (dotimes (i 5) + (setq comb1 (cat:gnrt-? mrph3 0 i)) + (is (equal (cat:cmbn-degr comb1) 0))) + (is (eq mrph3 mrph33))))) + +#| + (setf s3 (sphere 3)) + (setf ch3 (chml-clss s3 3)) + (setf 2ch3 (n-mrph 2 ch3)) + (setf f3 (z-whitehead s3 2ch3)) + (setf x (fibration-total f3)) + (homology x 0 10) + (setf k (k-z 3)) + (setf ch3 (chml-clss k 3)) + (setf 2ch3 (n-mrph 2 ch3)) + (setf f3 (z-whitehead k 2ch3)) + (setf x (fibration-total f3)) + (homology x 0 10) +|# + +(test n-mrph + (progn + (cat:cat-init) + (let* ((s3 (cat:sphere 3)) + (ch3 (cat:chml-clss s3 3)) + (2ch3 (cat:n-mrph 2 ch3)) +;; (f3 (cat:z-whitehead s3 2ch3)) +;; (x (cat:fibration-total f3)) + (k (cat:k-z 3))) +;; (cat:homology x 0 10) +;; (setf ch3 (cat:chml-clss k 3)) +;; (setf 2ch3 (cat:n-mrph 2 ch3)) +;; (setf f3 (cat:z-whitehead k 2ch3)) +;; (setf x (cat:fibration-total f3)) +;; (cat:homology x 0 10) + ))) + + +(setf *n* 10) +(setf cat:+too-much-time+ -1) +(test add + (progn + (cat:cat-init) + (let* ((cc (cat:build-chcm :cmpr #'cat:f-cmpr + :basis :locally-effective + :bsgn 0 + :intr-dffr #'(lambda (cmbn) + (cat:cmbn + (1- (cat:cmbn-degr cmbn)))) + :strt :cmbn + :orgn '(Z of Z))) + (mrph1 (cat:build-mrph :sorc cc :trgt cc :degr 0 + :intr #'ff :strt :gnrt :orgn '(test))) + (mrph2 (cat:build-mrph :sorc cc :trgt cc :degr 0 + :intr #'ff :strt :gnrt :orgn '(test2))) + (mrph3 (cat:add mrph1 mrph2 :gnrt)) + + (comb1 (cat:gnrt-? mrph1 0 0)) + (comb2 (cat:gnrt-? mrph2 0 0)) + (comb3 (cat:gnrt-? mrph3 0 0)) + (mrph4 (cat:add mrph1 mrph2 :cmbn)) + (comb4 (cat:gnrt-? mrph4 0 0)) + (mrph44 (cat:add mrph1 mrph2 :cmbn))) + (is (equal (cat:cmbn-degr comb1) 0)) + (is (equal (length (cat:cmbn-list comb1)) 10)) + (is (equal (cat:cmbn-degr comb2) 0)) + (is (equal (length (cat:cmbn-list comb2)) 10)) + (is (equal (cat:cmbn-degr comb3) 0)) + (is (<= (length (cat:cmbn-list comb3)) 20)) + (is (equal (cat:cmbn-degr comb4) 0)) + (is (<= (length (cat:cmbn-list comb4)) 20)) + (is (eq mrph4 mrph44))))) + + +(test sbtr + (progn + (cat:cat-init) + (let* ((cc (cat:build-chcm :cmpr #'cat:f-cmpr + :basis :locally-effective + :bsgn 0 + :intr-dffr #'(lambda (cmbn) + (cat:cmbn + (1- (cat:cmbn-degr cmbn)))) + :strt :cmbn + :orgn '(Z of Z))) + (mrph1 (cat:build-mrph :sorc cc :trgt cc :degr 0 + :intr #'ff :strt :gnrt :orgn '(test))) + (mrph2 (cat:build-mrph :sorc cc :trgt cc :degr 0 + :intr #'ff :strt :gnrt :orgn '(test2))) + (mrph3 (cat:sbtr mrph1 mrph2 :gnrt)) + (comb1 (cat:gnrt-? mrph1 0 0)) + (comb2 (cat:gnrt-? mrph2 0 0)) + (comb3 (cat:gnrt-? mrph3 0 0)) + (mrph4 (cat:sbtr mrph1 mrph2 :cmbn)) + (comb4 (cat:gnrt-? mrph4 0 0)) + (mrph44 (cat:sbtr mrph1 mrph2 :cmbn))) + (is (equal (cat:cmbn-degr comb1) 0)) + (is (equal (length (cat:cmbn-list comb1)) 10)) + (is (equal (cat:cmbn-degr comb2) 0)) + (is (equal (length (cat:cmbn-list comb2)) 10)) + (is (equal (cat:cmbn-degr comb3) 0)) + (is (<= (length (cat:cmbn-list comb3)) 20)) + (is (equal (cat:cmbn-degr comb4) 0)) + (is (<= (length (cat:cmbn-list comb4)) 20)) + (is (eq mrph4 mrph44)))))