Bergervei/Glücksrad
Aus ProgrammingWiki
Wiki-Quelltext dieser Seite.
<language>Scheme</language>
<code id="5640c170dc6a0" hidden>
;-- 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)
</code>
Ein Glücksrad besteht aus 3 blauen, 4 gelben und 5 roten Feldern.
Implementieren Sie die nullstellige Prozedur <tt>gluecksrad</tt>, die das einmalige Drehen dieses Glücksrades simuliert und die entsprechende Farbe als Symbol zurückgibt.
<code id="5640c170dc70f">
(define gluecksrad
(lambda ()
...)
</code>