; spectacular seven
(define rand
(let* ((a 3141592653) (c 2718281829)
(m (expt 2 35)) (x 5772156649)
(next (lambda ()
(let ((x-prime (modulo (+ (* a x) c) m)))
(set! x x-prime) x-prime)))
(k 103)
(v (list->vector (reverse
(let loop ((i k) (vs (list x)))
(if (= i 1) vs
(loop (- i 1) (cons (next) vs)))))))
(y (next))
(init (lambda (s)
(set! x s) (vector-set! v 0 x)
(do ((i 1 (+ i 1))) ((= i k))
(vector-set! v i (next))))))
(lambda seed
(cond ((null? seed)
(let* ((j (quotient (* k y) m))
(q (vector-ref v j)))
(set! y q)
(vector-set! v j (next)) (/ y m)))
((eq? (car seed) 'get) (list a c m x y k v))
((eq? (car seed) 'set)
(let ((state (cadr seed)))
(set! a (list-ref state 0))
(set! c (list-ref state 1))
(set! m (list-ref state 2))
(set! x (list-ref state 3))
(set! y (list-ref state 4))
(set! k (list-ref state 5))
(set! v (list-ref state 6))))
(else (init (modulo (numerator
(inexact->exact (car seed))) m))
(rand))))))
(define (seven n)
(let ((wins (make-vector 8 0))
(scores (make-vector 8 0)))
(let loop ((k n) (p 0) (winner 0) (challenger 1)
(queue '(2 3 4 5 6 7)))
(cond ((zero? k) ; simulation ends
(map (lambda (x) (exact->inexact (/ x n 1/100)))
(vector->list wins)))
((<= 7 (vector-ref scores winner)) ; game ends
(vector-set! wins winner
(+ (vector-ref wins winner) 1))
(set! scores (make-vector 8 0))
(loop (- k 1) 0 0 1 '(2 3 4 5 6 7)))
((< (rand) 1/2) ; current winner wins point
(vector-set! scores winner
(+ (vector-ref scores winner)
(if (<= 7 p) 2 1)))
(loop k (+ p 1) winner (car queue)
(append (cdr queue) (list challenger))))
(else ; current challenger wins point
(vector-set! scores challenger
(+ (vector-ref scores challenger)
(if (<= 7 p) 2 1)))
(loop k (+ p 1) challenger (car queue)
(append (cdr queue) (list winner))))))))
(display (seven 10000))