mmarco/kenzo
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

Computation of homotopy groups (null groups included)

Browse Source
This commit is contained in:
Ana Romero 2019-05-08 18:04:18 +02:00
parent a80dd83a67
commit 4ffed16284
2 changed files with 213 additions and 204 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

21
kenzo.asd
View File

@ -17,7 +17,8 @@
((:file "package") ((:file "package")
(:module "src" (:module "src"
:components :components
((:file "kenzo") (
(:file "kenzo")
(:file "abbreviations") (:file "abbreviations")
(:file "macros") (:file "macros")
(:file "various") (:file "various")
@ -56,16 +57,16 @@
(:file "cl-space-efhm") (:file "cl-space-efhm")
(:file "whitehead") (:file "whitehead")
(:file "smith") (:file "smith")
(:file "sage-interface")
(:module "anromero" (:module "anromero"
:components :components
((:file "resolutions")
(:file "cylinders")
(:file "fundamental-classes")
(:file "homotopy")
(:file "bicomplexes")))
#|
((:file "bicomplexes") ((:file "bicomplexes")
(:file "filtered-complexes") (:file "filtered-complexes")
(:file "spectral-sequences") (:file "spectral-sequences")))
(:file "resolutions") |#
(:file "cylinders") ))))
(:file "fundamental-classes")
(:file "homotopy")))
))))

26
src/anromero/homotopy.lisp
View File

