[ create a new paste ] login | about

Project: programmingpraxis
Link: http://programmingpraxis.codepad.org/54PDMDSv    [ raw code | output | fork ]

programmingpraxis - Scheme, pasted on Jul 19:
; let's make a deal

(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 (randint . args)
  (cond ((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 (monty n)
  (let monty ((n n) (switch 0) (stay 0))
    (let ((auto (randint 3)) (pick (randint 3)))
      (cond ((zero? n) (values switch stay))
            ((= auto pick) (monty (- n 1) switch (+ stay 1)))
            (else (monty (- n 1) (+ switch 1) stay))))))

(call-with-values
  (lambda () (monty 100000))
  (lambda (switch stay)
    (display "switch: ") (display switch) (newline)
    (display "stay:   ") (display stay) (newline)))


Output:
1
2
switch: 66824
stay:   33176


Create a new paste based on this one


Comments: