[ create a new paste ] login | about

Link: http://codepad.org/4KOJHCo7    [ raw code | output | fork ]

programmingpraxis - Scheme, pasted on Jan 13:
; shuffle box

(define knuth
  (let* ((a 69069) (c 1234567) (m 4294967296)
         (seed (current-seconds)))
    (lambda args
      (when (pair? args) (set! seed (modulo (car args) m)))
      (set! seed (modulo (+ (* a seed) c) m))
      (/ seed m))))

(define rand ; knuth random number generator with shuffle box
  (let* ((a 69069) (c 1234567) (m 4294967296) (k 32) ; 32-bit
         ; (a 6364136223846793005) (c 1442695040888963407)
         ; (m 18446744073709551616) (k 256) ; 64-bit
         (seed (current-seconds))
         (next (lambda ()
           (set! seed (modulo (+ (* a seed) c) m)) seed))
         (init (lambda (seed) (let ((box (make-vector k)))
           (do ((j 0 (+ j 1))) ((= j k) box)
             (vector-set! box j (next))))))
         (box (init seed)))
    (lambda args
      (when (pair? args)
        (set! seed (modulo (car args) m)) (set! box (init seed)))
      (let* ((j (quotient (* k seed) m)) (n (vector-ref box j)))
        (set! seed (next)) (vector-set! box j seed) (/ n m)))))

(define minstd ; minimum standard rng with shuffle box
  (let* ((a 16807) (m 2147483647) (k 32)
         (seed (current-seconds))
         (next (lambda ()
           (set! seed (modulo (* a seed) m)) seed))
         (init (lambda (seed) (let ((box (make-vector k)))
           (do ((j 0 (+ j 1))) ((= j k) box)
             (vector-set! box j (next))))))
         (box (init seed)))
    (lambda args
      (when (pair? args)
        (set! seed (modulo (car args) m)) (set! box (init seed)))
      (let* ((j (quotient (* k seed) m)) (n (vector-ref box j)))
        (set! seed (next)) (vector-set! box j seed) (/ n m)))))

(define (randint . args)
  (let ((lo (if (pair? (cdr args)) (car args) 0))
        (hi (if (pair? (cdr args)) (cadr args) (car args))))
    (+ lo (floor (* (rand) (- hi lo))))))

(define (twenty rand)
  (let loop ((n 20) (rs (list)))
    (if (zero? n) (reverse rs)
      (loop (- n 1) (cons (randint 100) rs)))))

(display (knuth 1)) (display " ") (display (twenty knuth)) (newline)
(display (rand 1)) (display " ") (display (twenty rand)) (newline)
(display (minstd 1)) (display " ") (display (twenty minstd)) (newline)


Output:
1
2
3
325909/1073741824 (28 33 19 37 61 49 82 91 18 64 40 26 17 81 92 68 11 64 37 42)
267966617/268435456 (57 71 30 40 36 7 32 73 54 15 82 40 0 5 62 74 48 96 39 99)
1817129560/2147483647 (97 9 33 62 73 7 59 22 0 83 62 89 48 57 88 42 5 94 66 78)


Create a new paste based on this one


Comments: