Bergervei/Random-Test

Wiki-Quelltext dieser Seite.

<language>Scheme</language>
<code id="506b0f9020599" hidden>
(define random-maker
 (let* ((multiplier 48271)
        (modulus 2147483647)
        (apply-congruence
         (lambda (current-seed)
           (let ((candidate (modulo (* current-seed multiplier) modulus)))
             (if (zero? candidate)
                 modulus
                 candidate))))
        (coerce
         (lambda (proposed-seed)
           (if (integer? proposed-seed)
               (- modulus (modulo proposed-seed modulus))
               19860617))))  ;; an arbitrarily chosen birthday
 (lambda (initial-seed)
   (let ((seed (coerce initial-seed)))
     (lambda args
       (cond ((null? args)
              (set! seed (apply-congruence seed))
              (/ (- modulus seed) modulus))
             ((null? (cdr args))
              (let* ((proposed-top
                      (ceiling (abs (car args))))
                     (exact-top
                      (if (inexact? proposed-top)
                          (inexact->exact proposed-top)
                          proposed-top))
                     (top
                      (if (zero? exact-top)
                          1
                          exact-top)))
                (set! seed (apply-congruence seed))
                (inexact->exact (floor (* top (/ seed modulus))))))
             ((eq? (cadr args) 'reset)
              (set! seed (coerce (car args))))
             (else
              (display "random: unrecognized message")
              (newline))))))))

;(define random
;  (let ((seed (time-nanosecond (current-time))))
;    (display seed)
;    (random-maker seed)))

(require-library 'sisc/libs/srfi/srfi-19)
(import srfi-19)   ; stellt current-time usw. bereit

(define random (random-maker (time-nanosecond (current-time))))
</code>

=== Intervalltest für Zufallszahlen ===

<code id="506b10c331675">
(define random-test 
  (lambda (n max)
    (if (= max 0) 
        'ok
        (let [(z (random n))]
          (if (or (< z 0) (> z (- n 1)))
              (string-append (number->string z) " --> Fehler!")
              (random-test n (- max 1)))))))
</code>

<run id="506b10c3316ed">
(random-test 10 1000)
</run>