(define (range first past . step)
(let* ((xs '()) (f first) (p past)
(s (cond ((pair? step) (car step))
((< f p) 1) (else -1)))
(le? (if (< 0 s) <= >=)))
(do ((x f (+ x s))) ((le? p x) (reverse xs))
(set! xs (cons x xs)))))
(define (sum xs)
(let loop ((xs xs) (s 0))
(if (null? xs) s
(loop (cdr xs) (+ s (car xs))))))
(define (take n xs)
(let loop ((n n) (xs xs) (ys '()))
(if (or (zero? n) (null? xs))
(reverse ys)
(loop (- n 1) (cdr xs)
(cons (car xs) ys)))))
(define (any? pred? xs)
(cond ((null? xs) #f)
((pred? (car xs)) #t)
(else (any? pred? (cdr xs)))))
(define rand
(let ((a 69069) (c 5)
(m (expt 2 32))
(seed 17070415))
(lambda s
(set! seed (modulo
(if (pair? s)
(numerator (inexact->exact (car s)))
(+ (* a seed) c)) m))
(/ seed m))))
(define (randint . args)
(cond ((null? args) (* (rand) (expt 2 32)))
((null? (cdr args))
(inexact->exact (floor (* (rand) (car args)))))
((< (car args) (cadr args))
(+ (inexact->exact (floor
(* (rand) (- (cadr args) (car args)))))
(car args)))
(else (+ (inexact->exact (ceiling
(* (rand) (- (cadr args) (car args)))))
(car args)))))
(define (shuffle x)
(do ((v (list->vector x)) (n (length x) (- n 1)))
((zero? n) (vector->list v))
(let* ((r (randint n)) (t (vector-ref v r)))
(vector-set! v r (vector-ref v (- n 1)))
(vector-set! v (- n 1) t))))
(define (card)
(list->vector (append
(take 5 (shuffle (range 1 16)))
(take 5 (shuffle (range 16 31)))
(take 4 (shuffle (range 31 46)))
(take 5 (shuffle (range 46 61)))
(take 5 (shuffle (range 61 76))))))
(define (bingo? card)
(define (test . xs)
(zero? (sum (map (lambda (x) (vector-ref card x)) xs))))
(or (test 0 1 2 3 4) ; B-column
(test 5 6 7 8 9) ; I-column
(test 10 11 12 13) ; N-column
(test 14 15 16 17 18) ; G-column
(test 19 20 21 22 23) ; O-column
(test 0 5 10 14 19) ; top row
(test 1 6 11 15 20) ; second row
(test 2 7 16 21) ; middle row
(test 3 8 12 17 22) ; fourth row
(test 4 9 13 18 23) ; bottom row
(test 0 6 17 23) ; nw-to-se diagonal
(test 4 8 15 19))) ; ne-to-sw diagonal
(define (play n)
(let ((cards (map (lambda (x) (card)) (range 0 n))))
(let loop ((k 0) (cage (shuffle (range 1 76))))
(if (any? bingo? cards)
(let loop ((i 0) (cards cards))
(if (bingo? (car cards))
(cons k i) ; number of calls, winner
(loop (+ i 1) (cdr cards))))
(let ((call (car cage)))
(map (lambda (card)
(do ((i 0 (+ i 1))) ((= i 24))
(if (= (vector-ref card i) call)
(vector-set! card i 0))))
cards)
(loop (+ k 1) (cdr cage)))))))
(display (sum (map (lambda (x) (car (play 1))) (range 0 1000))))