@ -6,6 +6,7 @@
;;; Authors: Jonathan Heras and Ana Romero ;;; Authors: Jonathan Heras and Ana Romero
(IN-PACKAGE #:cat) (IN-PACKAGE #:cat)
(provide "homotopy") (provide "homotopy")
@ -55,14 +56,15 @@
(ft (fibration-total (eval fib))) (ft (fibration-total (eval fib)))
(result (homology-format (eval ft) (1+ indx)))) (result (homology-format (eval ft) (1+ indx))))
(if (= (1+ indx) n-hom) (if (= (1+ indx) n-hom)
(homology-format (eval ft) n-hom) (homology-format (eval ft) n-hom)
(if (string= "NIL" result) result
(if (string= "Z " result) (if (string= "Z " result)
(compute-homotopy-z-xslt n-hom ft (1+ indx)) (compute-homotopy-z-xslt n-hom ft (1+ indx))
(if (string= "Z/2Z " result) (if (string= "Z/2Z " result)
(compute-homotopy-z2-xslt n-hom ft (1+ indx)) (compute-homotopy-z2-xslt n-hom ft (1+ indx))
(if (and (string= (subseq result 0 2) "Z/") (string= (subseq result (search "Z" result :start2 2)) "Z")) (if (and (string= (subseq result 0 2) "Z/") (string= (subseq result (search "Z" result :start2 2)) "Z"))
(compute-homotopy-zp-xslt n-hom ft (1+ indx) (read-from-string (subseq result 2 (search "Z" result :start2 2)))) (compute-homotopy-zp-xslt n-hom ft (1+ indx) (read-from-string (subseq result 2 (search "Z" result :start2 2))))
(compute-homotopy-several-xslt n-hom ft (1+ indx) result))))))) (compute-homotopy-several-xslt n-hom ft (1+ indx) result))))))))
(DEFUN COMPUTE-HOMOTOPY-Z2-XSLT (n-hom obj indx) (DEFUN COMPUTE-HOMOTOPY-Z2-XSLT (n-hom obj indx)
@ -71,14 +73,15 @@
(ft (fibration-total (eval fib))) (ft (fibration-total (eval fib)))
(result (homology-format (eval ft) (1+ indx)))) (result (homology-format (eval ft) (1+ indx))))
(if (= (1+ indx) n-hom) (if (= (1+ indx) n-hom)
(homology-format (eval ft) n-hom) (homology-format (eval ft) n-hom)
(if (string= "NIL" result) result
(if (string= "Z " result) (if (string= "Z " result)
(compute-homotopy-z-xslt n-hom ft (1+ indx)) (compute-homotopy-z-xslt n-hom ft (1+ indx))
(if (string= "Z/2Z " result) (if (string= "Z/2Z " result)
(compute-homotopy-z2-xslt n-hom ft (1+ indx)) (compute-homotopy-z2-xslt n-hom ft (1+ indx))
(if (and (string= (subseq result 0 2) "Z/") (string= (subseq result (search "Z" result :start2 2)) "Z")) (if (and (string= (subseq result 0 2) "Z/") (string= (subseq result (search "Z" result :start2 2)) "Z"))
(compute-homotopy-zp-xslt n-hom ft (1+ indx) (read-from-string (subseq result 2 (search "Z" result :start2 2)))) (compute-homotopy-zp-xslt n-hom ft (1+ indx) (read-from-string (subseq result 2 (search "Z" result :start2 2))))
(compute-homotopy-several-xslt n-hom ft (1+ indx) result))))))) (compute-homotopy-several-xslt n-hom ft (1+ indx) result))))))))
(DEFUN COMPUTE-HOMOTOPY-ZP-XSLT (n-hom obj indx n) (DEFUN COMPUTE-HOMOTOPY-ZP-XSLT (n-hom obj indx n)
@ -87,18 +90,21 @@
(ft (fibration-total (eval fib))) (ft (fibration-total (eval fib)))
(result (homology-format (eval ft) (1+ indx)))) (result (homology-format (eval ft) (1+ indx))))
(if (= (1+ indx) n-hom) (if (= (1+ indx) n-hom)
(homology-format (eval ft) n-hom) (homology-format (eval ft) n-hom)
(if (string= "NIL" result) result
(if (string= "Z " result) (if (string= "Z " result)
(compute-homotopy-z-xslt n-hom ft (1+ indx)) (compute-homotopy-z-xslt n-hom ft (1+ indx))
(if (string= "Z/2Z " result) (if (string= "Z/2Z " result)
(compute-homotopy-z2-xslt n-hom ft (1+ indx)) (compute-homotopy-z2-xslt n-hom ft (1+ indx))
(if (and (string= (subseq result 0 2) "Z/") (string= (subseq result (search "Z" result :start2 2)) "Z")) (if (and (string= (subseq result 0 2) "Z/") (string= (subseq result (search "Z" result :start2 2)) "Z"))
(compute-homotopy-zp-xslt n-hom ft (1+ indx) (read-from-string (subseq result 2 (search "Z" result :start2 2)))) (compute-homotopy-zp-xslt n-hom ft (1+ indx) (read-from-string (subseq result 2 (search "Z" result :start2 2))))
(compute-homotopy-several-xslt n-hom ft (1+ indx) result))))))) (compute-homotopy-several-xslt n-hom ft (1+ indx) result))))))))
(DEFUN SPLIT-COMPONENTS (string) (DEFUN SPLIT-COMPONENTS (string)
(let ((term (if (string= string "") "" (subseq string 0 2)))) (let ((term (if (string= string "") ""
(if (string= string "NIL") NIL
(subseq string 0 2)))))
(if (string= term "Z ") (if (string= term "Z ")
(cons 1 (split-components (subseq string 2))) (cons 1 (split-components (subseq string 2)))
(if (string= term "Z/") (if (string= term "Z/")
@ -129,14 +135,15 @@
(let* ((ft (construct-space-iterative obj (split-components hom) indx)) (let* ((ft (construct-space-iterative obj (split-components hom) indx))
(result (homology-format ft (1+ indx)))) (result (homology-format ft (1+ indx))))
(if (= (1+ indx) n-hom) (if (= (1+ indx) n-hom)
(homology-format (eval ft) n-hom) (homology-format (eval ft) n-hom)
(if (string= "NIL" result) result
(if (string= "Z " result) (if (string= "Z " result)
(compute-homotopy-z-xslt n-hom ft (1+ indx)) (compute-homotopy-z-xslt n-hom ft (1+ indx))
(if (string= "Z/2Z " result) (if (string= "Z/2Z " result)
(compute-homotopy-z2-xslt n-hom ft (1+ indx)) (compute-homotopy-z2-xslt n-hom ft (1+ indx))
(if (and (string= (subseq result 0 2) "Z/") (string= (subseq result (search "Z" result :start2 2)) "Z")) (if (and (string= (subseq result 0 2) "Z/") (string= (subseq result (search "Z" result :start2 2)) "Z"))
(compute-homotopy-zp-xslt n-hom ft (1+ indx) (read-from-string (subseq result 2 (search "Z" result :start2 2)))) (compute-homotopy-zp-xslt n-hom ft (1+ indx) (read-from-string (subseq result 2 (search "Z" result :start2 2))))
(compute-homotopy-several-xslt n-hom ft (1+ indx) result))))))) (compute-homotopy-several-xslt n-hom ft (1+ indx) result))))))))
(DEFUN COMPUTE-HOMOTOPY2-XSLT (n-hom obj degree hom) (DEFUN COMPUTE-HOMOTOPY2-XSLT (n-hom obj degree hom)
@ -191,3 +198,4 @@