TuH2 scheme
Aus ProgrammingWiki
Wiki-Quelltext dieser Seite.
<language>Scheme</language>
<language>Scheme</language>
<language>Scheme</language>
<language>Scheme</language>
=== Scheme Programmbeispiele ===
Für die Ausführung der Hauptprogramme sind diverse Hilfsprozeduren nötig.
*zzls - Erstellt eine Zufallszahlenliste
*mv-mergesort - Sortiert eine Liste
*teillisten2 - teilt eine Liste; wird von mv-mergesort und binaersuche benötigt
*verbinden - verbindet zwei Listen; wird von mv-mergesort benötigt
Der Programmcode der Hilfsprozeduren ist am Schluss dieser Wikiseite zu finden.
Der Scheme-Interpreter versteht das Sprachelement <tt>random</tt> zunächst noch nicht. Eine hier "versteckte" Prozedur definiert eine "Glücksrad-Fabrik", die im Folgenden verwendet wird, um einen Zufallszahlen-Generator (<tt>random</tt>) zu erzeugen.
<code 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))))))))
</code>
<eval>
(let ((random (random-maker 19781116))) ; beliebige (grosse) natuerliche Zahl
(list (random 10)(random 10)(random 10)(random 10))) ; Zufallszahl zwischen 0 und 9 (einschl. der Grenzen)
</eval>
Nun können wir die entsprechenden Hilfsprozeduren zur Erzeugung von Zufallslisten definieren.
<code>
(define zzls
(lambda (a e n)
(let ((random (random-maker 19781116)))
(letrec
((helper
(lambda (k)
(if (= k 0)
'()
(cons (+ a (random (- e a))) (helper (- k 1)))))))
(helper n)))))
</code>
<eval>(zzls 2 10 20)</eval>
=== Hauptprogramme ===
== Beispielliste ==
Zu Anfangs definieren wir uns eine Liste mit Zufallszahlen. Dazu verwenden wir die Hilfsprozedur '''zzls'''.
Die Liste soll aus 20 Zahlen zwischen 1 und 100 bestehen.
<code>(define liste (zzls 1 100 20)) </code>
Anschließend soll die Liste aufsteigend sortiert werden. Dazu verwenden wir die Hilfsprozedur '''mv-mergesort'''.
Die sortierte Liste wird in '''liste2''' gebunden.
<code>(define liste2 (mv-mergesort liste))</code>
== einfache Binaere Suche ==
Die Prozedur erwartet als Argumente die Gesuchte Zahl und eine sortierte Eingabeliste. Wenn die gesuchte Zahl gefunden wurde, erhält man die Ausgabe "Schlüssel gefunden", andernfalls die Ausgabe "Schlüssel nicht Enthalten". Der Index des gesuchten Begriffs wird nicht zurückgegeben.
<code>
(define binaersuche
(lambda (x ls)
(call-with-values
(lambda () (teillisten2 ls))
(lambda (lls rls)
(cond
((null? rls) "Schluessel nicht enthalten")
((= x (car rls)) "Schluessel gefunden")
((< x (car rls))
(if (null? lls)
"Schluessel nicht enthalten"
(binaersuche x lls)))
(else
(if (null? (cdr rls))
"Schluessel nicht enthalten"
(binaersuche x rls))))))))
</code>
<eval>(binaersuche 42 liste2)</eval>
Dieses Ergebnis ist noch recht unbefriedigend. Wir erweitern die Prozedur deshalb um zwei Funktionalitäten:
*Die Anzahl der rekursiven Aufrufe soll festgehalten werden. Dies wird für die Empirische Effizienzanalyse benötigt.
Dazu wird ein Zähler '''calls''' definiert, der vor jedem rekursiven Aufruf inkrementiert wird. Nach Abarbeitung der Prozedur kann dieser Zähler zur Analyse herangezogen werden.
*Es soll nicht nur herausgefunden werden, ob ein Element in der Liste enthalten ist, sondern auch die Stelle des gefundenen Elements innerhalb der Liste.
Wir definieren für die Eigentliche Suche die Prozedur '''binsuche''' und für den Aufruf die Prozedur '''binaersuche2'''. Diese hat die Aufgabe sicherzustellen, dass der Rekursionszähler und der Index-Zähler vor jedem Aufruf auf 0 gesetzt wird.
= Binaersuche2 =
<code>
;binhelfer - binaere suche mit Indexausgabe
(define binhelfer
(lambda (x ls)
(call-with-values
(lambda () (teillisten2 ls))
(lambda (lls rls)
(cond
((null? rls) "Schluessel nicht enthalten")
((= x (car rls)) (and (and (set! index (+ index (length lls))) (and (string-append "Schluessel gefunden an Stelle " (number->string index))))))
((< x (car rls))
(if (null? lls)
"Schluessel nicht enthalten"
(and (set! calls(+ calls 1))
(binhelfer x lls))))
(else
(if (null? (cdr rls))
"Schluessel nicht enthalten"
(and (set! calls(+ calls 1))
(and (set! index (+ index (length lls)))(binhelfer x rls))))))))))
</code>
<code>
(define index 0)
(define calls 0)
(define binaersuche2
(lambda (x ls)
(set! index 0)
(set! calls 0)
(binhelfer x ls)))
</code>
<eval>(binaersuche2 42 liste2)</eval>
Nachdem man die Suche durchgeführt hat, kann man die Variable ''calls'' zur Empirischen Effizienzanalyse auswerten.
Zum Vergleich hier eine Implementierung der Sequenziellen Suche mit Zähler.
<code>
(define seqsuche2
(lambda (x ls)
(cond
((null? ls) "Schluessel nicht enthalten.")
((= x (car ls)) "Schluessel gefunden.")
((< (car ls) x)(set! calls(+ calls 1))(seqsuche2 x (cdr ls)))
(else "Schluessel nicht enthalten."))))
</code>
Auch hier kann im Anschluss die Zählervariable ''calls'' ausgewertet werden. Bei einer sortierten Liste entspricht die Anzahl der Rekursionsaufrufe gleichzeitig auch dem Index des gesuchten Elements (sofern das Element enthalten ist).
=== Hilfsprozeduren ===
== zzls ==
<code>
;zzls für ZufallsZahlenListe. Generiert eine Liste mit n paarweise verschiedenen Ganzen Zahlen zwischen a und b.
;Beispielaufruf:
;>(zzls 10 100 1000) ; Zufallszahlenliste mit 1000 Zufallszahlen zwischen 10 und 100
(define zzls
(lambda (a b n)
(if (= n 0)
(list)
(let ((x (random b)))
(if (> x a)
(append (list x)(zzls a b (- n 1)))
(zzls a b n))))))
</code>
== mv-mergesort ==
Die Prozedur ist aus "Teilen und Herschen 1" bekannt. Sie sortiert eine gegebene Liste der Größe nach.
<code>
;mv-mergesort
(define mv-mergesort
(lambda (ls)
(if (or (null? ls)(null? (cdr ls)))
ls
(call-with-values
(lambda () (teillisten2 ls))
(lambda (ls1 ls2)
(verbinden
(mv-mergesort ls1)
(mv-mergesort ls2)))))))</code>
== teillisten2 ==
Teilt eine Liste in zwei Teillisten.
<code>
(define teillisten2
(lambda (ls)
(let ((k (floor (/ (length ls) 2))))
(letrec
((helfer
(lambda (ls i)
(if (= i 0)
(values '() ls)
(call-with-values
(lambda ()(helfer (cdr ls)(- i 1)))
(lambda (links rechts)
(values (cons (car ls) links) rechts)))))))
(helfer ls k)))))
</code>
== verbinden ==
Verbindet zwei Listen zu einer einzigen Liste
<code>
(define verbinden
(lambda (lls rls)
(cond
((null? lls) rls)
((null? rls) lls)
(else
(let ((x (car lls))(y (car rls)))
(if (< x y)
(cons x (verbinden (cdr lls) rls))
(cons y (verbinden lls (cdr rls)))))))))
</code>