From 6851846a71e6b87520b9ed159298b5ad4f15b29c Mon Sep 17 00:00:00 2001 From: gheber Date: Wed, 24 Dec 2014 23:08:33 -0600 Subject: [PATCH] All files compile w/ SBCL --- kenzo-test.asd | 5 +- kenzo.asd | 33 +++++++++- package.lisp | 13 +++- src/algebras.lisp | 2 +- src/bar.lisp | 6 +- src/bicones.lisp | 2 +- src/cartesian-products.lisp | 2 +- src/chain-complexes.lisp | 88 +------------------------- src/cl-space-efhm.lisp | 4 +- src/classifying-spaces.lisp | 5 +- src/coalgebras.lisp | 2 +- src/cobar.lisp | 8 ++- src/cones.lisp | 2 +- src/cs-twisted-products.lisp | 4 +- src/delta.lisp | 2 +- src/disk-pasting.lisp | 2 +- src/effective-homology.lisp | 2 +- src/eilenberg-zilber.lisp | 4 +- src/fibrations.lisp | 4 +- src/homology-groups.lisp | 2 +- src/k-pi-n.lisp | 2 +- src/kan.lisp | 4 +- src/loop-spaces.lisp | 5 +- src/lp-space-efhm.lisp | 2 +- src/ls-twisted-products.lisp | 2 +- src/searching-homology.lisp | 2 +- src/serre.lisp | 4 +- src/simplicial-groups.lisp | 4 +- src/simplicial-mrphs.lisp | 2 +- src/simplicial-sets.lisp | 2 +- src/smith.lisp | 2 +- src/special-smsts.lisp | 4 +- src/suspensions.lisp | 4 +- src/tensor-products.lisp | 4 +- src/whitehead.lisp | 4 +- test/chain-complexes-test.lisp | 110 +++++++++++++++++++++++++++++++++ test/circle.lisp | 26 ++++++++ test/diabolo.lisp | 49 +++++++++++++++ test/various-test.lisp | 7 ++- 39 files changed, 291 insertions(+), 140 deletions(-) create mode 100644 test/chain-complexes-test.lisp create mode 100644 test/circle.lisp create mode 100644 test/diabolo.lisp diff --git a/kenzo-test.asd b/kenzo-test.asd index 19b7e90..4976755 100644 --- a/kenzo-test.asd +++ b/kenzo-test.asd @@ -7,4 +7,7 @@ :pathname #P"test/" :components ((:file "package") (:file "combinations-test") - (:file "various-test"))) + (:file "various-test") + (:file "chain-complexes-test") + (:file "diabolo") + (:file "circle"))) diff --git a/kenzo.asd b/kenzo.asd index 936bfb6..c20f482 100644 --- a/kenzo.asd +++ b/kenzo.asd @@ -18,5 +18,36 @@ (:file "classes") (:file "combinations") (:file "chain-complexes") - (:file "chcm-elementary-op"))))) + (:file "chcm-elementary-op") + (:file "effective-homology") + (:file "homology-groups") + (:file "searching-homology") + (:file "cones") + (:file "bicones") + (:file "tensor-products") + (:file "coalgebras") + (:file "cobar") + (:file "algebras") + (:file "bar") + (:file "simplicial-sets") + (:file "simplicial-mrphs") + (:file "delta") + (:file "special-smsts") + (:file "suspensions") + (:file "disk-pasting") + (:file "cartesian-products") + (:file "eilenberg-zilber") + (:file "kan") + (:file "simplicial-groups") + (:file "fibrations") + (:file "loop-spaces") + (:file "ls-twisted-products") + (:file "lp-space-efhm") + (:file "classifying-spaces") + (:file "k-pi-n") + (:file "serre") + (:file "cs-twisted-products") + (:file "cl-space-efhm") + (:file "whitehead") + (:file "smith"))))) diff --git a/package.lisp b/package.lisp index 1ab2276..b2fc829 100644 --- a/package.lisp +++ b/package.lisp @@ -7,13 +7,19 @@ ;; chain-complexes.lisp + BUILD-CHCM + CAT-INIT + DO-CONTROL + ;; chcm-elementary-op.lisp ;; classes.lisp + CHAIN-COMPLEX CMBN-CMBN CMBN-DEGR CMBN-LIST + MAKE-RESULT ;; combinations.lisp @@ -35,15 +41,20 @@ ;; macros.lisp + BASIS + BINOMIAL-P-Q CFFC - GNRT CMBN-NON-ZERO-P CMBN-ZERO-P + CMPR + DFFR + GNRT TERM TERM-CMBN ;; various.lisp + +EMPTY-LIST+ >A-B< diff --git a/src/algebras.lisp b/src/algebras.lisp index 962fd6e..3e9c01b 100644 --- a/src/algebras.lisp +++ b/src/algebras.lisp @@ -2,7 +2,7 @@ ;;; ALGEBRAS ALGEBRAS ALGEBRAS ALGEBRAS ALGEBRAS ALGEBRAS ;;; ALGEBRAS ALGEBRAS ALGEBRAS ALGEBRAS ALGEBRAS ALGEBRAS -(IN-PACKAGE "COMMON-LISP-USER") +(IN-PACKAGE #:cat) (PROVIDE "algebras") diff --git a/src/bar.lisp b/src/bar.lisp index 13fd789..9953cfb 100644 --- a/src/bar.lisp +++ b/src/bar.lisp @@ -6,7 +6,7 @@ ;;; MAC-LANE signs (p. 306) ;;; -(IN-PACKAGE "COMMON-LISP-USER") +(IN-PACKAGE #:cat) (PROVIDE "bar") @@ -31,8 +31,8 @@ (abar 2 'a 3)) ;; error |# -(DEFCONSTANT +NULL-ABAR+ (make-abar :list +empty-list+)) - +#-sbcl (DEFCONSTANT +NULL-ABAR+ (make-abar :list +empty-list+)) +#+sbcl (DEFPARAMETER +NULL-ABAR+ (make-abar :list +empty-list+)) ;;; -[CLISP #| diff --git a/src/bicones.lisp b/src/bicones.lisp index 257d7f3..187525b 100644 --- a/src/bicones.lisp +++ b/src/bicones.lisp @@ -2,7 +2,7 @@ ;;; BICONES BICONES BICONES BICONES BICONES BICONES BICONES BICONES ;;; BICONES BICONES BICONES BICONES BICONES BICONES BICONES BICONES -(IN-PACKAGE "COMMON-LISP-USER") +(IN-PACKAGE #:cat) (PROVIDE "bicones") diff --git a/src/cartesian-products.lisp b/src/cartesian-products.lisp index f3e7552..025ea80 100644 --- a/src/cartesian-products.lisp +++ b/src/cartesian-products.lisp @@ -2,7 +2,7 @@ ;;; CARTESIAN-PRODUCTS CARTESIAN-PRODUCTS CARTESIAN-PRODUCTS CARTESIAN-PRODUCTS ;;; CARTESIAN-PRODUCTS CARTESIAN-PRODUCTS CARTESIAN-PRODUCTS CARTESIAN-PRODUCTS -(IN-PACKAGE "COMMON-LISP-USER") +(IN-PACKAGE #:cat) (PROVIDE "cartesian-products") diff --git a/src/chain-complexes.lisp b/src/chain-complexes.lisp index 5e586f0..d7f0b67 100644 --- a/src/chain-complexes.lisp +++ b/src/chain-complexes.lisp @@ -111,11 +111,6 @@ result) -#| -() -(make-result :gnrt 'a :value '(a a) :clnm 23 :rntm 2.345) -|# - (DEFPARAMETER +MAXIMAL-DIMENSION+ 15) (DEFVAR *MRPH-LIST*) @@ -361,7 +356,7 @@ (/ runtime internal-time-units-per-second)))) (declare (single-float rntm)) (incf *results-cmlt-tm* rntm) - rntm))) + rntm))) (mapl #'(lambda (mark) (declare (cons mark)) (incf (car mark) runtime)) @@ -380,7 +375,7 @@ (:less (setf right middle)) (:greater (setf left middle))))))) - + (DEFUN MRPH-CMBN (scmpr2 tcmpr2 intr cmbn memory) (declare (type intr-mrph intr) @@ -419,15 +414,6 @@ ~A and ~A are in a wrong order." (cdar mark2) (cdar mark1))))) cmbn) -#| - (do-control #'s-cmpr (cmbn 0 1 'a 1 'b -1 'c)) - (do-control #'s-cmpr (cmbn 0 1 'b 1 'b -1 'c)) - (do-control #'s-cmpr (cmbn 0 1 'a 1 'b -1 'b)) - (setf *cmbn-control* nil) - (control #'s-cmpr (cmbn 0 1 'a 1 'b -1 'b)) - (setf *cmbn-control* t) - (control #'s-cmpr (cmbn 0 1 'a 1 'b -1 'b)) -|# #| (DEFVAR *PROFILER-STACK*) @@ -495,38 +481,6 @@ ;; (profiler-off mrph) )))))))) -#| -() -(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 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 ff (build-mrph :sorc cc :trgt cc :degr 0 - :intr #'(lambda (degr n) (cmbn degr 1 n)) - :strt :gnrt :orgn '(test))) -(setf ff (build-mrph :sorc cc :trgt cc :degr 0 - :intr #'(lambda (degr n) (cmbn degr 1 n)) - :strt :gnrt :orgn '(test))) -(dotimes (i 20) - (let ((n (- (random 50) 50))) - (format t "~%~D ~D" n (gnrt-? ff 0 n)))) -(setf +too-much-time+ -1) -(dotimes (i 20) - (let ((n (- (random 50) 50))) - (format t "~%~D ~D" n (gnrt-? ff 0 n)))) -(setf +too-much-time+ 50) -|# (DEFUN CMBN-? (mrph cmbn) (declare @@ -565,41 +519,3 @@ cmbn (svref (rslts mrph) (cmbn-degr cmbn)))) ;; (profiler-off mrph) ))))))))) - -#| -() -(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)))) -(ff 0 20) -(compile 'ff) -(setf mrph (build-mrph :sorc cc :trgt cc :degr 0 - :intr #'ff :strt :gnrt :orgn '(test))) -(cmbn-? mrph (cmbn 0 1 100)) -(cmbn-? mrph *) -(cmbn-? mrph *) -(cmbn-? mrph *) -(cmbn-? mrph *) -(cmbn-? mrph *) -(time (cmbn-? mrph *)) -(inspect mrph) -|# diff --git a/src/cl-space-efhm.lisp b/src/cl-space-efhm.lisp index c77a9f1..f223f8b 100644 --- a/src/cl-space-efhm.lisp +++ b/src/cl-space-efhm.lisp @@ -2,7 +2,7 @@ ;;; CL-SPACE-EFHM CL-SPACE-EFHM CL-SPACE-EFHM CL-SPACE-EFHM ;;; CL-SPACE-EFHM CL-SPACE-EFHM CL-SPACE-EFHM CL-SPACE-EFHM -(IN-PACKAGE "COMMON-LISP-USER") +(IN-PACKAGE #:cat) (provide "cl-space-efhm") @@ -872,4 +872,4 @@ (homology bk 0 10) (setf obk (loop-space bk)) (homology obk 0 6) -|# \ No newline at end of file +|# diff --git a/src/classifying-spaces.lisp b/src/classifying-spaces.lisp index b743f86..7420b8c 100644 --- a/src/classifying-spaces.lisp +++ b/src/classifying-spaces.lisp @@ -2,11 +2,12 @@ ;;; CLASSIFYING-SPACES CLASSIFYING-SPACES CLASSIFYING-SPACES ;;; CLASSIFYING-SPACES CLASSIFYING-SPACES CLASSIFYING-SPACES -(IN-PACKAGE "COMMON-LISP-USER") +(IN-PACKAGE #:cat) (provide "classifying-spaces") -(DEFCONSTANT +NULL-GBAR+ (make-gbar :dmns 0 :list +empty-list+)) +#-sbcl (DEFCONSTANT +NULL-GBAR+ (make-gbar :dmns 0 :list +empty-list+)) +#+sbcl (DEFPARAMETER +NULL-GBAR+ (make-gbar :dmns 0 :list +empty-list+)) (DEFUN GBAR-PRINT (gbar stream depth) (declare diff --git a/src/coalgebras.lisp b/src/coalgebras.lisp index 03e2e57..5c9a6b4 100644 --- a/src/coalgebras.lisp +++ b/src/coalgebras.lisp @@ -2,7 +2,7 @@ ;;; COALGEBRAS COALGEBRAS COALGEBRAS COALGEBRAS COALGEBRAS COALGEBRAS ;;; COALGEBRAS COALGEBRAS COALGEBRAS COALGEBRAS COALGEBRAS COALGEBRAS -(IN-PACKAGE "COMMON-LISP-USER") +(IN-PACKAGE #:cat) (PROVIDE "coalgebras") diff --git a/src/cobar.lisp b/src/cobar.lisp index 7447efd..572e43f 100644 --- a/src/cobar.lisp +++ b/src/cobar.lisp @@ -2,7 +2,7 @@ ;;; COBAR COBAR COBAR COBAR COBAR COBAR COBAR COBAR COBAR ;;; COBAR COBAR COBAR COBAR COBAR COBAR COBAR COBAR COBAR -(IN-PACKAGE "COMMON-LISP-USER") +(IN-PACKAGE #:cat) (PROVIDE "cobar") @@ -28,7 +28,9 @@ (allp 2 'a 3)) ;; error |# -(DEFCONSTANT +NULL-ALLP+ (make-allp :list +empty-list+)) +#-sbcl(DEFCONSTANT +NULL-ALLP+ (make-allp :list +empty-list+)) +#+sbcl (DEFPARAMETER +NULL-ALLP+ (make-allp :list +empty-list+)) + (DEFUN ALLP-PRINT (allp stream depth) (declare @@ -705,4 +707,4 @@ (setf h (left-hmeq (sphere 3))) (setf c (cobar h)) (inspect c) -|# \ No newline at end of file +|# diff --git a/src/cones.lisp b/src/cones.lisp index 1de1743..6a62af0 100644 --- a/src/cones.lisp +++ b/src/cones.lisp @@ -2,7 +2,7 @@ ;;; CONES CONES CONES CONES CONES CONES CONES CONES CONES CONES ;;; CONES CONES CONES CONES CONES CONES CONES CONES CONES CONES -(IN-PACKAGE "COMMON-LISP-USER") +(IN-PACKAGE #:cat) (PROVIDE "cones") diff --git a/src/cs-twisted-products.lisp b/src/cs-twisted-products.lisp index f9d9773..6909459 100644 --- a/src/cs-twisted-products.lisp +++ b/src/cs-twisted-products.lisp @@ -2,7 +2,7 @@ ;;; CS-TWISTED-PRODUCTS CS-TWISTED-PRODUCTS CS-TWISTED-PRODUCTS ;;; CS-TWISTED-PRODUCTS CS-TWISTED-PRODUCTS CS-TWISTED-PRODUCTS -(IN-PACKAGE "COMMON-LISP-USER") +(IN-PACKAGE #:cat) (PROVIDE "cs-twisted-products") @@ -143,4 +143,4 @@ 0 '()))) (? chi *tc*) (check-rdct) -|# \ No newline at end of file +|# diff --git a/src/delta.lisp b/src/delta.lisp index f41f954..ab976cf 100644 --- a/src/delta.lisp +++ b/src/delta.lisp @@ -2,7 +2,7 @@ ;;; DELTA DELTA DELTA DELTA DELTA DELTA DELTA DELTA DELTA ;;; DELTA DELTA DELTA DELTA DELTA DELTA DELTA DELTA DELTA -(IN-PACKAGE "COMMON-LISP-USER") +(IN-PACKAGE #:cat) (PROVIDE "delta") diff --git a/src/disk-pasting.lisp b/src/disk-pasting.lisp index a70ad56..659c34a 100644 --- a/src/disk-pasting.lisp +++ b/src/disk-pasting.lisp @@ -2,7 +2,7 @@ ;;; DISK-PASTING DISK-PASTING DISK-PASTING DISK-PASTING ;;; DISK-PASTING DISK-PASTING DISK-PASTING DISK-PASTING -(IN-PACKAGE "COMMON-LISP-USER") +(IN-PACKAGE #:cat) (provide "disk-pasting") diff --git a/src/effective-homology.lisp b/src/effective-homology.lisp index b3b2346..325a1f7 100644 --- a/src/effective-homology.lisp +++ b/src/effective-homology.lisp @@ -2,7 +2,7 @@ ;;; EFFECTIVE-HOMOLOGY EFFECTIVE-HOMOLOGY EFFECTIVE-HOMOLOGY ;;; EFFECTIVE-HOMOLOGY EFFECTIVE-HOMOLOGY EFFECTIVE-HOMOLOGY -(IN-PACKAGE "COMMON-LISP-USER") +(IN-PACKAGE #:cat) (PROVIDE "effective-homology") diff --git a/src/eilenberg-zilber.lisp b/src/eilenberg-zilber.lisp index c888713..c482003 100644 --- a/src/eilenberg-zilber.lisp +++ b/src/eilenberg-zilber.lisp @@ -2,7 +2,7 @@ ;;; EILENBERG-ZILBER EILENBERG-ZILBER EILENBERG-ZILBER ;;; EILENBERG-ZILBER EILENBERG-ZILBER EILENBERG-ZILBER -(IN-PACKAGE "COMMON-LISP-USER") +(IN-PACKAGE #:cat) (PROVIDE "eilenberg-zilber") @@ -477,4 +477,4 @@ (setf k (k-z 2)) (setf k2 (crts-prdc k k)) (homology k2 0 10) -|# \ No newline at end of file +|# diff --git a/src/fibrations.lisp b/src/fibrations.lisp index ca968b1..3898b75 100644 --- a/src/fibrations.lisp +++ b/src/fibrations.lisp @@ -2,7 +2,7 @@ ;;; FIBRATIONS FIBRATIONS FIBRATIONS FIBRATIONS FIBRATIONS ;;; FIBRATIONS FIBRATIONS FIBRATIONS FIBRATIONS FIBRATIONS -(IN-PACKAGE "COMMON-LISP-USER") +(IN-PACKAGE #:cat) (PROVIDE "fibrations") @@ -182,4 +182,4 @@ (dotimes (i 5) (print (kfll total i 4 (remove (nth i hat) hat))) (check-kan total i 4 (remove (nth i hat) hat))) -|# \ No newline at end of file +|# diff --git a/src/homology-groups.lisp b/src/homology-groups.lisp index 130b178..c347993 100644 --- a/src/homology-groups.lisp +++ b/src/homology-groups.lisp @@ -2,7 +2,7 @@ ;; HOMOLOGY-GROUPS HOMOLOGY-GROUPS HOMOLOGY-GROUPS HOMOLOGY-GROUPS ;; HOMOLOGY-GROUPS HOMOLOGY-GROUPS HOMOLOGY-GROUPS HOMOLOGY-GROUPS -(IN-PACKAGE "COMMON-LISP-USER") +(IN-PACKAGE #:cat) (provide "homology-groups") diff --git a/src/k-pi-n.lisp b/src/k-pi-n.lisp index 852f624..cc4209c 100644 --- a/src/k-pi-n.lisp +++ b/src/k-pi-n.lisp @@ -2,7 +2,7 @@ ;;; K-PI-1 K-PI-1 K-PI-1 K-PI-1 K-PI-1 K-PI-1 K-PI-1 ;;; K-PI-1 K-PI-1 K-PI-1 K-PI-1 K-PI-1 K-PI-1 K-PI-1 -(IN-PACKAGE "COMMON-LISP-USER") +(IN-PACKAGE #:cat) (PROVIDE "k-pi-1") diff --git a/src/kan.lisp b/src/kan.lisp index 5d82a75..7268b1b 100644 --- a/src/kan.lisp +++ b/src/kan.lisp @@ -2,7 +2,7 @@ ;;; KAN KAN KAN KAN KAN KAN KAN KAN KAN KAN KAN KAN ;;; KAN KAN KAN KAN KAN KAN KAN KAN KAN KAN KAN KAN -(IN-PACKAGE "COMMON-LISP-USER") +(IN-PACKAGE #:cat) (provide "kan") @@ -195,4 +195,4 @@ Del-~D(Fill) = ~A~@ Hat-~D = ~A" rslt i del-i-rslt i x-i))))))) - (done)))) \ No newline at end of file + (done)))) diff --git a/src/loop-spaces.lisp b/src/loop-spaces.lisp index 202d308..ac30f3c 100644 --- a/src/loop-spaces.lisp +++ b/src/loop-spaces.lisp @@ -2,11 +2,12 @@ ;;; LOOP-SPACES LOOP-SPACES LOOP-SPACES LOOP-SPACES LOOP-SPACES LOOP-SPACES ;;; LOOP-SPACES LOOP-SPACES LOOP-SPACES LOOP-SPACES LOOP-SPACES LOOP-SPACES -(IN-PACKAGE "COMMON-LISP-USER") +(IN-PACKAGE #:cat) (PROVIDE "loop-spaces") -(DEFCONSTANT +NULL-LOOP+ (make-loop :list +empty-list+)) +#-sbcl (DEFCONSTANT +NULL-LOOP+ (make-loop :list +empty-list+)) +#+sbcl (DEFPARAMETER +NULL-LOOP+ (make-loop :list +empty-list+)) ;;; NILOOP = non-normalized iloop; a common dgop is possible. diff --git a/src/lp-space-efhm.lisp b/src/lp-space-efhm.lisp index fdb787b..a6fb253 100644 --- a/src/lp-space-efhm.lisp +++ b/src/lp-space-efhm.lisp @@ -2,7 +2,7 @@ ;;; LP-SPACE-EFHM LP-SPACE-EFHM LP-SPACE-EFHM LP-SPACE-EFHM ;;; LP-SPACE-EFHM LP-SPACE-EFHM LP-SPACE-EFHM LP-SPACE-EFHM -(IN-PACKAGE "COMMON-LISP-USER") +(IN-PACKAGE #:cat) (PROVIDE "lp-space-efhm") diff --git a/src/ls-twisted-products.lisp b/src/ls-twisted-products.lisp index 8833561..8f27259 100644 --- a/src/ls-twisted-products.lisp +++ b/src/ls-twisted-products.lisp @@ -2,7 +2,7 @@ ;;; LS-TWISTED-PRODUCTS LS-TWISTED-PRODUCTS LS-TWISTED-PRODUCTS ;;; LS-TWISTED-PRODUCTS LS-TWISTED-PRODUCTS LS-TWISTED-PRODUCTS -(IN-PACKAGE "COMMON-LISP-USER") +(IN-PACKAGE #:cat) (PROVIDE "ls-twisted-products") diff --git a/src/searching-homology.lisp b/src/searching-homology.lisp index fe30039..ae7f1be 100644 --- a/src/searching-homology.lisp +++ b/src/searching-homology.lisp @@ -2,7 +2,7 @@ ;;; SEARCHING-HOMOLOGY SEARCHING-HOMOLOGY SEARCHING-HOMOLOGY ;;; SEARCHING-HOMOLOGY SEARCHING-HOMOLOGY SEARCHING-HOMOLOGY -(IN-PACKAGE "COMMON-LISP-USER") +(IN-PACKAGE #:cat) (PROVIDE "searching-homology") diff --git a/src/serre.lisp b/src/serre.lisp index 8f14014..af5345b 100644 --- a/src/serre.lisp +++ b/src/serre.lisp @@ -2,7 +2,7 @@ ;;; SERRE SERRE SERRE SERRE SERRE SERRE SERRE SERRE SERRE ;;; SERRE SERRE SERRE SERRE SERRE SERRE SERRE SERRE SERRE -(IN-PACKAGE "COMMON-LISP-USER") +(IN-PACKAGE #:cat) (PROVIDE "serre") @@ -283,4 +283,4 @@ - \ No newline at end of file + diff --git a/src/simplicial-groups.lisp b/src/simplicial-groups.lisp index 0108335..139dd6d 100644 --- a/src/simplicial-groups.lisp +++ b/src/simplicial-groups.lisp @@ -2,7 +2,7 @@ ;;; SIMPLICIAL-GROUPS SIMPLICIAL-GROUPS SIMPLICIAL-GROUPS ;;; SIMPLICIAL-GROUPS SIMPLICIAL-GROUPS SIMPLICIAL-GROUPS -(IN-PACKAGE "COMMON-LISP-USER") +(IN-PACKAGE #:cat) (PROVIDE "simplicial-groups") @@ -195,4 +195,4 @@ (type simplicial-mrph grml)) (cmps grml eml)))) - \ No newline at end of file + diff --git a/src/simplicial-mrphs.lisp b/src/simplicial-mrphs.lisp index 9646bdb..eb67d18 100644 --- a/src/simplicial-mrphs.lisp +++ b/src/simplicial-mrphs.lisp @@ -2,7 +2,7 @@ ;;; SIMPLICIAL-MRPHS SIMPLICIAL-MRPHS SIMPLICIAL-MRPHS ;;; SIMPLICIAL-MRPHS SIMPLICIAL-MRPHS SIMPLICIAL-MRPHS -(IN-PACKAGE "COMMON-LISP-USER") +(IN-PACKAGE #:cat) (PROVIDE "simplicial-mrphs") diff --git a/src/simplicial-sets.lisp b/src/simplicial-sets.lisp index 5f7c6b6..d4c66a0 100644 --- a/src/simplicial-sets.lisp +++ b/src/simplicial-sets.lisp @@ -2,7 +2,7 @@ ;;; SIMPLICIAL-SETS SIMPLICIAL-SETS SIMPLICIAL-SETS ;;; SIMPLICIAL-SETS SIMPLICIAL-SETS SIMPLICIAL-SETS -(IN-PACKAGE "COMMON-LISP-USER") +(IN-PACKAGE #:cat) (PROVIDE "simplicial-sets") diff --git a/src/smith.lisp b/src/smith.lisp index 7c4af86..58a9ad1 100644 --- a/src/smith.lisp +++ b/src/smith.lisp @@ -2,7 +2,7 @@ ;;; SMITH SMITH SMITH SMITH SMITH SMITH SMITH SMITH ;;; SMITH SMITH SMITH SMITH SMITH SMITH SMITH SMITH -(IN-PACKAGE "COMMON-LISP-USER") +(IN-PACKAGE #:cat) (PROVIDE "smith") diff --git a/src/special-smsts.lisp b/src/special-smsts.lisp index 45d5eeb..974c330 100644 --- a/src/special-smsts.lisp +++ b/src/special-smsts.lisp @@ -2,7 +2,7 @@ ;;; SPECIAL-SMSTS SPECIAL-SMSTS SPECIAL-SMSTS SPECIAL-SMSTS SPECIAL-SMSTS ;;; SPECIAL-SMSTS SPECIAL-SMSTS SPECIAL-SMSTS SPECIAL-SMSTS SPECIAL-SMSTS -(IN-PACKAGE "COMMON-LISP-USER") +(IN-PACKAGE #:cat) (PROVIDE "special-smsts") @@ -685,4 +685,4 @@ (setf cmbn (lf efhm (rg efhm 3 (first (basis (rbcc efhm) 3))))) (setf kf (gmsms-subsmst s3 cmbn)) (homology kf 0 4) -|# \ No newline at end of file +|# diff --git a/src/suspensions.lisp b/src/suspensions.lisp index 9e07aeb..a5bfe9a 100644 --- a/src/suspensions.lisp +++ b/src/suspensions.lisp @@ -2,7 +2,7 @@ ;;; SUSPENSIONS SUSPENSIONS SUSPENSIONS SUSPENSIONS ;;; SUSPENSIONS SUSPENSIONS SUSPENSIONS SUSPENSIONS -(IN-PACKAGE "COMMON-LISP-USER") +(IN-PACKAGE #:cat) (PROVIDE "suspensions") @@ -318,4 +318,4 @@ (setf sk (suspension (k-z 2))) (homology sk 0 10) |# - \ No newline at end of file + diff --git a/src/tensor-products.lisp b/src/tensor-products.lisp index 45f1d1c..2c5f2eb 100644 --- a/src/tensor-products.lisp +++ b/src/tensor-products.lisp @@ -2,7 +2,7 @@ ;;; TENSOR-PRODUCTS TENSOR-PRODUCTS TENSOR-PRODUCTS TENSOR-PRODUCTS TENSOR-PRODUCTS ;;; TENSOR-PRODUCTS TENSOR-PRODUCTS TENSOR-PRODUCTS TENSOR-PRODUCTS TENSOR-PRODUCTS -(IN-PACKAGE "COMMON-LISP-USER") +(IN-PACKAGE #:cat) (PROVIDE "tensor-products") @@ -366,4 +366,4 @@ (setf k (k-z 2)) (setf k2 (tnsr-prdc k k)) (homology k2 0 10) -|# \ No newline at end of file +|# diff --git a/src/whitehead.lisp b/src/whitehead.lisp index df05d28..1bd5a1d 100644 --- a/src/whitehead.lisp +++ b/src/whitehead.lisp @@ -2,7 +2,7 @@ ;;; WHITEHEAD WHITEHEAD WHITEHEAD WHITEHEAD WHITEHEAD WHITEHEAD WHITEHEAD ;;; WHITEHEAD WHITEHEAD WHITEHEAD WHITEHEAD WHITEHEAD WHITEHEAD WHITEHEAD -(IN-PACKAGE "COMMON-LISP-USER") +(IN-PACKAGE #:cat) (provide "whitehead") @@ -335,4 +335,4 @@ (setf mt (fibration-total mf)) (homology mt 0 10) |# - \ No newline at end of file + diff --git a/test/chain-complexes-test.lisp b/test/chain-complexes-test.lisp new file mode 100644 index 0000000..deada3e --- /dev/null +++ b/test/chain-complexes-test.lisp @@ -0,0 +1,110 @@ + +(in-package :kenzo-test) + +(in-suite :kenzo) + +(test result-print + (let ((rslt (format nil "~a" + (cat:make-result :gnrt 'a :value '(a a) + :clnm 23 :rntm 2.345)))) + (is (equal rslt (format nil "~{~a~}" + '(#\Newline "" #\Newline + " GNRT-> A" #\Newline + " VALUE-> (A A)" #\Newline + " CLNM-> 23" #\Newline + " RNTM-> 2.345")))))) + +#| + (do-control #'s-cmpr (cmbn 0 1 'a 1 'b -1 'c)) + (do-control #'s-cmpr (cmbn 0 1 'b 1 'b -1 'c)) + (do-control #'s-cmpr (cmbn 0 1 'a 1 'b -1 'b)) + (setf *cmbn-control* nil) + (control #'s-cmpr (cmbn 0 1 'a 1 'b -1 'b)) + (setf *cmbn-control* t) + (control #'s-cmpr (cmbn 0 1 'a 1 'b -1 'b)) +|# + +(test do-control + (let ((comb (cat:do-control #'cat:s-cmpr (cat:cmbn 0 1 'a 1 'b -1 'c)))) + (is (equal (cat:cmbn-degr comb) 0)) + (is (equal (cat:cmbn-list comb) '((1 . a) (1 . b) (-1 . c))))) + + (signals simple-error (cat:do-control #'cat:s-cmpr + (cat:cmbn 0 1 'b 1 'b -1 'c))) + + (signals simple-error (cat:do-control #'cat:s-cmpr + (cat:cmbn 0 1 'a 1 'b -1 'b))) + + (setf cat:*cmbn-control* nil)) + +#| +() +(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 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 ff (build-mrph :sorc cc :trgt cc :degr 0 + :intr #'(lambda (degr n) (cmbn degr 1 n)) + :strt :gnrt :orgn '(test))) +(setf ff (build-mrph :sorc cc :trgt cc :degr 0 + :intr #'(lambda (degr n) (cmbn degr 1 n)) + :strt :gnrt :orgn '(test))) +(dotimes (i 20) + (let ((n (- (random 50) 50))) + (format t "~%~D ~D" n (gnrt-? ff 0 n)))) +(setf +too-much-time+ -1) +(dotimes (i 20) + (let ((n (- (random 50) 50))) + (format t "~%~D ~D" n (gnrt-? ff 0 n)))) +(setf +too-much-time+ 50) +|# + + +#| +() +(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)))) +(ff 0 20) +(compile 'ff) +(setf mrph (build-mrph :sorc cc :trgt cc :degr 0 + :intr #'ff :strt :gnrt :orgn '(test))) +(cmbn-? mrph (cmbn 0 1 100)) +(cmbn-? mrph *) +(cmbn-? mrph *) +(cmbn-? mrph *) +(cmbn-? mrph *) +(cmbn-? mrph *) +(time (cmbn-? mrph *)) +(inspect mrph) +|# diff --git a/test/circle.lisp b/test/circle.lisp new file mode 100644 index 0000000..fc2a3da --- /dev/null +++ b/test/circle.lisp @@ -0,0 +1,26 @@ + +(in-package :kenzo-test) + +(in-suite :kenzo) + +(defun circle () + (the cat:chain-complex + (cat:build-chcm + :cmpr #'(lambda (gnrt1 gnrt2) (the cat:cmpr :equal)) + :basis #'(lambda (dmns) + (the list + (case dmns (0 '(*)) (1 '(s1)) + (otherwise cat:+empty-list+)))) + :bsgn '* + :intr-dffr #'cat:zero-intr-dffr + :strt :cmbn + :orgn '(circle)))) + + +(test circle + (progn + (cat:cat-init) + (let ((circle (circle))) + (is (equal (cat:basis circle 0) '(*))) + (is (equal (cat:basis circle 1) '(s1))) + (is (equal (cat:basis circle 2) cat:+empty-list+))))) diff --git a/test/diabolo.lisp b/test/diabolo.lisp new file mode 100644 index 0000000..a0414c5 --- /dev/null +++ b/test/diabolo.lisp @@ -0,0 +1,49 @@ + +(in-package :kenzo-test) + +(in-suite :kenzo) + +(defun diabolo-basis (dmn) + (case dmn + (0 '(s0 s1 s2 s3 s4 s5)) + (1 '(s01 s02 s12 s23 s34 s35 s45)) + (2 '(s345)) + (otherwise nil))) + +(defun diabolo-pure-dffr (dmn gnr) + (unless (<= 0 dmn 2) + (error "Incorrect dimension for diabolo-dp.")) + (case dmn + (0 (cat:cmbn -1)) + (1 (case gnr + (s01 (cat:cmbn 0 -1 's0 1 's1)) + (s02 (cat:cmbn 0 -1 's0 1 's2)) + (s12 (cat:cmbn 0 -1 's1 1 's2)) + (s23 (cat:cmbn 0 -1 's2 1 's3)) + (s34 (cat:cmbn 0 -1 's3 1 's4)) + (s35 (cat:cmbn 0 -1 's3 1 's5)) + (s45 (cat:cmbn 0 -1 's4 1 's5)))) + (2 (case gnr + (s345 (cat:cmbn 1 1 's34 -1 's35 1 's45)))) + (otherwise (error "Bad generator for complex diabolo.")))) + +(test diabolo + (progn + (cat:cat-init) + (let ((diabolo (cat:build-chcm :cmpr #'cat:s-cmpr + :basis #'diabolo-basis + :bsgn 's0 + :intr-dffr #'diabolo-pure-dffr + :strt :GNRT + :orgn '(diabolo-for-example)))) + (is (equal (cat:basis diabolo 0) '(s0 s1 s2 s3 s4 s5))) + (is (equal (cat:basis diabolo 1) '(s01 s02 s12 s23 s34 s35 s45))) + (is (equal (cat:basis diabolo 2) '(s345))) + (is (null (cat:basis diabolo 10))) + + (let* ((comb (cat:dffr diabolo 2 's345)) + (comb1 (cat:dffr diabolo comb))) + (is (equal (cat:cmbn-degr comb) 1)) + (is (equal (cat:cmbn-list comb) '((1 . s34) (-1 . s35) (1 . s45)))) + (is (equal (cat:cmbn-degr comb1) 0)) + (is (equal (cat:cmbn-list comb1) nil)))))) diff --git a/test/various-test.lisp b/test/various-test.lisp index f0e2dd7..cfe8017 100644 --- a/test/various-test.lisp +++ b/test/various-test.lisp @@ -7,11 +7,12 @@ (let ((rslt '(1 5 10 10 5 1))) (dotimes (i 6) (is (equal (cat:binomial-n-p 5 i) - (nth i rslt))))) + (nth i rslt)))))) - (let ((rslt '(1 4 3 1 1 1))) +(test binomial-p-q + (let ((rslt '(1 5 10 10 5 1))) (dotimes (i 6) - (is (equal (cat:binomial-n-p (- 5 i) i) + (is (equal (cat:binomial-p-q (- 5 i) i) (nth i rslt)))))) (test