fork download
copy 
  1. ; approximate median
  2.  
  3. (define rand ; knuth random number generator with shuffle box
  4.   (let* ((a 69069) (c 1234567) (m 4294967296) (k 32)
  5.          (seed 19380110) ; Happy Birthday DEK!
  6.          (next (lambda ()
  7.            (set! seed (modulo (+ (* a seed) c) m)) seed))
  8.          (init (lambda (seed) (let ((box (make-vector k)))
  9.            (do ((j 0 (+ j 1))) ((= j k) box)
  10.              (vector-set! box j (next))))))
  11.          (box (init seed)))
  12.     (lambda args
  13.       (when (pair? args)
  14.         (set! seed (modulo (car args) m)) (set! box (init seed)))
  15.       (let* ((j (quotient (* k seed) m)) (n (vector-ref box j)))
  16.         (set! seed (next)) (vector-set! box j seed) (/ n m)))))
  17.  
  18. (define (randint . args)
  19.   (let ((lo (if (pair? (cdr args)) (car args) 0))
  20.         (hi (if (pair? (cdr args)) (cadr args) (car args))))
  21.     (+ lo (floor (* (rand) (- hi lo))))))
  22.  
  23. (define (copysign magnitude sign)
  24.   (* (abs magnitude) (if (negative? sign) -1 1)))
  25.  
  26. (define (median n gen tolerance)
  27.   (let loop ((n n) (x (gen)) (average 0.0) (median 0.0))
  28.     (if (zero? n) median
  29.       (let ((average (+ (* (- x average) 0.1) average)))
  30.         (loop (- n 1) (gen) average
  31.               (+ (copysign (* average tolerance) (- x median))
  32.                  median))))))
  33.  
  34. (define (gen) (randint 101))
  35.  
  36. (display  (median 100000 gen 0.01)) (newline)
Success #stdin #stdout 0.44s 9248KB
comments (?)
stdin
copy 
Standard input is empty
stdout
copy 
50.5217285129718
https://ideone.com/9pa1tx
language:
Scheme (chicken 4.13)
created:
4 years ago
visibility:
secret

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!