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") 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) diff --git a/src/sage-interface.lisp b/src/sage-interface.lisp index 34a3e8a..7d1e980 100644 --- a/src/sage-interface.lisp +++ b/src/sage-interface.lisp @@ -8,8 +8,10 @@ -(DEFVAR *ASCII-NUM-START* 48) +;;;;; Chain complexes ;;;;; + +(DEFVAR *ASCII-NUM-START* 48) (DEFVAR *ASCII-NUM-END* 57) @@ -33,7 +35,6 @@ (return (format nil "~{~a~}" (nreverse result)))))) - (DEFUN STRCAT (&rest strings) (apply 'concatenate 'string strings)) @@ -41,8 +42,8 @@ `(read-from-string (strcat "G" (itoa ,num1) "G" (itoa ,num2)))) - (DEFUN KBASIS (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) @@ -52,8 +53,8 @@ (the basis #'rslt))) - (DEFUN KDFFR (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))) @@ -75,8 +76,8 @@ #'frslt)) - (DEFUN G-CMPR (GnGm1 GnGm2) +#| 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))))) @@ -89,8 +90,16 @@ :greater))))) +(DEFUN ENTRY (mat i j) +#| 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) + 0))) + (DEFUN CONVERTMATRICE (matrice) +#| 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))) @@ -102,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)) @@ -145,8 +146,51 @@ mat))) +(DEFUN MAKE-ARRAY-TO-LISTS (array) +#| 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) +#| Construct an array from a list formed by the array's 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))) + + +(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) +#| 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)) @@ -166,5 +210,18 @@ (setf (symbol-value ind-smst) rslt) rslt))) -(DEFUN MAKE-ARRAY-FROM-LISTS (list) - (make-array (list (length list) (length (first list))) :initial-contents list)) + +(DEFUN SFINITESIMPLICIALSET_AUX1 (finitess limit) +#| 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)) + (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))) + +