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