From 7cff3960f0c7c31adad19410c1ac5d0f927b6b4a Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Juli=C3=A1n=20Cuevas-Rozo?= Date: Thu, 9 May 2019 13:50:37 +0200 Subject: [PATCH 1/8] Auxiliary functions added to /src/sage-interface.lisp --- src/sage-interface.lisp | 46 +++++++++++++++++++++++++++++++++++++++-- 1 file changed, 44 insertions(+), 2 deletions(-) diff --git a/src/sage-interface.lisp b/src/sage-interface.lisp index 34a3e8a..c3fa3b8 100644 --- a/src/sage-interface.lisp +++ b/src/sage-interface.lisp @@ -8,11 +8,18 @@ +;;;; Chain complexes + + + (DEFVAR *ASCII-NUM-START* 48) + + (DEFVAR *ASCII-NUM-END* 57) + (DEFUN ITOA (value) (if (not (integerp value)) (error "Wrong type")) (if (zerop value) @@ -37,6 +44,7 @@ (DEFUN STRCAT (&rest strings) (apply 'concatenate 'string strings)) + (DEFMACRO GEN (num1 num2) `(read-from-string (strcat "G" (itoa ,num1) "G" (itoa ,num2)))) @@ -146,6 +154,39 @@ +(DEFUN MAKE-ARRAY-TO-LISTS (array) + (loop for i below (array-dimension array 0) + collect (loop for j below (array-dimension array 1) + collect (aref array i j)))) + + + +(DEFUN MAKE-ARRAY-FROM-LISTS (nrows ncols list) + (make-array (list nrows ncols) :initial-contents list)) + + + +(DEFUN BASIS_AUX1 (kchcm dim) + (basis kchcm dim)) + + + +(DEFUN ORGN_AUX1 (kchcm) + (orgn kchcm)) + + + +(DEFUN DFFR_AUX1(kchcm dim cmbn_list) + (let ((comb (cmbn dim))) + (setf (cmbn-list comb) cmbn_list) + (dffr kchcm comb))) + + + +;;;; Simplicial sets + + + (DEFUN BUILD-FINITE-SS2 (list) (declare (list list)) (let ((bspn (first list)) @@ -166,5 +207,6 @@ (setf (symbol-value ind-smst) rslt) rslt))) -(DEFUN MAKE-ARRAY-FROM-LISTS (list) - (make-array (list (length list) (length (first list))) :initial-contents list)) + + + From 5b16336b1cd378f989aa0088dba6410d72fbac58 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Juli=C3=A1n=20Cuevas-Rozo?= Date: Thu, 9 May 2019 13:51:21 +0200 Subject: [PATCH 2/8] sage-interface added to the list of files --- kenzo.asd | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/kenzo.asd b/kenzo.asd index e066433..25dac21 100644 --- a/kenzo.asd +++ b/kenzo.asd @@ -56,7 +56,8 @@ (:file "cs-twisted-products") (:file "cl-space-efhm") (:file "whitehead") - (:file "smith") + (:file "smith") + (:file "sage-interface") (:module "anromero" :components ((:file "resolutions") From f2e72823910da0a82121cf12ffa84c2d0cb58c39 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Juli=C3=A1n=20Cuevas-Rozo?= Date: Tue, 21 May 2019 00:25:06 +0200 Subject: [PATCH 3/8] Some comments about auxiliary functions were added --- src/sage-interface.lisp | 58 +++++++++++++++++++++-------------------- 1 file changed, 30 insertions(+), 28 deletions(-) diff --git a/src/sage-interface.lisp b/src/sage-interface.lisp index c3fa3b8..d3fd157 100644 --- a/src/sage-interface.lisp +++ b/src/sage-interface.lisp @@ -8,18 +8,13 @@ -;;;; Chain complexes - +;;;;; Chain complexes ;;;;; (DEFVAR *ASCII-NUM-START* 48) - - - (DEFVAR *ASCII-NUM-END* 57) - (DEFUN ITOA (value) (if (not (integerp value)) (error "Wrong type")) (if (zerop value) @@ -40,17 +35,15 @@ (return (format nil "~{~a~}" (nreverse result)))))) - (DEFUN STRCAT (&rest strings) (apply 'concatenate 'string strings)) - (DEFMACRO GEN (num1 num2) `(read-from-string (strcat "G" (itoa ,num1) "G" (itoa ,num2)))) - (DEFUN KBASIS (schcm) +#| It provides the slot :basis of the KenzoSimplicialSet obtained by applying the function 'KChainComplex' to 'schcm' |# (flet ((rslt (dim) (let ((pair (assoc dim schcm))) (if (null pair) @@ -60,8 +53,8 @@ (the basis #'rslt))) - (DEFUN KDFFR (schcm) +#| It provides the slot :intr-dffr of the KenzoSimplicialSet obtained by applying the function 'KChainComplex' to 'schcm' |# (flet ((frslt (dim gnr) (let* ((sep (1+ (position #\G (subseq (write-to-string gnr) 1)))) (dim_gnr (read-from-string (subseq (write-to-string gnr) 1 sep))) @@ -83,8 +76,8 @@ #'frslt)) - (DEFUN G-CMPR (GnGm1 GnGm2) +#| It provides the slot :cmpr of the KenzoSimplicialSet obtained by applying the function 'KChainComplex' to 'schcm' |# (let* ((sep (1+ (position #\G (subseq (write-to-string GnGm1) 1)))) (m1 (read-from-string (subseq (write-to-string GnGm1) (1+ sep)))) (m2 (read-from-string (subseq (write-to-string GnGm2) (1+ sep))))) @@ -97,8 +90,16 @@ :greater))))) +(DEFUN ENTRY (mat i j) +#| It provides the entry in row 'i' and column 'j' of the matrice 'mat' |# + (let ((p (left (chercher-hor (baselig mat i) j)))) + (if (= j (icol p)) + (val p) + 0))) + (DEFUN CONVERTMATRICE (matrice) +#| It converts a matrix of type matrice to an array |# (let* ((numfil (nlig matrice)) (numcol (ncol matrice)) (rslt (make-array (list numfil numcol) :initial-element 0))) @@ -110,16 +111,8 @@ rslt)) - -(DEFUN ENTRY (mat i j) - (let ((p (left (chercher-hor (baselig mat i) j)))) - (if (= j (icol p)) - (val p) - 0))) - - - (DEFUN CHCM-MAT2 (chcm n) +#| The same 'chcm-mat' function but it does not print on screen intermediate computations |# (declare (type chain-complex chcm) (type fixnum n)) @@ -153,41 +146,38 @@ mat))) - (DEFUN MAKE-ARRAY-TO-LISTS (array) +#| It converts an array to a list formed by its rows |# (loop for i below (array-dimension array 0) collect (loop for j below (array-dimension array 1) collect (aref array i j)))) - (DEFUN MAKE-ARRAY-FROM-LISTS (nrows ncols list) +#| It constructs an array from a list formed by its rows |# (make-array (list nrows ncols) :initial-contents list)) - (DEFUN BASIS_AUX1 (kchcm dim) (basis kchcm dim)) - (DEFUN ORGN_AUX1 (kchcm) (orgn kchcm)) - (DEFUN DFFR_AUX1(kchcm dim cmbn_list) +#| Differential of a comb with dimension 'dim' and 'cmbn_list' as its cmbn-list |# (let ((comb (cmbn dim))) (setf (cmbn-list comb) cmbn_list) (dffr kchcm comb))) - -;;;; Simplicial sets - +;;;;; SImplicial Sets ;;;;; (DEFUN BUILD-FINITE-SS2 (list) +#| The same 'build-finite-ss' function but it does not check the face relations of the simplices in 'list' ('check-smst' omitted) |# (declare (list list)) (let ((bspn (first list)) (table (finite-ss-table list)) @@ -208,5 +198,17 @@ rslt))) +(DEFUN SFINITESIMPLICIALSET_AUX1 (finitess limit) +#| It constructs a list (L0 L1 ... Lm), with m <= 'limit', where each list Lk is formed by lists of the form (S (a0 ... ak)), where each aj is a face of the k-simplex S |# + (let ((rslt NIL)) + (do ((k 1 (1+ k))) ((> k limit)) + (let ((dimk NIL)) + (dolist (simplex (basis finitess k)) + (let ((faces NIL)) + (do ((i k (1- i))) ((< i 0)) + (push (face finitess i k simplex) faces)) + (push (cons simplex faces) dimk))) + (push dimk rslt))) + (reverse rslt))) From c76ec97055a789508d46a039f332958c15e979b0 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Juli=C3=A1n=20Cuevas-Rozo?= Date: Thu, 23 May 2019 17:03:54 +0200 Subject: [PATCH 4/8] Updated --- src/sage-interface.lisp | 31 ++++++++++++++++++++++--------- 1 file changed, 22 insertions(+), 9 deletions(-) diff --git a/src/sage-interface.lisp b/src/sage-interface.lisp index d3fd157..7d1e980 100644 --- a/src/sage-interface.lisp +++ b/src/sage-interface.lisp @@ -43,7 +43,7 @@ (DEFUN KBASIS (schcm) -#| It provides the slot :basis of the KenzoSimplicialSet obtained by applying the function 'KChainComplex' to 'schcm' |# +#| Provide the slot :basis of the KenzoSimplicialSet obtained by applying the function 'KChainComplex' to 'schcm' |# (flet ((rslt (dim) (let ((pair (assoc dim schcm))) (if (null pair) @@ -54,7 +54,7 @@ (DEFUN KDFFR (schcm) -#| It provides the slot :intr-dffr of the KenzoSimplicialSet obtained by applying the function 'KChainComplex' to 'schcm' |# +#| Provide the slot :intr-dffr of the KenzoSimplicialSet obtained by applying the function 'KChainComplex' to 'schcm' |# (flet ((frslt (dim gnr) (let* ((sep (1+ (position #\G (subseq (write-to-string gnr) 1)))) (dim_gnr (read-from-string (subseq (write-to-string gnr) 1 sep))) @@ -77,7 +77,7 @@ (DEFUN G-CMPR (GnGm1 GnGm2) -#| It provides the slot :cmpr of the KenzoSimplicialSet obtained by applying the function 'KChainComplex' to 'schcm' |# +#| Provide the slot :cmpr of the KenzoSimplicialSet obtained by applying the function 'KChainComplex' to 'schcm' |# (let* ((sep (1+ (position #\G (subseq (write-to-string GnGm1) 1)))) (m1 (read-from-string (subseq (write-to-string GnGm1) (1+ sep)))) (m2 (read-from-string (subseq (write-to-string GnGm2) (1+ sep))))) @@ -91,7 +91,7 @@ (DEFUN ENTRY (mat i j) -#| It provides the entry in row 'i' and column 'j' of the matrice 'mat' |# +#| Provide the entry in row 'i' and column 'j' of the matrice 'mat' |# (let ((p (left (chercher-hor (baselig mat i) j)))) (if (= j (icol p)) (val p) @@ -99,7 +99,7 @@ (DEFUN CONVERTMATRICE (matrice) -#| It converts a matrix of type matrice to an array |# +#| Convert a matrix of type matrice to an array |# (let* ((numfil (nlig matrice)) (numcol (ncol matrice)) (rslt (make-array (list numfil numcol) :initial-element 0))) @@ -147,14 +147,14 @@ (DEFUN MAKE-ARRAY-TO-LISTS (array) -#| It converts an array to a list formed by its rows |# +#| Convert an array to a list formed by the array's rows |# (loop for i below (array-dimension array 0) collect (loop for j below (array-dimension array 1) collect (aref array i j)))) (DEFUN MAKE-ARRAY-FROM-LISTS (nrows ncols list) -#| It constructs an array from a list formed by its rows |# +#| Construct an array from a list formed by the array's rows |# (make-array (list nrows ncols) :initial-contents list)) @@ -173,7 +173,20 @@ (dffr kchcm comb))) -;;;;; SImplicial Sets ;;;;; +(DEFUN KCHAINCOMPLEX_AUX1 (chcm str_orgn) +#| Construct a chain complex in Kenzo from the information of the assoc list 'chcm' constructed from a dictionary whose values are matrices |# + (build-chcm :cmpr #'G-CMPR + :strt :GNRT + :basis (kbasis chcm) + :intr-dffr (kdffr chcm) + :orgn `(KChainComplex ,str_orgn))) + + +;;;;; Simplicial Sets ;;;;; + + +(DEFUN KABSTRACTSIMPLEX_AUX1 (degeneracies name) + (absm (dgop-ext-int degeneracies) name)) (DEFUN BUILD-FINITE-SS2 (list) @@ -199,7 +212,7 @@ (DEFUN SFINITESIMPLICIALSET_AUX1 (finitess limit) -#| It constructs a list (L0 L1 ... Lm), with m <= 'limit', where each list Lk is formed by lists of the form (S (a0 ... ak)), where each aj is a face of the k-simplex S |# +#| Construct a list (L0 L1 ... Lm), with m <= 'limit', where each list Lk is formed by lists of the form (S (a0 ... ak)), where each aj is a face of the k-simplex S |# (let ((rslt NIL)) (do ((k 1 (1+ k))) ((> k limit)) (let ((dimk NIL)) From 9d1da86a8aaee87bde358d7eb3834aec51c09adc Mon Sep 17 00:00:00 2001 From: carlos alquezar Date: Mon, 27 May 2019 20:23:16 +0200 Subject: [PATCH 5/8] updated test script --- run-kenzo-test.lisp | 15 ++++++++++++--- 1 file changed, 12 insertions(+), 3 deletions(-) diff --git a/run-kenzo-test.lisp b/run-kenzo-test.lisp index 6489768..4c53980 100644 --- a/run-kenzo-test.lisp +++ b/run-kenzo-test.lisp @@ -2,9 +2,18 @@ (DECLAIM (OPTIMIZE (speed 3) (space 0) (debug 3))) -(require 'asdf) - -(asdf:operate 'asdf:load-op 'kenzo-test) +(require :asdf) +(require :kenzo) +(require :ecl-quicklisp) +(ql:quickload "fiveam") +(push #P"./" asdf:*central-registry*) +(require :kenzo-test) +(setf fiveam:*debug-on-error* t + fiveam:*debug-on-failure* t) +(setf *debugger-hook* + (lambda (c h) + (declare (ignore c h)) + (uiop:quit -1))) (fiveam:run! :kenzo) #+(or ecl ccl) (quit) From 700546750a523d99cd8c770a821a693c15ca1374 Mon Sep 17 00:00:00 2001 From: Ana Romero Date: Wed, 12 Jun 2019 17:23:15 +0200 Subject: [PATCH 6/8] Problem in computation of homotopy groups solved --- src/anromero/homotopy.lisp | 12 +++++++++--- 1 file changed, 9 insertions(+), 3 deletions(-) diff --git a/src/anromero/homotopy.lisp b/src/anromero/homotopy.lisp index 8fcd8d5..42a3e90 100644 --- a/src/anromero/homotopy.lisp +++ b/src/anromero/homotopy.lisp @@ -119,15 +119,21 @@ (cond ((equal (car list) 1) (let* ((ch (chml-clss chcm indx)) (fib (z-whitehead chcm ch)) (ft (fibration-total fib))) - (construct-space-iterative ft (cdr list) indx))) + (progn + (kill-epis ft 1 indx) + (construct-space-iterative ft (cdr list) indx)))) ((equal (car list) 2) (let* ((ch (chml-clss chcm indx)) (fib (z2-whitehead chcm ch)) (ft (fibration-total fib))) - (construct-space-iterative ft (cdr list) indx))) + (progn + (kill-epis ft 1 indx) + (construct-space-iterative ft (cdr list) indx)))) (t (let* ((ch (chml-clss chcm indx)) (fib (zp-whitehead (car list) chcm ch)) (ft (fibration-total fib))) - (construct-space-iterative ft (cdr list) indx))) + (progn + (kill-epis ft 1 indx) + (construct-space-iterative ft (cdr list) indx)))) ))) From ee23f1128d87a554b854c356eb5456c1f4db80a6 Mon Sep 17 00:00:00 2001 From: Ana Romero Date: Wed, 19 Jun 2019 11:52:38 +0200 Subject: [PATCH 7/8] Problem with the order of generators in some computations solved --- src/smith.lisp | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/src/smith.lisp b/src/smith.lisp index 60fba3f..0e6dc4e 100644 --- a/src/smith.lisp +++ b/src/smith.lisp @@ -644,7 +644,9 @@ (if (and (symbolp gnrt1) (eq (symbol-package gnrt1) +gnrts-pckg+)) - (s-cmpr gnrt1 gnrt2) + ;;(s-cmpr gnrt1 gnrt2) + (f-cmpr (parse-integer (subseq (string gnrt1) 3)) + (parse-integer (subseq (string gnrt2) 3))) (funcall cmpr gnrt1 gnrt2))) :basis #'(lambda (degr) (declare (fixnum degr)) From 560b1e297bde466b8e119f12e4d5e9bbce1b16b4 Mon Sep 17 00:00:00 2001 From: Ana Romero Date: Wed, 19 Jun 2019 12:21:46 +0200 Subject: [PATCH 8/8] File homotopy-test added --- test/homotopy-test.lisp | 70 +++++++++++++++++++++++++++++++++++++++++ 1 file changed, 70 insertions(+) create mode 100644 test/homotopy-test.lisp diff --git a/test/homotopy-test.lisp b/test/homotopy-test.lisp new file mode 100644 index 0000000..b85447a --- /dev/null +++ b/test/homotopy-test.lisp @@ -0,0 +1,70 @@ +;;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Base: 10 -* + +(in-package :kenzo-test) + +(in-suite :kenzo) + + +(test homotopy-s2 + (cat:cat-init) + (let* ((s2 (cat:sphere 2)) + ) + (is (equalp (cat:homotopy-list s2 2 '(1)))) + (is (equalp (cat:homotopy-list s2 3 '(1)))) + (is (equalp (cat:homotopy-list s2 4 '(2)))) + (is (equalp (cat:homotopy-list s2 5 '(2)))) + (is (equalp (cat:homotopy-list s2 6 '(12)))) + )) + + +(test homotopy-s3 + (cat:cat-init) + (let* ((s3 (cat:sphere 3)) + ) + (is (equalp (cat:homotopy-list s3 2 nil))) + (is (equalp (cat:homotopy-list s3 3 '(1)))) + (is (equalp (cat:homotopy-list s3 4 '(2)))) + (is (equalp (cat:homotopy-list s3 5 '(2)))) + (is (equalp (cat:homotopy-list s3 6 '(12)))) + )) + + +(test homotopy-s4 + (cat:cat-init) + (let* ((s4 (cat:sphere 4)) + ) + (is (equalp (cat:homotopy-list s4 2 nil))) + (is (equalp (cat:homotopy-list s4 3 nil))) + (is (equalp (cat:homotopy-list s4 4 '(1)))) + (is (equalp (cat:homotopy-list s4 5 '(2)))) + (is (equalp (cat:homotopy-list s4 6 '(2)))) + (is (equalp (cat:homotopy-list s4 7 '(12 1)))) + )) + + +(test homotopy-s5 + (cat:cat-init) + (let* ((s5 (cat:sphere 5)) + ) + (is (equalp (cat:homotopy-list s5 2 nil))) + (is (equalp (cat:homotopy-list s5 3 nil))) + (is (equalp (cat:homotopy-list s5 4 nil))) + (is (equalp (cat:homotopy-list s5 5 '(1)))) + (is (equalp (cat:homotopy-list s5 6 '(2)))) + (is (equalp (cat:homotopy-list s5 7 '(2)))) + (is (equalp (cat:homotopy-list s5 8 '(24)))) + )) + +(test homotopy-s6 + (cat:cat-init) + (let* ((s6 (cat:sphere 6)) + ) + (is (equalp (cat:homotopy-list s6 2 nil))) + (is (equalp (cat:homotopy-list s6 3 nil))) + (is (equalp (cat:homotopy-list s6 4 nil))) + (is (equalp (cat:homotopy-list s6 5 nil))) + (is (equalp (cat:homotopy-list s6 6 '(1)))) + (is (equalp (cat:homotopy-list s6 7 '(2)))) + (is (equalp (cat:homotopy-list s6 8 '(2)))) + (is (equalp (cat:homotopy-list s6 9 '(24)))) + ))