Merge branch 'testing' of https://github.com/miguelmarco/kenzo into testing
This commit is contained in:
commit
804813be71
142
kenzo.asd
142
kenzo.asd
@ -1,71 +1,71 @@
|
||||
;;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Base: 10 -*
|
||||
|
||||
(in-package :cl-user)
|
||||
|
||||
(defpackage :kenzo-asd
|
||||
(:use :cl :asdf))
|
||||
|
||||
(in-package :kenzo-asd)
|
||||
|
||||
(asdf:defsystem #:kenzo
|
||||
:description "A Symbolic Software for Effective Homology Computation by Francis Sergeraert"
|
||||
:version "1.1.7"
|
||||
:author "Francis Sergeraert <Francis.Sergeraert@ujf-grenoble.fr>"
|
||||
:license "GPLv3"
|
||||
:serial t
|
||||
:components
|
||||
((:file "package")
|
||||
(:module "src"
|
||||
:components
|
||||
(
|
||||
(:file "kenzo")
|
||||
(:file "abbreviations")
|
||||
(:file "macros")
|
||||
(:file "various")
|
||||
(:file "classes")
|
||||
(:file "combinations")
|
||||
(:file "chain-complexes")
|
||||
(: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")
|
||||
(:file "sage-interface")
|
||||
(:module "anromero"
|
||||
:components
|
||||
((:file "resolutions")
|
||||
(:file "cylinders")
|
||||
(:file "fundamental-classes")
|
||||
(:file "homotopy")
|
||||
(:file "bicomplexes")
|
||||
(:file "filtered-complexes")
|
||||
(:file "spectral-sequences")
|
||||
(:file "persistent-homology")
|
||||
))))))
|
||||
;;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Base: 10 -*
|
||||
|
||||
(in-package :cl-user)
|
||||
|
||||
(defpackage :kenzo-asd
|
||||
(:use :cl :asdf))
|
||||
|
||||
(in-package :kenzo-asd)
|
||||
|
||||
(asdf:defsystem #:kenzo
|
||||
:description "A Symbolic Software for Effective Homology Computation by Francis Sergeraert"
|
||||
:version "1.1.7"
|
||||
:author "Francis Sergeraert <Francis.Sergeraert@ujf-grenoble.fr>"
|
||||
:license "GPLv3"
|
||||
:serial t
|
||||
:components
|
||||
((:file "package")
|
||||
(:module "src"
|
||||
:components
|
||||
(
|
||||
(:file "kenzo")
|
||||
(:file "abbreviations")
|
||||
(:file "macros")
|
||||
(:file "various")
|
||||
(:file "classes")
|
||||
(:file "combinations")
|
||||
(:file "chain-complexes")
|
||||
(: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")
|
||||
(:file "sage-interface")
|
||||
(:module "anromero"
|
||||
:components
|
||||
((:file "resolutions")
|
||||
(:file "cylinders")
|
||||
(:file "fundamental-classes")
|
||||
(:file "homotopy")
|
||||
(:file "bicomplexes")
|
||||
(:file "filtered-complexes")
|
||||
(:file "spectral-sequences")
|
||||
(:file "persistent-homology")
|
||||
))))))
|
||||
|
||||
@ -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)
|
||||
|
||||
@ -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))))
|
||||
)))
|
||||
|
||||
|
||||
|
||||
@ -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)))
|
||||
|
||||
|
||||
|
||||
@ -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))
|
||||
|
||||
70
test/homotopy-test.lisp
Normal file
70
test/homotopy-test.lisp
Normal file
@ -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))))
|
||||
))
|
||||
Loading…
Reference in New Issue
Block a user