gheber / kenzo

A repackaged version of the Kenzo program by Francis Sergeraert and collaborators.
https://sur-l-analysis-sit.us/
Other
50 stars 8 forks source link

`whitehead-test` failures #144

Closed gheber closed 5 years ago

gheber commented 5 years ago
 Failure Details:
 --------------------------------
 Z2-WHITEHEAD-SINTR []: 
      Unexpected Error: #<TYPE-ERROR expected-type: LIST datum: 2>
The value 2 is not of type LIST when binding CAT-9::LIST1..
 --------------------------------
 --------------------------------
 Z-WHITEHEAD-SINTR []: 
      Unexpected Error: #<TYPE-ERROR expected-type: LIST datum: 2>
The value 2 is not of type LIST when binding CAT-9::LIST1..
 --------------------------------
sphyynx commented 5 years ago

These errors are due to later changes in the general organization of this part of the Kenzo program. And the test examples were never updated to take account of these changes. The simplest update consists in replacing the whitehead.lisp file in Kenzo-9 by the attached one, which is OK under ACL.

Le 21/05/2019 02:23, Gerd Heber a écrit :

Failure Details:

Z2-WHITEHEAD-SINTR []: Unexpected Error: #<TYPE-ERROR expected-type: LIST datum: 2> The value 2 is not of type LIST when binding CAT-9::LIST1..


Z-WHITEHEAD-SINTR []: Unexpected Error: #<TYPE-ERROR expected-type: LIST datum: 2> The value 2 is not of type LIST when binding CAT-9::LIST1..

— You are receiving this because you are subscribed to this thread. Reply to this email directly, view it on GitHub, or mute the thread.

;;; WHITEHEAD WHITEHEAD WHITEHEAD WHITEHEAD WHITEHEAD WHITEHEAD WHITEHEAD ;;; WHITEHEAD WHITEHEAD WHITEHEAD WHITEHEAD WHITEHEAD WHITEHEAD WHITEHEAD ;;; WHITEHEAD WHITEHEAD WHITEHEAD WHITEHEAD WHITEHEAD WHITEHEAD WHITEHEAD

(IN-PACKAGE "COMMON-LISP-USER")

(provide "whitehead")

;;; ;;; Z ;;;

(DEFUN Z-WHITEHEAD-SINTR (smst n chml-clss &aux (face (face smst)) (k-z-n-1 (k-z (1- n))) (idnt (bspn k-z-n-1)) ) (declare (type simplicial-set smst) (type fixnum n) (type morphism chml-clss) (type face face) (type ab-simplicial-group k-z-n-1) (type gmsm idnt)) (flet ((rslt (dmns gmsm) (declare (type fixnum dmns) (type gmsm gmsm)) (if (< dmns n) (absm (mask (1- dmns)) idnt) (z-cocycle-gbar-head n dmns (gmsm-cocycle face n dmns gmsm chml-clss))))) (the sintr #'rslt)))

|

(cat-init) (setf k (k-z 2)) (setf chml-clss (chml-clss k 2)) (setf tw (z-whitehead-sintr k 2 chml-clss)) (funcall tw 2 (gbar 2 0 '(55) 0 '())) (funcall tw 3 (gbar 3 0 '(12 23) 0 '(34) 0 '())) (funcall tw 4 (gbar 4 0 '(12 23 34) 2 '(45) 0 '(56) 0 '())) (setf k (k-z 3)) (setf chml-clss (chml-clss k 3)) (setf tw (z-whitehead-sintr k 3 chml-clss)) (tw-a-sintr3 tw 1 (absm 1 +null-gbar+) +null-gbar+) (tw-a-sintr3 tw 2 (absm 3 +null-gbar+) +null-gbar+) (tw-a-sintr3 tw 3 (absm 7 +null-gbar+) +null-gbar+) (funcall tw 3 (z-fundamental-gmsm 3 55)) (equalp (funcall tw 3 (z-fundamental-gmsm 3 55)) (absm 0 (z-fundamental-gmsm 2 55))) (funcall tw 4 (gbar 4 0 (gbar 3 0 '(12 23) 0 '(34) 0 '()) 0 (gbar 2 0 '(45) 0 '()) 1 (gbar 0) 0 (gbar 0))) |#

(DEFUN Z-WHITEHEAD (smst chml-clss &aux (n (- (degr chml-clss)))) (declare (type simplicial-set smst) (type fixnum n) (type morphism chml-clss)) (the fibration (build-smmr :sorc smst :trgt (k-z (1- n)) :degr -1 :sintr (z-whitehead-sintr smst n chml-clss) :orgn `(z-whitehead ,smst ,chml-clss))))

;;; ;;; Z/2Z ;;;

(DEFUN Z2-WHITEHEAD-SINTR (smst n chml-clss &aux (face (face smst)) (k-z2-n-1 (k-z2 (1- n))) (idnt (bspn k-z2-n-1))) (declare (type simplicial-set smst) (type fixnum n) (type morphism chml-clss) (type face face) (type ab-simplicial-group k-z2-n-1) (type gmsm idnt)) (flet ((rslt (dmns gmsm) (declare (type fixnum dmns) (type gmsm gmsm)) (if (< dmns n) (absm (mask (1- dmns)) idnt) (z2-cocycle-gbar-head n dmns (gmsm-cocycle face n dmns gmsm chml-clss)))))
(the sintr #'rslt)))

|

(cat-init) (setf k (k-z2 2)) (setf chml-clss (chml-clss k 2)) (setf tw (Z2-whitehead-sintr k 2 chml-clss)) (funcall tw 2 (gbar 2 0 1 0 '())) (funcall tw 3 (gbar 3 0 2 0 1 0 0)) (funcall tw 4 (gbar 4 0 3 2 1 0 1 0 0))

(setf k (k-z2 3)) (setf chml-clss (chml-clss k 3)) (setf tw (Z2-whitehead-sintr k 3 chml-clss)) (funcall tw 3 (Z2-fundamental-gmsm 3 1)) (equalp (funcall tw 3 (Z2-fundamental-gmsm 3 1)) (absm 0 (Z2-fundamental-gmsm 2 1))) (funcall tw 4 (gbar 4 0 (gbar 3 0 2 0 1 0 0) 0 (gbar 2 0 1 0 0) 1 (gbar 0) 0 (gbar 0))) |#

(DEFUN Z2-WHITEHEAD (smst chml-clss &aux (n (- (degr chml-clss)))) (declare (type simplicial-set smst) (type fixnum n) (type morphism chml-clss)) (the fibration (build-smmr :sorc smst :trgt (k-z2 (1- n)) :degr -1 :sintr (Z2-whitehead-sintr smst n chml-clss) :orgn `(Z2-whitehead ,smst, chml-clss))))

|

(cat-init) (setf m (moore 2 4)) (setf chml-clss (chml-clss m 4)) (setf mf (z2-whitehead m chml-clss)) (setf mt (fibration-total mf)) (homology mt 0 10) |#

gheber commented 5 years ago

Fixed in 685009d.