[ create a new paste ] login | about

Link: http://codepad.org/6bcXRB4Z    [ raw code | output | fork ]

programmingpraxis - Scheme, pasted on May 2:
; spectacular seven

(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 (seven n)
  (let ((wins (make-vector 8 0))
        (scores (make-vector 8 0)))
    (let loop ((k n) (p 0) (winner 0) (challenger 1)
               (queue '(2 3 4 5 6 7)))
      (cond ((zero? k) ; simulation ends
              (map (lambda (x) (exact->inexact (/ x n 1/100)))
                   (vector->list wins)))
            ((<= 7 (vector-ref scores winner)) ; game ends
              (vector-set! wins winner
                (+ (vector-ref wins winner) 1))
              (set! scores (make-vector 8 0))
              (loop (- k 1) 0 0 1 '(2 3 4 5 6 7)))
            ((< (rand) 1/2) ; current winner wins point
              (vector-set! scores winner
                (+ (vector-ref scores winner)
                   (if (<= 7 p) 2 1)))
              (loop k (+ p 1) winner (car queue)
                    (append (cdr queue) (list challenger))))
            (else ; current challenger wins point
              (vector-set! scores challenger
                (+ (vector-ref scores challenger)
                   (if (<= 7 p) 2 1)))
              (loop k (+ p 1) challenger (car queue)
                    (append (cdr queue) (list winner))))))))

(display (seven 10000))


Output:
1
(16.0 16.58 13.63 12.3 10.21 10.06 8.78 12.44)


Create a new paste based on this one


Comments: