First cl-space-efhm test extracted. This part seems to be affected by the

ICMBN-P issues.
This commit is contained in:
Gerd Heber 2015-07-10 06:58:06 -05:00
parent 6a9a2f60b9
commit 89975ca8fa
6 changed files with 756 additions and 727 deletions

View File

@ -23,4 +23,5 @@
(:file "delta-test")
(:file "bar-test")
(:file "cartesian-products-test")
(:file "cones-test")))
(:file "cones-test")
(:file "cl-space-efhm-test")))

View File

@ -86,6 +86,10 @@
Z-CHCM
ZERO-MRPH
;; cl-space-efhm.lisp
CS-HAT-U-T
;; classes.lisp
ABSM
@ -101,6 +105,7 @@
F
FACE
G
GBAR
GMSM
H
HOMOTOPY-EQUIVALENCE
@ -114,6 +119,7 @@
REDUCTION
RRDCT
TCC
TNPR
;; combinations.lisp

File diff suppressed because it is too large Load Diff

View File

@ -56,7 +56,7 @@
(funcall r 5 (cat:abar 2 (cat:d 3) 3 (cat:d 7)))))
(defun random-abar (length)
(defun random-abar1 (length)
(let ((rslt nil))
(dotimes (i length)
(let* ((gmsm (random (cat:mask 7)))
@ -71,9 +71,9 @@
(cat:cat-init)
(let ((v (cat:vrtc-bar (cat:soft-delta-infinity))))
(dotimes (i 10)
(print (random-abar 5)))
(print (random-abar1 5)))
(dotimes (i 10)
(let ((abar (random-abar 3)))
(let ((abar (random-abar1 3)))
(print abar)
(print (cat:? v (apply #'+ (mapcar #'car (cat:abar-list abar)))
abar))
@ -82,22 +82,6 @@
abar))))))))
(defun random-abar1 (tot-degr~ max-degr)
(do ((rslt nil)
(cum-degr 0 (+ cum-degr degr 1))
(degr))
((>= cum-degr tot-degr~) (cat:make-abar :list rslt))
(setf degr (1+ (random max-degr)))
(push (cat:brgn (1+ degr)
(let ((list (make-list degr)))
(mapl
#'(lambda (sublist)
(setf (car sublist) (- (random 21) 10)))
list)
list))
rslt)))
#|
(test bar-intr-hrzn-dffr
(let* ((k (cat:k-z-1))

View File

@ -0,0 +1,56 @@
(in-package :kenzo-test)
(in-suite :kenzo)
(test cs-hat-u-t
(progn
(cat:cat-init)
(let* ((c (cat:cs-hat-u-t (cat:k-z-1)))
(abar (random-abar 8 4))
(abar-degr (apply #'+ (mapcar #'car (cat:abar-list abar))))
(gnrt (cat:tnpr 5 (cat:tnpr 3 (cat:gbar 3 0 '(1 2) 0 '(3) 0 '())
2 '(4 5))
abar-degr abar)))
(dotimes (i 5) (print (random-abar 8 4)))
#|
(cat:? c (+ 5 abar-degr) gnrt)
(cat:? c (cat:? c (+ 5 abar-degr) gnrt))
(dotimes (i 10)
(let ((abar (random-abar 8 4)))
(setf abar-degr (apply #'+ (mapcar #'car (cat:abar-list abar))))
(setf gnrt (cat:tnpr 5 (cat:tnpr 3 (cat:gbar 3 0 '(1 2) 0 '(3)
0 '()) 2 '(4 5))
abar-degr abar))
(unless (>= abar-degr 10)
(print (cat:? c (+ 5 abar-degr) gnrt))
(print (cat:? c (cat:? c (+ 5 abar-degr) gnrt))))))
(dotimes (i 10)
(let ((abar (random-abar 8 4)))
(setf abar-degr (apply #'+ (mapcar #'car (cat:abar-list abar))))
(setf gnrt (cat:tnpr 6 (cat:tnpr 3 (cat:gbar 3 0 '(1 2) 0 '(3)
0 '()) 3 '(4 5 6))
abar-degr abar))
(unless (>= abar-degr 9)
(print (cat:? c (+ 6 abar-degr) gnrt))
(print (cat:? c (cat:? c (+ 6 abar-degr) gnrt))))))
(dotimes (i 10)
(let ((abar (random-abar 8 4)))
(setf abar-degr (apply #'+ (mapcar #'car (cat:abar-list abar))))
(setf gnrt (cat:tnpr 5 (cat:tnpr 2 (cat:gbar 2 0 '(3) 0 '())
3 '(4 5 6)) abar-degr abar))
(unless (>= abar-degr 10)
(print (cat:? c (+ 5 abar-degr) gnrt))
(print (cat:? c (cat:? c (+ 5 abar-degr) gnrt))))))
(dotimes (i 10)
(let ((abar (random-abar 8 4)))
(setf abar-degr (apply #'+ (mapcar #'car (cat:abar-list abar))))
(setf gnrt (cat:tnpr 4 (cat:tnpr 2 (cat:gbar 2 0 '(3) 0 '())
2 '(4 5))
abar-degr abar))
(unless (>= abar-degr 11)
(print (cat:? c (+ 4 abar-degr) gnrt))
(print (cat:? c (cat:? c (+ 4 abar-degr) gnrt))))))
|#
)))

View File

@ -168,3 +168,19 @@
cat:*dg-gd* cat:*hg*))
cat:*bc*
cat:*tc*))))))
(defun random-abar (tot-degr~ max-degr)
(do ((rslt nil)
(cum-degr 0 (+ cum-degr degr 1))
(degr))
((>= cum-degr tot-degr~) (cat:make-abar :list rslt))
(setf degr (1+ (random max-degr)))
(push (cat:brgn (1+ degr)
(let ((list (make-list degr)))
(mapl
#'(lambda (sublist)
(setf (car sublist) (- (random 21) 10)))
list)
list))
rslt)))