Grundlagen der funktionsorientierten Programmierung mit SCHEME/MergeSort

Wiki-Quelltext dieser Seite.

<language>Scheme</language>
<code id="4bf43dc497467" 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 canvas turtle)
    (let* ([breite (/ maxbreite (length ls))] 
           [extremwerte (minmax ls)]
           [min (car extremwerte)] [max (cdr extremwerte)])
      (letrec
          ([zeichnen
            (lambda (min max ls)
              (if (null? ls)
                  'ok
                  (begin
                    (balken (* (/ (car ls) (- max min)) maxhoehe) 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:'''

<code id="4bf43ea96e11d">
(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>&nbsp;</td>
<td align="center">
'''Geordnete Zufallszahlen:'''
<canvas w="400" h="300"></canvas>
</td>
</tr>
</table>

<eval id="4bf43dc49938d">
(define ls (zufallsliste 1 1000 100))
(balkendiagramm ls canvas1 turtle1)
(define ls-sort (mergesort ls))
(balkendiagramm ls-sort canvas2 turtle2)
</eval>

MergeSort ist damit auch ein klassischer ''Teile-und-herrsche-Algorithmus''.

Zurück zu [[Grundlagen der funktionsorientierten Programmierung mit SCHEME/QuickSort|QuickSort]].