hill fuer tsp
Bilder: Startbild Endbild
;;;
; benötigt [Graph fuer tsp.scm]
(load "Graph fuer tsp.scm")
;;; hill climbing - Verfahren nach mathematik lehren Heft 81
;;; lokale Verbesserung durch Zweiwegetausch:
;>>> t(0) t(1) ... t(k) t(k+1) ... t(m) t(m+1) ... t(n)
;;; wird getauscht zu:
;>>> t(0) t(1) ... t(k) t(m) t(m-1) ... t(k+1) t(m+1) ... t(n)
;;; das Teilstück wird also in umgekehrter Reihenfolge
;;; durchlaufen.( n Knoten, t(n)= t(0) )
;;; ===== tausche-Knoten =====================================
; tauscht die Knoten nach dem o.a. Verfahren aus.
; Die Prozedur verhindert einen Tausch, wenn k<0, m>=n-2
; und m<k+2
(define
(tausche-Knoten k m tour)
(let
((n (sub1 (length tour))))
(cond
((negative? k) tour)
((> m (- n 2)) tour)
((< m (+ k 2)) tour)
(else
(append
(reverse (list-tail (reverse tour) (- n k)))
(list-tail
(reverse (list-tail tour (add1 k)))
(- n m))
(list-tail tour (add1 m)))))))
;;; ===== hill ===============================================
; Das Verfahren durchläuft eine Schleife, bei der alle möglichen
; Zweiwegetausche daraufhin untersucht werden, ob sie zu einer
; Verbesserung führen. Wenn ja, wird dieser weiter verfolgt,
; anderenfalls bricht das Verfahren ab.
(define
(alle-tauschen tour bisheriges-minimum)
(let
k-Schleife
((k 0)
(n (sub1 (length tour)))
(neue-tour #f))
(cond
((> k (sub1 n)) neue-tour)
(else
(let
m-Schleife
((m (+ k 2))
(neue-tour neue-tour))
(cond
((>= m n)
(k-Schleife
(add1 k)
n
neue-tour))
(else
(let
((Versuch (tausche-knoten k m tour)))
(cond
((kuerzer? Versuch tour)
(if
neue-tour
(if
(kuerzer? Versuch neue-tour)
(m-Schleife (add1 m) Versuch)
(m-Schleife (add1 m) neue-tour))
(m-Schleife (add1 m) Versuch)))
(else
(m-Schleife (add1 m) neue-tour)))))))))))
;;; ===== hill ===============================================
(define
(hill tour)
(let
loop
((neu (alle-tauschen tour (Tourlaenge tour))))
(if
neu
(hill neu)
(begin
(display "keine weitere Verbesserung möglich")(newline)
(display tour)(newline)
(display (Tourlaenge tour))(newline)
(alle-Kanten-und-Punkte-zeichnen tour)
(void)))))
;;; ===== kuerzer? ===========================================
; Vergleicht die Länge von zwei Touren.
(define
(kuerzer? tour-1 tour-2)
(< (Tourlaenge tour-1) (Tourlaenge tour-2)))
;;; ===== 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: