; green eyes
(define (sum xs) (apply + xs))
(define-syntax for
(syntax-rules ()
((for (var first past step) body ...)
(let ((ge? (if (< first past) >= <=)))
(do ((var first (+ var step)))
((ge? var past))
body ...)))
((for (var first past) body ...)
(let* ((f first) (p past) (s (if (< first past) 1 -1)))
(for (var f p s) body ...)))
((for (var past) body ...)
(let* ((p past)) (for (var 0 p) body ...)))))
(define-syntax fold-of
(syntax-rules (range in is)
((_ "z" f b e) (set! b (f b e)))
((_ "z" f b e (v range fst pst stp) c ...)
(let* ((x fst) (p pst) (s stp)
(le? (if (positive? s) <= >=)))
(do ((v x (+ v s))) ((le? p v) b)
(fold-of "z" f b e c ...))))
((_ "z" f b e (v range fst pst) c ...)
(let* ((x fst) (p pst) (s (if (< x p) 1 -1)))
(fold-of "z" f b e (v range x p s) c ...)))
((_ "z" f b e (v range pst) c ...)
(fold-of "z" f b e (v range 0 pst) c ...))
((_ "z" f b e (x in xs) c ...)
(do ((t xs (cdr t))) ((null? t) b)
(let ((x (car t)))
(fold-of "z" f b e c ...))))
((_ "z" f b e (x is y) c ...)
(let ((x y)) (fold-of "z" f b e c ...)))
((_ "z" f b e p? c ...)
(if p? (fold-of "z" f b e c ...)))
((_ f i e c ...)
(let ((b i)) (fold-of "z" f b e c ...)))))
(define-syntax list-of (syntax-rules ()
((_ arg ...) (reverse (fold-of
(lambda (d a) (cons a d)) '() arg ...)))))
(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 (choose n r)
(let loop ((n n) (r r) (c 1))
(if (zero? r) c
(loop (- n 1) (- r 1) (* c n (/ r))))))
(display (* (/ (choose 24 2) (choose 27 3)) 3))
(newline)
(define eyes (make-vector 27 'blue))
(for (i 0 3) (vector-set! eyes i 'green))
(for (i 3 16) (vector-set! eyes i 'brown))
(define (green x)
(if (eq? (vector-ref eyes x) 'green) 1 0))
(display
(length
(list-of (list a b c)
(a range 0 27)
(b range (+ a 1) 27)
(c range (+ b 1) 27)
(= (+ (green a) (green b) (green c)) 1))))
(newline)
(define (sample n m)
(let loop ((s m) (r n) (x 0) (xs '()))
(cond ((= x n) xs)
((< (rand) (/ s r))
(loop (- s 1) (- r 1) (+ x 1) (cons x xs)))
(else (loop s (- r 1) (+ x 1) xs)))))
(define (sim n)
(define (s?)
(= (sum (map green (sample 27 3))) 1))
(let loop ((n n) (g 0))
(if (zero? n) g
(loop (- n 1) (+ g (if (s?) 1 0))))))
(display (sim 2925))
(newline)