fork download
copy 
  1. ; random number test
  2.  
  3. (define (digits n . args)
  4.   (let ((b (if (null? args) 10 (car args))))
  5.     (let loop ((n n) (d '()))
  6.       (if (zero? n) d
  7.           (loop (quotient n b)
  8.                 (cons (modulo n b) d))))))
  9.  
  10. (define seed 20170707)
  11.  
  12. (define (lcg) (set! seed (modulo (* 16807 seed) 2147483647)) seed)
  13.  
  14. (define (zero-pad n len)
  15.   (let* ((ds (digits n 2)))
  16.     (append (make-list (- len (length ds)) 0) ds)))
  17.  
  18. (define (make-bits n)
  19.   (let loop ((n n) (bits (list)))
  20.     (if (zero? n) bits
  21.       (loop (- n 1) (append (zero-pad (lcg) 31) bits)))))
  22.  
  23. (define (one? n) (= n 1))
  24.  
  25. (define (count-ones n)
  26.   (let* ((bits (make-bits n))
  27.          (expected (* n 31 1/2))
  28.          (std-dev (sqrt (/ n 4)))
  29.          (lo (- expected (* 2 std-dev)))
  30.          (hi (+ expected (* 2 std-dev))))
  31.     (display "Number of ones: ")
  32.     (display (length (filter one? bits)))
  33.     (newline)
  34.     (display "Expected: ")
  35.     (display (inexact->exact (round lo)))
  36.     (display " to ")
  37.     (display (inexact->exact (round hi)))
  38.     (newline)))
  39.  
  40. (count-ones 10000)
  41.  
  42. (define (max-run n)
  43.   (let* ((bits (make-bits n))
  44.          (expected (- (/ (log (* 0.5 31 n)) (log 0.5))))
  45.          (std-dev (/ (log 2)))
  46.          (lo (- expected (* 2 std-dev)))
  47.          (hi (+ expected (* 2 std-dev))))
  48.     (let loop ((bits bits) (current-run 0) (max-run 0))
  49.       (if (null? bits)
  50.           (begin
  51.             (display "Maximum run length: ")
  52.             (display max-run)
  53.             (newline)
  54.             (display "Expected: ")
  55.             (display (inexact->exact (round lo)))
  56.             (display " to ")
  57.             (display (inexact->exact (round hi)))
  58.             (newline))
  59.           (if (zero? (car bits))
  60.               (loop (cdr bits) 0 (max current-run max-run))
  61.               (loop (cdr bits) (+ current-run 1) max-run))))))
  62.  
  63. (max-run 10000)
Success #stdin #stdout 5.45s 56520KB
comments (?)
stdin
copy 
Standard input is empty
stdout
copy 
Number of ones: 155180
Expected: 154900 to 155100
Maximum run length: 20
Expected: 14 to 20
https://ideone.com/wW5NJO
language:
Scheme (guile 2.2.4)
created:
6 years ago
visibility:
public

Share or Embed source code

Discover > Sphere Engine API

The brand new service which powers Ideone!

Discover > IDE Widget

Widget for compiling and running the source code in a web browser!