zurück Grafik

einfaches hill fuer tsp

Bilder: Startbild Endbild

;;; <einfaches hill fuer tsp.scm>
; benötigt [Graph fuer tsp.scm]
(load "Graph fuer tsp.scm")
;;; Diese einfachere Variante nach einem Bubble - ähnlichen
;;; Algorithmus zeigt sehr schön, wie das Verfahren in einem
;;; lokalen Minimum der Länge hängen bleibt.

;;; hill climbing - Verfahren durch
;;; lokale Verbesserung mit Tausch zweier benachbarter Knoten
;>>> t(0) t(1) ... t(k) t(k+1) ...   t(n)
;;; wird getauscht zu:
;>>> t(0) t(1) ... t(k+1) t(k) ...   t(n)

;;; ===== tausche-Knoten =====================================
; tauscht die Knoten nach dem o.a. Verfahren aus.
; Da der erste und der letzte Knoten in der tour identisch
; sein müssen, dürfen sie nicht getauscht werden.
(define
  (tausche-Knoten k tour)
  (if
   (or
    (< k 1)
    (> k (- (length tour) 3)))
   tour
   (let loop
     ((k k)
      (tour tour))
     (cond
       ((zero? k)
        (cons (cadr tour) (cons (car tour) (cddr tour))))
       (else
        (cons
         (car tour)
         (loop (sub1 k) (cdr tour))))))))
;;; ===== kuerzer-nach-Tausch? ======================================
; Prueft, ob nach dem Tausch die Tour kürzer wäre.
; Gibt die neue Tourlänge oder #f zurück.
; Dazuwerden einfach die Veränderungen durch den Austausch der beiden
; Knoten berechnet.
(define
  (kuerzer-nach-Tausch? k tour ihre-laenge)
  (let
      ((aenderung
        (+
         (abstand      ; neue Abstände
          (list-ref tour (sub1 k))
          (list-ref tour (add1 k)))
         (-
          (abstand
           (list-ref tour (+ k 2))
           (list-ref tour k))
          (abstand            ; alte Abstände
           (list-ref tour (sub1 k))
           (list-ref tour k))
          (abstand
           (list-ref tour (add1 k))
           (list-ref tour (+ k 2))))
         )))
    (if
     (negative? aenderung)
     (+ ihre-laenge aenderung)
     #f)))

;;; ===== alle-tauschen =============================================
; Das Verfahren durchläuft eine Schleife, bei der alle möglichen
; Zweiknotentausche daraufhin untersucht werden, ob sie zu einer
; Verbesserung führen. Wenn ja, wird dieser weiter verfolgt,
; anderenfalls bricht das Verfahren wegen des Rückgabewertes #f in
; hill ab.

(define
  (alle-tauschen tour bisheriges-minimum)
  (let loop
    ((k 1)
     (n (- (length tour) 3))
     (minimum bisheriges-minimum)
     (neue-tour #f))
    (cond
      ((> k n) neue-tour)
      ((let
           ((neue-laenge (kuerzer-nach-Tausch? k tour minimum)))
         (if
          neue-laenge
          (loop (add1 k) n neue-laenge (tausche-Knoten k tour))
          #f)))
      (else
       (loop (add1 k) n minimum neue-tour)))))

;;; ===== hill ===============================================
(define
  (hill tour)
  (let
      loop
    ((neu (alle-tauschen tour (Tourlaenge tour))))
    (if
     neu
     (begin
       (display neu)(newline)
       (display (Tourlaenge neu))(newline)
       (alle-Kanten-und-Punkte-zeichnen neu)
       (hill neu))
     (begin
       (display "keine weitere Verbesserung möglich")(newline)
       (display tour)(newline)
       (display (Tourlaenge tour))(newline)
       (alle-Kanten-und-Punkte-zeichnen tour)
       tour))))


;;; ===== Tourlaenge =========================================
(define
  (Tourlaenge tour)
  (let
      loop
    ((Punkt (car tour))
     (liste (cdr tour))
     (laenge 0))
    (cond
      ((null? liste) laenge)
      (else
       (loop
        (car liste)
        (cdr liste)
        (+ laenge (abstand Punkt (car liste))))))))

;;; ===== Test : ====================================================
(define Mustertour (cons (car (reverse alle-Knoten)) alle-Knoten))
(Tourlaenge Mustertour)
(alle-Kanten-und-Punkte-zeichnen Mustertour)
(hill Mustertour)

Startbild:

Endbild: