Grundlagen der funktionsorientierten Programmierung mit SCHEME/MergeSort
Aus ProgrammingWiki
Wiki-Quelltext dieser Seite.
<language>Scheme</language>
<code id="4e75ccd3c0a38" hidden>
;-- M. Hielscher / Chr. Wagenknecht / V. Berger --
(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)) 19880214))))
(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) ; stellt current-time usw. bereit
(define random (random-maker (time-nanosecond (current-time))))
(define listequal?
(lambda (ls1 ls2)
(cond
[(and (null? ls1) (null? ls2)) #t]
[(or (null? ls1) (null? ls2)) #f]
[(and (list? (car ls1)) (list? (car ls1)))
(and (listequal? (car ls1) (car ls2)) (listequal? (cdr ls1) (cdr ls2)))]
[else
(and (equal? (car ls1) (car ls2)) (listequal? (cdr ls1) (cdr ls2)))])))
(define rand 50)
(define maxbreite (- 400 (* 2 rand)))
(define maxhoehe (- 300 (* 2 rand)))
(define minmax
(lambda (ls)
(letrec
([extremsuche
(lambda (extrem ls op)
(cond
[(null? ls) extrem]
[(op extrem (car ls)) (extremsuche (car ls) (cdr ls) op)]
[else
(extremsuche extrem (cdr ls) op)]))])
(cons (extremsuche 0 ls >)
(extremsuche 0 ls <)))))
(define balken
(lambda (hoehe breite turtle)
(forward turtle breite) (left turtle 90)
(forward turtle hoehe) (left turtle 90)
(forward turtle breite) (left turtle 90)
(forward turtle hoehe) (left turtle 90)
(forward turtle breite)))
(define balkendiagramm
(lambda (ls nr)
(let* ([breite (/ maxbreite (length ls))]
[extremwerte (minmax ls)]
[min (car extremwerte)] [max (cdr extremwerte)]
[canvas (eval (string->symbol (string-append "canvas" (number->string nr))))]
[turtle (eval (string->symbol (string-append "turtle" (number->string nr))))])
(letrec
([zeichnen
(lambda (min max ls)
(if (null? ls)
'ok
(begin
(balken (floor (* (/ (car ls) (- max min)) maxhoehe)) (floor breite) turtle)
(zeichnen min max (cdr ls)))))])
(clear canvas)
(hide turtle)
(move turtle rand (+ rand (* (/ max (- max min)) maxhoehe))) (right turtle 90)
(zeichnen min max ls)))))
</code>
=== Implementation von MergeSort ===
<code id="4e75ccd3c0ada">
(define zufallszahl
(lambda (min max)
(+ (random (- max min -1)) min)))
(define zufallsliste
(lambda (min max anzahl)
(if (= anzahl 0)
()
(cons (zufallszahl min max) (zufallsliste min max (- anzahl 1))))))
;Teile eine Liste in zwei annähernd gleich große Teillisten
(define teilen
(lambda (ls)
...))
;Setze zwei Teillisten zu einer geordneten Gesamtliste zusammen
(define zusammensetzen
(lambda (ls1 ls2)
...))
;MergeSort
(define mergesort
(lambda (ls)
(cond
[(null? ls) ls]
[(null? (cdr ls)) ls]
[else
(let ([tls (teilen ls)])
(zusammensetzen (mergesort (car tls)) (mergesort (cadr tls))))])))
</code>
<check>
(listequal? (mergesort '(12 4 5 6 33 2 6 7 1 47)) '(1 2 4 5 6 6 7 12 33 47))
</check>
<table border="0" cellpadding="0" cellspacing="0">
<tr>
<td align="center">
'''Ungeordnete Zufallszahlen:'''
<canvas w="400" h="300"></canvas>
</td>
<td> </td>
<td align="center">
'''Geordnete Zufallszahlen:'''
<canvas w="400" h="300"></canvas>
</td>
</tr>
</table>
<run id="4e75ccd3c0ce6">
(define ls (zufallsliste 1 1000 100))
(balkendiagramm ls 1)
(define ls-sort (mergesort ls))
(balkendiagramm ls-sort 2)
</run>
MergeSort ist damit auch ein klassischer ''Teile-und-herrsche-Algorithmus''.
=== Effizienz von MergeSort ===
Wir wollen auch für MergeSort eine empirische Analyse des Zeitaufwands vornehmen und definieren dazu:
<code id="4e75ccd3c0b57">
(define count 0)
(define mergesort-aufwand
(lambda (ls)
(letrec
([teilen
(lambda (ls)
(cond
[(null? ls) (list () ())]
[(null? (cdr ls))
(list ls ())]
[else
(set! count (+ 1 count)) ;Teilen
(let ([tls (teilen (cddr ls))])
(list (cons (car ls) (car tls)) (cons (cadr ls) (cadr tls))))]))]
[zusammensetzen
(lambda (ls1 ls2)
(cond
[(null? ls1) ls2]
[(null? ls2) ls1]
[else
(set! count (+ 1 count)) ;geordnetes Zusammensetzen
(if (< (car ls1) (car ls2))
(cons (car ls1) (zusammensetzen (cdr ls1) ls2))
(cons (car ls2) (zusammensetzen ls1 (cdr ls2))))]))])
(cond
[(null? ls) ls]
[(null? (cdr ls)) ls]
[else
(let ([tls (teilen ls)])
(zusammensetzen (mergesort-aufwand (car tls)) (mergesort-aufwand (cadr tls))))]))))
(define mergesort-ausgabe
(lambda (min max anzahl)
(let ([ls (zufallsliste min max anzahl)])
(set! count 0)
(display "Ungeordnete Zufallszahlen:") (newline)
(display ls) (newline)
(display "Geordnete Zufallszahlen:") (newline)
(display (mergesort-aufwand ls)) (newline)
(display "Anzahl der Teilungen und Zusammensetzungen: ") (display count) (newline)
'ok)))
</code>
<run id="4e75ccd3c0d5c">
(mergesort-ausgabe 1 1000 20)
</run>
Wenige Tests bestätigen unsere Vermutung: MergeSort scheint ebenso effizient zu sein wie QuickSort.<br />
Die Überprüfung erfolgt wieder mit den bekannten Prozeduren für Mehrfachexperimente sowie den entsprechenden grafischen Darstellungen. Dabei wollen wir auch den Fall einbeziehen, bei dem bereits eine sortierte Zahlenliste vorliegt:
<code id="4e75ccd3c0bcd">
(define mergesort-mehrfach
(lambda (min max anzahl whlg)
(letrec
([summe
(lambda (n)
(if (= n 0)
0
(begin
(set! count 0)
(mergesort-aufwand (zufallsliste min max anzahl))
(+ count (summe (- n 1))))))])
(exact->inexact (/ (summe whlg) whlg)))))
</code>
<run id="4e75ccd3c0dcd">
(mergesort-mehrfach 1 1000 20 100)
</run>
<code id="4e75ccd3c0c47">
(define experiment
(lambda (min max anzahl schrittweite whlg)
(if (< anzahl 1)
()
(append (experiment min max (- anzahl schrittweite) schrittweite whlg)
(list (mergesort-mehrfach min max anzahl whlg))))))
(define mergesort-worst-case
(lambda (min max anzahl)
(set! count 0)
(mergesort-aufwand (mergesort (zufallsliste min max anzahl)))
count))
(define experiment-worst-case
(lambda (min max anzahl schrittweite)
(if (< anzahl 1)
()
(append (experiment-worst-case min max (- anzahl schrittweite) schrittweite)
(list (mergesort-worst-case min max anzahl))))))
</code>
<table border="0" cellpadding="0" cellspacing="0">
<tr>
<td align="center">
'''MergeSort: average-case'''
<canvas w="400" h="300"></canvas>
</td>
<td> </td>
<td align="center">
'''MergeSort: worst-case'''
<canvas w="400" h="300"></canvas>
</td>
</tr>
</table>
<run id="4e75ccd3c0e53">
(balkendiagramm (experiment 1 1000 200 5 50) 3)
(balkendiagramm (experiment-worst-case 1 1000 200 5) 4)
</run>
Damit bestätigt sich, dass der Zeitaufwand im Average- und Worst-case-Fall <math>T(n) = \mathcal{O}(n \cdot \log_2 n)</math> beträgt.
Zurück zu [[Grundlagen der funktionsorientierten Programmierung mit SCHEME/QuickSort|QuickSort]].