zurück

Das Problem des kürzesten Weges

;;;                dijkstra.scm
;;; Algorithmus von dijkstra [nach Turau].
;;; Lösung zum Problem der kürzesten Wege.
;
(define Graph
  '((1 ((2 4) (6 10) (7 5)))
    (2 ((1 4) (3 7) (7 2)))
    (3 ((2 7) (7 1) (4 12)))
    (4 ((3 12) (5 4)))
    (5 ((4 4) (6 3) (7 8)))
    (6 ((1 10) (5 3) (7 4)))
    (7 ((1 5) (2 2) (3 1) (5 8) (6 4)))))

(define Weglängen
  (vector 0 +inf.0 +inf.0 +inf.0 +inf.0 +inf.0 +inf.0 ))

(define Vorgänger
  (vector 0 0 0 0 0 0 0))

; Menge aller offenen Randpunkte im Baum der kürzesten Wege von ...
(define offen        ; heißt bei Turau B
  '(1))

; untersucht ob eine Ecke Nachbarecke einer anderen ist.
(define (Nachbar-Ecke? Ecke-1 Ecke-2)
  (let loop
    ((Kanten (cadr (assoc Ecke-1 Graph))))
    (cond
      ((null? Kanten) #f)
      ((equal? (caar Kanten) Ecke-2))
      (else (loop (cdr Kanten))))))


(define (Bewertung Ecke Vorgänger)       ; Turau: B[i,j]
  (if
   (assoc Ecke (cadr (assoc Vorgänger Graph)))
   (cadr
    (assoc Ecke (cadr (assoc Vorgänger Graph))))
   +inf.0 ))

; entfernt ein Element aus einer Menge
(define (entferne element menge)
  (cond
    ((and
      (member element menge)
      (member element (cdr (member element menge))))
     (error "keine Menge" menge))
   ((member element menge)
    (append
     (reverse (cdr (member element (reverse menge))))
     (cdr (member element menge))))
   (else menge)))

(define (verkürze Ecke vorige)
  (cond
   ((<
    (+ (Bewertung Ecke vorige) (vector-ref Weglängen (sub1 vorige)))
    (vector-ref Weglängen (sub1 Ecke)))
    (vector-set! Weglängen (sub1 Ecke) (+ (Bewertung Ecke vorige) (vector-ref Weglängen (sub1 vorige))))
    (vector-set! Vorgänger (sub1 Ecke) vorige)
    (writeln "Länge neu:" Ecke Weglängen Vorgänger offen)
    (void))
   (else #f)))

; findet unter den offenen Ecken die mit minimaler Bewertung
(define (finde-minimal-bewertete-Ecke)
  (let loop
      ((liste offen)
       (minimalwert +inf.0)
       (kleinste #f))
    (cond
      ((null? liste) kleinste)
      ((< (vector-ref Weglängen (sub1 (car liste))) minimalwert)
       (loop (cdr liste) (vector-ref Weglängen (sub1 (car liste))) (car liste)))
      (else
       (loop (cdr liste) minimalwert kleinste)))))


(define (dijkstra)
  (cond
    ((null? offen)        ; fertig !!!
     (writeln offen Weglängen Vorgänger))
    (else
     (let loop
         ((zu-entfernende-Ecke (finde-minimal-bewertete-Ecke))
          (j 7))
       (cond
         ((zero? j)
          (set! offen (entferne zu-entfernende-Ecke offen))
          (dijkstra))
         ((and
           (Nachbar-Ecke? zu-entfernende-Ecke j)
           (= (vector-ref Weglängen (sub1 j)) +inf.0))
          (set! offen (cons j offen))
          (verkürze j zu-entfernende-Ecke)
          (loop zu-entfernende-Ecke (sub1 j)))
         (else
          (verkürze j zu-entfernende-Ecke)
          (loop zu-entfernende-Ecke (sub1 j))))))))

(dijkstra)
;;; =================================================================
; Beispiel - Ausgaben :
;Länge neu: 7 #(0 +inf.0 +inf.0 +inf.0 +inf.0 +inf.0 5) #(0 0 0 0 0 0 1) (7 1)
;Länge neu: 6 #(0 +inf.0 +inf.0 +inf.0 +inf.0 10 5) #(0 0 0 0 0 1 1) (6 7 1)
;Länge neu: 2 #(0 4 +inf.0 +inf.0 +inf.0 10 5) #(0 1 0 0 0 1 1) (2 6 7 1)
;Länge neu: 3 #(0 4 11 +inf.0 +inf.0 10 5) #(0 1 2 0 0 1 1) (3 2 6 7)
;Länge neu: 6 #(0 4 11 +inf.0 +inf.0 9 5) #(0 1 2 0 0 7 1) (3 6 7)
;Länge neu: 5 #(0 4 11 +inf.0 13 9 5) #(0 1 2 0 7 7 1) (5 3 6 7)
;Länge neu: 3 #(0 4 6 +inf.0 13 9 5) #(0 1 7 0 7 7 1) (5 3 6 7)
;Länge neu: 4 #(0 4 6 18 13 9 5) #(0 1 7 3 7 7 1) (4 5 3 6)
;Länge neu: 5 #(0 4 6 18 12 9 5) #(0 1 7 3 6 7 1) (4 5 6)
;Länge neu: 4 #(0 4 6 16 12 9 5) #(0 1 7 5 6 7 1) (4 5)
;() #(0 4 6 16 12 9 5) #(0 1 7 5 6 7 1)