197 lines
7.8 KiB
Common Lisp
197 lines
7.8 KiB
Common Lisp
;;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Base: 10 -*
|
|
|
|
(in-package :kenzo-test)
|
|
|
|
(in-suite :kenzo)
|
|
|
|
|
|
(test normalize-loop
|
|
(cat:normalize-loop 4 cat:+empty-list+)
|
|
(cat:normalize-loop 4 '((1 a . 1)))
|
|
(cat:normalize-loop 4 '((1 a . 1) (3 b . 1) (5 b . 1))))
|
|
|
|
|
|
(test unnormalize-loop
|
|
(cat:unnormalize-loop (cat:absm 1 (cat:loop3 2 'a 3))))
|
|
|
|
|
|
(test loop3
|
|
(cat:loop3 nil)
|
|
(cat:loop3 '(1 a 2 3 b -2))
|
|
(signals simple-error (cat:loop3 '(1 a 2 3 b b)))
|
|
(signals simple-error (cat:loop3 '(1 a 2 3 b)))
|
|
(cat:loop3 1 'a 2 3 'b 4)
|
|
(signals simple-error (cat:loop3 1 'a 2 3 'b)))
|
|
|
|
|
|
(test loop-print
|
|
(print (cat:loop3 nil))
|
|
(print (cat:loop3 '(0 a 2)))
|
|
(print (cat:loop3 '(1 a 2)))
|
|
(print (cat:loop3 '(3 a 2 5 b -1 6 c 4)))
|
|
(print (cat:loop3 '(7 a 1 11 b 1 13 c 1 14 d 1)))
|
|
(print (cat:loop3 '(7 a 1 11 b 1 13 c 1 7 d 1)))
|
|
(print (cat:loop3 '(0 a 1 0 b 2 0 c -1 1 d 1))))
|
|
|
|
|
|
(test apowr-niloop
|
|
(cat:apowr-niloop #'cat:s-cmpr '(0 a . 1) cat:+empty-list+)
|
|
(cat:apowr-niloop #'cat:s-cmpr '(0 a . 1) '((1 a . 1)))
|
|
(cat:apowr-niloop #'cat:s-cmpr '(0 a . 1) '((0 b . 1)))
|
|
(cat:apowr-niloop #'cat:s-cmpr '(0 a . 1) '((0 a . 1) (0 b . 1)))
|
|
(cat:apowr-niloop #'cat:s-cmpr '(0 a . 1) '((0 a . -1) (0 b . 1))))
|
|
|
|
|
|
(test loop-space-cmpr
|
|
(let ((cmpr (cat:loop-space-cmpr #'cat:s-cmpr)))
|
|
(is (equal :greater (funcall cmpr (cat:loop3 '(1 a 2))
|
|
(cat:loop3 '(1 a -1)))))
|
|
(is (equal :greater (funcall cmpr (cat:loop3 '(3 b 4 1 a 2))
|
|
(cat:loop3 '(3 b 4 1 a -1)))))))
|
|
|
|
|
|
(test apowr-face4
|
|
(cat:cat-init)
|
|
(let ((face (cat:face (cat:delta-infinity))))
|
|
(cat:apowr-face4 face 3 4 (cat:apowr 1 31 5))
|
|
(setf face (cat:face (cat:sphere 5)))
|
|
(cat:apowr-face4 face 2 5 (cat:apowr 1 's5 4))
|
|
(cat:apowr-face4 face 2 5 (cat:apowr 2 's5 4))))
|
|
|
|
|
|
(test apowr-lastface4
|
|
(cat:cat-init)
|
|
(let ((cmpr #'cat:f-cmpr)
|
|
(face (cat:face (cat:delta-infinity))))
|
|
(cat:apowr-lastface4 cmpr face 4 (cat:apowr 0 63 1))
|
|
(cat:apowr-lastface4 cmpr face 4 (cat:apowr 0 63 -1))
|
|
(cat:apowr-lastface4 cmpr face 4 (cat:apowr 0 63 3))
|
|
(cat:apowr-lastface4 cmpr face 4 (cat:apowr 0 63 -3))
|
|
(cat:apowr-lastface4 cmpr face 4 (cat:apowr 8 31 1))
|
|
(setf face #'(lambda (indx dmns gmsm) ; dmns = 5
|
|
(case indx
|
|
(5 (cat:absm 8 'a))
|
|
(4 (cat:absm 8 'a)))))
|
|
(setf cmpr #'cat:s-cmpr)
|
|
(cat:apowr-lastface4 cmpr face 4 (cat:apowr 0 'a 2))
|
|
(setf face #'(lambda (indx dmns gmsm) ; dmns = 5
|
|
(case indx
|
|
(5 (cat:absm 1 'a))
|
|
(4 (cat:absm 8 'a)))))
|
|
(cat:apowr-lastface4 cmpr face 4 (cat:apowr 0 'a 2))
|
|
(setf face #'(lambda (indx dmns gmsm) ; dmns = 5
|
|
(case indx
|
|
(5 (cat:absm 1 'a))
|
|
(4 (cat:absm 1 'a)))))
|
|
(cat:apowr-lastface4 cmpr face 4 (cat:apowr 0 'a 2))))
|
|
|
|
|
|
(test loop-space-face
|
|
(cat:cat-init)
|
|
(let* ((cmpr #'cat:f-cmpr)
|
|
(face (cat:face (cat:delta-infinity)))
|
|
(rslt (cat:loop-space-face cmpr face)))
|
|
(funcall rslt 2 4 (cat:loop3 '(0 63 3 1 31 -3)))
|
|
(funcall rslt 2 4 (cat:loop3 '(0 63 3 0 63 -3)))
|
|
(funcall rslt 4 4 (cat:loop3 '(0 63 3 0 63 -3)))
|
|
(funcall rslt 4 4 (cat:loop3 '(0 63 3)))))
|
|
|
|
|
|
(test loop-space-grin-sintr
|
|
(cat:loop-space-grin-sintr 5 (cat:loop3 0 'a 2 3 'b -3)))
|
|
|
|
|
|
(test loop-space-grml-sintr
|
|
(let* ((cmpr #'cat:s-cmpr)
|
|
(ml (cat:loop-space-grml-sintr cmpr)))
|
|
(funcall ml 2 (cat:crpr 3 (cat:loop3) 0 (cat:loop3 0 'a 2)))
|
|
(funcall ml 2 (cat:crpr 0 (cat:loop3 0 'a 2) 3 (cat:loop3)))
|
|
(funcall ml 2 (cat:crpr 0 (cat:loop3 0 'a 2) 0 (cat:loop3 0 'a -2)))
|
|
(funcall ml 2 (cat:crpr 0 (cat:loop3 0 'a 2) 0 (cat:loop3 0 'a -3)))
|
|
(funcall ml 2 (cat:crpr 0 (cat:loop3 0 'a 2) 0 (cat:loop3 0 'b -3)))
|
|
(funcall ml 2 (cat:crpr 0 (cat:loop3 0 'a 2 0 'b -3)
|
|
0 (cat:loop3 0 'b +3 0 'a -2)))))
|
|
|
|
|
|
(test loop-space
|
|
(cat:cat-init)
|
|
(let ((g (cat:gdeltab))
|
|
basis cmbn cmbn2 dd echcm efhm hat loop-list rslt x)
|
|
(is (equal :equal (cat:cmpr g (cat:loop3 0 3 2) (cat:loop3 0 3 2))))
|
|
(is (equal :less (cat:cmpr g (cat:loop3 0 3 2) (cat:loop3 0 3 3))))
|
|
(is (equal :less (cat:cmpr g (cat:loop3 0 3 2) (cat:loop3 0 5 2))))
|
|
(is (equal :greater (cat:cmpr g (cat:loop3 0 5 2) (cat:loop3 0 3 2))))
|
|
(cat:face g 3 3 (cat:loop3 12 7 3))
|
|
(cat:face g 3 3 (cat:loop3 5 7 3))
|
|
(cat:face g 3 3 (cat:loop3 6 7 3 5 7 3 3 7 3))
|
|
(cat:face g 4 4 (cat:absm 4 (cat:loop3 6 7 3 5 7 3 3 7 3)))
|
|
(cat:check-faces (cat:cmpr g) (cat:face g) 3
|
|
(cat:loop3 6 7 -3 5 7 -3 3 7 -3))
|
|
(setf dd (cat:cmps g g))
|
|
(cat:? dd 3 (cat:loop3 6 7 3 5 7 3 3 7 3))
|
|
(cat:grml g 2 (cat:crpr 0 (cat:loop3 0 15 3) 0 (cat:loop3 0 15 4)))
|
|
(cat:grin g 2 (cat:loop3 0 15 -2))
|
|
(setf rslt (cat:loop3 0 31 1))
|
|
(setf hat (mapcar #'(lambda (i) (cat:face g i 3 rslt))
|
|
(cat:<a-b> 0 3)))
|
|
(dotimes (i 4)
|
|
(print (cat:kfll g i 3 (remove (nth i hat) hat :test #'equal)))
|
|
(cat:check-kan g i 3 (remove (nth i hat) hat :test #'equal)))
|
|
|
|
(setf g (cat:loop-space (cat:sphere 2)))
|
|
(setf rslt (cat:loop3 3 's2 2 5 's2 -2 6 's2 2))
|
|
(setf hat (mapcar #'(lambda (i) (cat:face g i 3 rslt))
|
|
(cat:<a-b> 0 3)))
|
|
(dotimes (i 4)
|
|
(print (cat:kfll g i 3 (remove (nth i hat) hat :test #'equal)))
|
|
(cat:check-kan g i 3 (remove (nth i hat) hat :test #'equal)))
|
|
|
|
(setf g (cat:loop-space (cat:sphere 3) 2))
|
|
(setf x (first (cat:basis (cat:echcm g) 4)))
|
|
(setf efhm (cat:efhm g))
|
|
(setf x (cat:lf efhm (cat:rg efhm 4 x)))
|
|
(setf rslt (cat:gnrt (first (cat:cmbn-list x))))
|
|
(setf hat (mapcar #'(lambda (i) (cat:face g i 4 rslt))
|
|
(cat:<a-b> 0 4)))
|
|
(dotimes (i 5)
|
|
(print (cat:kfll g i 4 (remove (nth i hat) hat :test #'equal)))
|
|
(cat:check-kan g i 4 (remove (nth i hat) hat :test #'equal)))
|
|
|
|
(setf rslt (cat:gnrt (third (cat:cmbn-list x))))
|
|
(setf hat (mapcar #'(lambda (i) (cat:face g i 4 rslt))
|
|
(cat:<a-b> 0 4)))
|
|
(dotimes (i 5)
|
|
(print (cat:kfll g i 4 (remove (nth i hat) hat :test #'equal)))
|
|
(cat:check-kan g i 4 (remove (nth i hat) hat :test #'equal)))
|
|
|
|
(setf g (cat:loop-space (cat:sphere 3) 2))
|
|
(setf efhm (cat:efhm g))
|
|
(setf echcm (cat:rbcc efhm))
|
|
(setf basis (cat:basis echcm 4))
|
|
(setf cmbn (cat:cmbn 4 1 (first basis) 10 (second basis)
|
|
100 (third basis)))
|
|
(setf cmbn2 (cat:lf efhm (cat:rg efhm cmbn)))
|
|
(setf loop-list (mapcar #'cdr (cat:cmbn-list cmbn2)))
|
|
(dolist (loop loop-list)
|
|
(setf hat (mapcar #'(lambda (i) (cat:face g i 4 loop))
|
|
(cat:<a-b> 0 4)))
|
|
(dotimes (i 5)
|
|
(print (cat:kfll g i 4 (remove (nth i hat) hat)))
|
|
(cat:check-kan g i 4 (remove (nth i hat) hat))))))
|
|
|
|
|
|
(test loop-space2
|
|
(cat:cat-init)
|
|
(let* ((p (cat:r-proj-space 3))
|
|
(op (cat:loop-space p))
|
|
cmpr c)
|
|
(dotimes (i 15) (print (random-apowr 8 3)))
|
|
(dotimes (i 20)
|
|
(print (cat:normalize-loop 7 (random-niloop 7 3 3))))
|
|
|
|
(setf cmpr (cat:cmpr op))
|
|
(setf cat:+too-much-time+ -1)
|
|
(setf c (random-loop-cmbn cmpr 8 10 4 4 100))
|
|
(time (cat:? op (cat:? op c)))
|
|
(time (cat:? op (cat:? op c)))))
|