codepad
[
create a new paste
]
login
|
about
Language:
C
C++
D
Haskell
Lua
OCaml
PHP
Perl
Plain Text
Python
Ruby
Scheme
Tcl
(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))))
Private
[
?
]
Run code
Submit