Glücksrad

;-- M. Hielscher / Chr. Wagenknecht --
(define random-maker
 (let* ((multiplier 48271)
        (modulus 21474836)
        (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))))
 (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))))))))

(require-library 'sisc/libs/srfi/srfi-19)
(import srfi-19)

(define random (random-maker (time-nanosecond (current-time))))

(define gluecksrad-test
  (lambda (n)
    (do ((i 1 (+ i 1))
         (ls '(0 0 0)
             (let ([farbe (gluecksrad)])
               (cond
                 [(equal? farbe 'blau) (list (+ 1 (car ls)) (cadr ls) (caddr ls))]
                 [(equal? farbe 'gelb) (list (car ls) (+ 1 (cadr ls)) (caddr ls))]
                 [else
                  (list (car ls) (cadr ls) (+ 1 (caddr ls)))]))))
      ((> i n) ls))))

(define eps 0.1)

(define gluecksrad
  (lambda ()
     ...)

(define eps 0.1)

(define sortieren
  (lambda (ls)
    (letrec 
        ([streichen
          (lambda (el ls)
            (cond
              [(null? ls) ls]
              [(equal? el (car ls)) (cdr ls)]
              [else
               (cons (car ls) (streichen el (cdr ls)))]))]
         [sort
          (lambda (ls)
            (if (null? ls)
                ls
                (let ([z (apply min ls)])
                  (cons z (sort (streichen z ls))))))])
      (sort ls))))

(define gluecksrad-test
  (lambda (n)
    (do ((i 1 (+ i 1))
         (ls '(0 0 0)
             (let ([farbe (gluecksrad)])
               (cond
                 [(eqv? farbe 'blau) (list (+ 1 (car ls)) (cadr ls) (caddr ls))]
                 [(eqv? farbe 'gelb) (list (car ls) (+ 1 (cadr ls)) (caddr ls))]
                 [else
                  (list (car ls) (cadr ls) (+ 1 (caddr ls)))]))))
      ((> i n) ls))))

(define gluecksrad-korrekt?
  (lambda (n)
    (let ([ls (sortieren (gluecksrad-test n))])
      (and (< (abs (- 1 (/ (car ls) n 3/12))) eps)
           (< (abs (- 1 (/ (cadr ls) n 4/12))) eps)
           (< (abs (- 1 (/ (caddr ls) n 5/12))) eps)))))

(gluecksrad)

(define gluecksrad-drehen
  (lambda (n)
    (if (= n 0)
        (list 0 0 0)
        (let ([farbe (gluecksrad)] [ls (gluecksrad-drehen (- n 1))])
          (cond
            [(equal? farbe 'blau) (list (+ 1 (car ls)) (cadr ls) (caddr ls))]
            [(equal? farbe 'gelb) (list (car ls) (+ 1 (cadr ls)) (caddr ls))]
            [else
             (list (car ls) (cadr ls) (+ 1 (caddr ls)))])))))

(gluecksrad-drehen 1000)

Suche