zurück Grafik

minimal spanning tree

;;;                                [minimal-prim.scm]
; Der Graph besteht in diesem Beispiel aus folgender Figur:
; 1           2
;       5
;   8       6
;       7
; 4           3
; Dabei haben die Punkte die Koordinaten
(define
  Koordinaten
  '(
    (1 (10 10))
    (2 (390 11))
    (3 (390 390))
    (4 (12 390))
    (5 (201 99))
    (6 (303 199))
    (7 (202 298))
    (8 (104 201))))
; Es sollen alle Verbindungen möglich sein.
;;; ===== Abstand ===================================================
; Bewertung durch den geometrischen Abstand.
(define
  (Abstand P-1 P-2)
  (sqrt (+ (sqr (- (car P-1) (car P-2)))
           (sqr (- (cadr P-1) (cadr P-2))))))
(define (sqr x) (* x x))
;;; ===== Graph =====================================================
; Bewerteter Graph.
(define
  Graph
  (let loop
    ((Punkt 8)
     (alle-Punkte Koordinaten)
     (akku ())
     (temp ()))
    (cond
      ((zero? Punkt)
       akku)
      ((null? alle-Punkte)
       (loop
        (sub1 Punkt)
        Koordinaten
        (cons (list Punkt (reverse temp)) akku)
        ()))
      ((equal? Punkt (caar alle-Punkte))
       (loop Punkt (cdr alle-Punkte) akku temp))
      (else
       (loop
        Punkt
        (cdr alle-Punkte)
        akku
        (cons (list (caar alle-Punkte)
                    (Abstand
                     (cadr (assoc Punkt Koordinaten))
                     (cadar alle-Punkte)))
              temp))))))

;;; ===== Nachfolger =========================================
; Anders als bei der einfachen Tiefensuche muss die Nachfolger-
; funktion die Kanten komplett übergeben, also auch mit dem
; Ausgangsknoten.
(define
  (Nachfolger Knoten Graph)
  (let
      loop
    ((liste (cadr (assoc Knoten Graph)))
     (akku ()))
    (cond
      ((null? liste) akku)
      (else
       (loop
        (cdr liste)
        (cons
         (cons
          Knoten
          (car liste))
         akku))))))

;;; ===== laenger? ==========================================
; Prädikat zum Sortieren
(define
  (laenger? erstes zweites)
  (> (caddr erstes) (caddr zweites)))

;;; ===== ordne ==============================================
; ordnet übergebene Kanten der Laenge nach durch lineares
; Einfügen.
(define
  (ordne Kanten)
  (cond
    ((null? Kanten) ())
    (else
     (fuege-ein (car Kanten) (ordne (cdr Kanten))))))

;;; ----- fuege-ein ------------------------------------------
; Hilfprozedur zum linearen Einfügen in eine sortierte Liste.
(define
  (fuege-ein Element aufwaerts-sortierte-Liste)
  (cond
    ((null? aufwaerts-sortierte-Liste) (list Element))
    ((laenger? Element (car aufwaerts-sortierte-Liste))
     (cons
      (car aufwaerts-sortierte-Liste)
      (fuege-ein Element (cdr aufwaerts-sortierte-Liste))))
    (else
     (cons Element aufwaerts-sortierte-Liste))))

;;; ===== greedy =============================================
; Die benachbarten Kanten werden in einer Prioritäts - Warte-
; schlange geführt: In sie werden die Elemente nach ihren
; Bewertungen sortiert eingefügt.
(define
  (minmal-prim Startknoten Graph)
  (let
     ((Laenge (length Graph)))
      (let
          loop
        ((Prio-Schlange
          (ordne (Nachfolger Startknoten Graph)))
         (besucht (list Startknoten))
         (beteiligte-Kanten ()))
;        (display Prio-Schlange)(newline)
;        (display besucht)(newline)
;        (display beteiligte-Kanten)(newline)(newline)
        (cond
          ((= laenge (length besucht))                    ;{1}
           beteiligte-Kanten)
          ((member (Zielknoten (car Prio-Schlange)) besucht)
           (loop                                          ;{2}
            (cdr Prio-schlange)
            besucht
            beteiligte-Kanten))
          (else
           (loop                                          ;{3}
            (ordne
             (append
              (Nachfolger (Zielknoten (car Prio-Schlange)) Graph)
              (cdr Prio-Schlange)))
            (cons (Zielknoten (car Prio-Schlange))
                  besucht)
            (cons (car Prio-Schlange) beteiligte-Kanten)))))))

;{1} Wenn alle Knoten in der besucht - Liste enthalten sind, ist
;    ihre Länge gleich der Länge des Graphen und das Problem ist
;    gelöst.
;{2} Führt der erste Weg zu einem Knoten, der schon in der
;    besucht - Liste enthalten ist, muss er aus der Schlange
;    entfernt werden.
;{3} Anderenfalls wird ein Schritt ausgeführt. Die neuen Randwege
;    werden in die Prioritäts - Warteschlange eingefügt, aus der
;    der erste weg entfernt wurde, der Zielknoten wird der
;    besucht - Liste hinzugefügt und die Kante der Kantenliste.

;;; ===== Zielknoten =========================================
; Hilfsprozedur zur Bestimmung des Zielknotens.
(define
  (Zielknoten Kante)
  (cadr Kante))

;;; ===== Test: ==============================================
(display "Grafik ?")
(cond
 ((equal? (read) #t)
  (load "minmal-prim Grafik.scm")
  (zeichne (minmal-prim 1 Graph) Koordinaten))
 (else
  (minmal-prim 1 Graph)))