The (aux games dice-of-doom) module

Dice of Doom

 Posted on October 21, 2026  |   5 min  |   Massimo Nocentini

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 ""))
Categories: scheme 

See also

The (aux anthropic) module The Anthropic Messages API, offline The (aux cml) module Events, threads, synchronous variables, the library and I/O The (aux hakaru10) modules Random sources, distributions, the language, exact inference and examples The (aux kanren) modules Arithmetic, dates, presentation of answers and a union-find miniKanren The (aux machine) modules Environments, the SC machine and the SECD machine The (aux schemer seasoned) module The Seasoned Schemer The (aux continuation) modules Classic operators, escapers, amb and Collatz sequences The (aux category) modules Monads: list, maybe, probability, ziplist, difference lists and state The (aux timsort) module Sorting and the trace buffer The (aux fds) modules Functional queues and union-find The (aux sxml) module Rendering SXML to HTML The (aux variable) module Logic variables introduced by fresh The (aux tabling) module Memoization and tabled definitions The (aux commons) module Learning tests for CHICKEN Scheme Promises delay and make-promise The Ackermann function On unary numbers, as lists Concurrent ML for CHICKEN Scheme Porting SML/NJ CML as the (aux cml) library CHICKEN Scheme Versions and implementation notes The SBRAL data structure Skew Binary Random-Access Lists Pattern matching Scheme macrology: a generalized pattern matcher The (aux hansei) modules Inference, random sources, lazy lists, logic programming and example models The (aux nondeterministic) module Learning tests for Scheme The (aux stream) modules Streams, streams after SICP, and sequences and power series The (aux unittest) module Bootstrapping a unittest framework Scheme lang: Chez, 48 and Chicken Some docs, refs and containers, respectively. The Reasoned Schemer miniKanren, microKanren and some implementations Aggregation predicates for µkanren Groups, window functions, sets and enumerations miniKanren, live and untagged Quine generation via relational interpreters Pure, declarative, and constructive arithmetic relations A declarative pearl Final shift for call/cc Direct implementation of shift and reset Call with Current Continuation Patterns Cogen in six lines The Seasoned Schemer The Little Schemer Adding generic functions to Scheme Handling control