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: