The (aux games dice-of-doom) module
Dice of Doom
test/dice-of-doom/initial: pass
(define (test/dice-of-doom/initial _)
(let1 (boards (seeded-boards))
(⊦= "\n B-2 B-2 \n B-2 B-2 " (to-string (list-ref boards 0)))
(⊦= #((A 4) (A 3) (A 3) (B 2)) (board-cells (list-ref boards 1)))
(⊦= '(2 1 3) (stream:->list (neighbors 0 (list-ref boards 2))))
(⊦= '(3 0) (stream:->list (neighbors 1 (list-ref boards 3))))
(⊦= '(0 3) (stream:->list (neighbors 2 (list-ref boards 4))))
(⊦= '(1 0 2) (stream:->list (neighbors 3 (list-ref boards 5))))
(⊦= #((A 3) (A 1) (B 3) (A 2))
(board-cells
(board-attack
(make-board #((A 3) (A 3) (B 3) (B 1)) 2)
'A
1
3
3)))
(⊦= #((A 2) (B 3) (A 3) (B 1))
(board-cells
(add-new-dice (make-board #((A 1) (B 3) (A 2) (B 1)) 2) 'A 2)))
(⊦= '(A "\n A-1 B-1 \n A-2 B-1 "
(((cell 2 attacks 3)
(A "\n A-1 B-1 \n A-1 A-1 "
((pass (B "\n A-1 B-1 \n A-1 A-1 " ())))))))
(game-tree->sexp
(game-tree
(make-board #((A 1) (B 1) (A 2) (B 1)) 2)
(apply circular-list '(A B))
0
#t)))
(⊦= '(A) (winners (make-board #((A 1) (B 1) (A 1) (A 1)) 2)))
(⊦= "\n A-4 B-1 B-4 A-3 A-4 \n B-1 A-2 A-1 A-2 A-1 \n A-1 B-3 B-4 A-1 A-3 \n A-2 B-3 B-2 A-2 B-4 \n A-1 A-4 A-1 B-3 B-2 "
(with-output-to-string (τ (display (list-ref boards 6)))))
(⊦= transcript/4x4
(with-output-to-string
(τ (let ((board (list-ref boards 7))
(players (apply circular-list '(A B))))
((computer-vs-computer 4)
(game-tree board players 0 #t))))))))
((eta 0.009) (memory #(12582912 2448536 1048576)) (stdout "") (stderr ""))
test/dice-of-doom/literal-boards: pass
(define (test/dice-of-doom/literal-boards _)
(let1 (boards (seeded-boards))
(⊦= (board-cells board/5x5) (board-cells (list-ref boards 6)))
(⊦= (board-cells board/4x4) (board-cells (list-ref boards 7))))
(⊦= "\n A-4 B-1 B-4 A-3 A-4 \n B-1 A-2 A-1 A-2 A-1 \n A-1 B-3 B-4 A-1 A-3 \n A-2 B-3 B-2 A-2 B-4 \n A-1 A-4 A-1 B-3 B-2 "
(with-output-to-string (τ (display board/5x5))))
(⊦= '(2 1 3) (stream:->list (neighbors 0 board/2x2)))
(⊦= '(3 0) (stream:->list (neighbors 1 board/2x2)))
(⊦= '(0 3) (stream:->list (neighbors 2 board/2x2)))
(⊦= '(1 0 2) (stream:->list (neighbors 3 board/2x2)))
(for-each
(λ (pos)
(⊦= (stream:->list (neighbors pos board/5x5))
(stream:->list (neighbors/size pos 5)))
(⊦= (stream:->list (neighbors pos board/5x5))
(stream:->list
(neighbors pos (make-board (make-vector 25 '(C 2)) 5)))))
(iota 25))
(⊦= '(5 1 6) (stream:->list (neighbors/size 0 5)))
(⊦= '(19 18 23) (stream:->list (neighbors/size 24 5)))
(call+stdout
(τ ((computer-vs-computer 4)
(game-tree board/4x4 (apply circular-list '(A B)) 0 #t)))
(λ (result transcript) (⊦= '(A) result) (⊦= transcript/4x4 transcript))))
((eta 0.005) (memory #(12582912 2457488 1048576)) (stdout "") (stderr ""))
test/dice-of-doom/gen-board/shape: pass
(define (test/dice-of-doom/gen-board/shape _)
(let1 (b (gen-board 5 '(A B) 4))
(⊦= 5 (board-size b))
(⊦= 25 (board-hexnum b))
(⊦= 25 (vector-length (board-cells b)))
(⊨ (every (λ (hex)
(and (memq (car hex) '(A B)) (<= 1 (cadr hex) 4) #t))
(vector->list (board-cells b))))))
((eta 0.0) (memory #(12582912 2459712 1048576)) (stdout "") (stderr ""))
test/dice-of-doom/printer: pass
(define (test/dice-of-doom/printer _)
(⊦= "\nCurrent player: A\nBoard:\n A-1 B-1 \n A-2 B-1 "
(with-output-to-string (τ (display (make-gametree 'A board/2x2 '())))))
(⊦= "[\n A-1 B-1 \n A-2 B-1 ]"
(with-output-to-string
(τ (let1 (s (open-output-string))
(display board/2x2 s)
(display "[")
(display (get-output-string s))
(display "]"))))))
((eta 0.0) (memory #(12582912 2461352 1048576)) (stdout "") (stderr ""))
test/dice-of-doom/game-tree/tabled: pass
(define (test/dice-of-doom/game-tree/tabled _)
(let ((t₁ (game-tree board/2x2 (apply circular-list '(A B)) 0 #t))
(t₂ (game-tree board/2x2 (list/circular 'A 'B) 0 #t)))
(⊨ (eq? t₁ t₂)))
(⊦= '(A B C) (players-rotation (circular-list 'A 'B 'C)))
(⊦= '(B C A) (players-rotation (cdr (circular-list 'A 'B 'C)))))
((eta 0.0) (memory #(12582912 2461104 1048576)) (stdout "") (stderr ""))
test/dice-of-doom/game-tree/key-hash: pass
(define (test/dice-of-doom/game-tree/key-hash _)
(let* ((cells (let C ((n 4))
(cond ((zero? n) '(()))
(else
(append-map
(λ (rest)
(append-map
(λ (p)
(map (λ (d) (cons (list p d) rest)) '(1 2 3)))
'(A B)))
(C (sub1 n)))))))
(boards (map (λ (cs) (make-board (list->vector cs) 2)) cells))
(H (λ (b) (game-tree/key-hash (list b '(A B) 0 #f) 1000003))))
(⊦= 1296 (length boards))
(⊨ (> (length (delete-duplicates (map H boards))) 1200))
(let1 (copy (make-board (vector-copy (board-cells board/2x2)) 2))
(⊦= (H board/2x2) (H copy))
(⊨ (eq? (game-tree board/2x2 (circular-list 'A 'B) 0 #f)
(game-tree copy (circular-list 'A 'B) 0 #f))))))
((eta 0.024) (memory #(12582912 2758504 1048576)) (stdout "") (stderr ""))
test/dice-of-doom/game-tree/turn-order: pass
(define (test/dice-of-doom/game-tree/turn-order _)
(let* ((b (make-board #((A 1) (B 1) (A 2) (C 1)) 2))
(next-after-pass (λ (t) (car (cadr (car (stream:->list (caddr t)))))))
(t/ABC (game-tree b (circular-list 'A 'B 'C) 0 #f))
(t/ACB (game-tree b (circular-list 'A 'C 'B) 0 #f)))
(⊨ (not (eq? t/ABC t/ACB)))
(⊦= 'B (next-after-pass t/ABC))
(⊦= 'C (next-after-pass t/ACB)))
(let ((t/AB (game-tree board/2x2 (circular-list 'A 'B) 0 #t))
(t/AC (game-tree board/2x2 (circular-list 'A 'C) 0 #t)))
(⊨ (not (eq? t/AB t/AC)))
(⊦= 'B
(car (cadr (car (stream:->list
(caddr (cadr (car (stream:->list (caddr t/AB))))))))))
(⊦= 'C
(car (cadr (car (stream:->list
(caddr (cadr (car (stream:->list (caddr t/AC))))))))))))
((eta 0.0) (memory #(12582912 2765368 1048576)) (stdout "") (stderr ""))
test/dice-of-doom/winners/tie: pass
(define (test/dice-of-doom/winners/tie _)
(⊦= '(A B) (winners (make-board #((A 1) (B 1) (B 1) (A 1)) 2)))
(⊦= "\nThe game is a tie between (A B)"
(with-output-to-string
(τ (announce-winner (make-board #((A 1) (B 1) (B 1) (A 1)) 2))))))
((eta 0.0) (memory #(12582912 2766664 1048576)) (stdout "") (stderr ""))
test/dice-of-doom/heuristics: pass
(define (test/dice-of-doom/heuristics _)
(⊦= '(#f #f #f #t) (map (λ (pos) (threatened pos board/2x2)) '(0 1 2 3)))
(⊦= 2 (score-board board/2x2 'A))
(⊦= 1 (score-board board/2x2 'B)))
((eta 0.0) (memory #(12582912 2768008 1048576)) (stdout "") (stderr ""))
test/dice-of-doom/ratings: pass
(define (test/dice-of-doom/ratings _)
(let1 (t (game-tree board/2x2 (apply circular-list '(A B)) 0 #t))
(⊦= '(5) (get-ratings t 'A))
(⊦= 5 ((rate-position 'A) t))
(⊦= 5
(rate-position/αβ t 'A most-positive-fixnum most-negative-fixnum))
(⊦= '(5)
(get-ratings/αβ-max
t
'A
most-positive-fixnum
most-negative-fixnum))
(⊦= '(A "\n A-1 B-1 \n A-1 A-1 "
((pass (B "\n A-1 B-1 \n A-1 A-1 " ()))))
(game-tree->sexp (handle-computer t)))))
((eta 0.001) (memory #(12582912 2470432 1048576)) (stdout "") (stderr ""))
test/dice-of-doom/limit-tree-depth: pass
(define (test/dice-of-doom/limit-tree-depth _)
(let1 (t (game-tree board/2x2 (apply circular-list '(A B)) 0 #t))
(⊨ (stream:null? (caddr ((limit-tree-depth 0) t))))
(⊦= '(A "\n A-1 B-1 \n A-2 B-1 "
(((cell 2 attacks 3) (A "\n A-1 B-1 \n A-1 A-1 " ()))))
(game-tree->sexp ((limit-tree-depth 1) t)))
(⊦= (game-tree->sexp t) (game-tree->sexp ((limit-tree-depth 5) t)))))
((eta 0.001) (memory #(12582912 2471712 1048576)) (stdout "") (stderr ""))