Progamm
Seitenanfang
Seitenende
Progamm Seite 3
;;; <tsp mit GA Funktionen.scm>
;;; ===== Globale Variable ==========================================
; Das Programm benötigt einige globale Variable:
; ---Groesse der Bilschirmdarstellung:
(define Bild-Groesse 500)
; ---Anzahl der Städte:
(define Anzahl-Staedte 50)
; Das Setzen des Zufallszahlengenerators sollte im HP erfolgen.
;;; ===== eine-Stadt ================================================
; Alternative zu (waehle-Positionen n)
(define
(eine-Stadt)
(list
(add1 (random (- Bild-Groesse 2)))
(add1 (random (- Bild-Groesse 2)))))
;;; ===== Staedteliste ==============================================
; Erzeugt eine Liste von Städten
(define
Staedte-Liste
(let
loop
((n Anzahl-Staedte)
(akku ()))
(cond
((zero? n)
akku)
(else
(loop
(sub1 n)
(cons
(eine-Stadt)
akku))))))
;;; ===== erzeuge-Individuum ========================================
; Erzeugt ein Individuum der Population.
; Benötigt die Staedteliste:
(define
(erzeuge-Individuum)
(let
loop
((n (length Staedte-Liste))
(Auswahl (random (length Staedte-Liste)))
(Staedte-Liste Staedte-Liste)
(akku ()))
(cond
((= n 1)
(cons (car Staedte-Liste) akku))
(else
(loop
(sub1 n)
(random (sub1 n))
(entferne Staedte-Liste Auswahl)
(cons
(list-ref Staedte-Liste Auswahl)
akku))))))
;;; ===== entferne ==================================================
; Entfernt ein Element aus einer Liste. Hilfsfunktion für Selektion.
; k:0..Länge -1.
(define
(entferne Liste k)
(append
(reverse (list-tail (reverse Liste) (- (length Liste) k)))
(list-tail Liste (add1 k))))
;;; ===== Abstand ===================================================
; Berechnet den Luftlinienabstand zweier Punkte.
(define
(Abstand P Q)
(sqrt (+ (* (- (car P) (car Q))(- (car P) (car Q)))
(* (- (cadr P) (cadr Q))(- (cadr P) (cadr Q))))))
;;; ===== bewerte ===================================================
; Bewertet ein Individuum mit einer Bewertungsziffer.
; Liefert eine Liste aus Individuum und Bewertungszahl zurück
(define
(bewerte Individuum)
(let
loop
((Tour Individuum)
(akku 0))
(cond
((null? (cdr Tour))
(list
Individuum
(+ (Abstand (car Tour) (car Individuum)) akku)))
(else
(loop
(cdr Tour)
(+ (Abstand (car Tour) (cadr Tour)) akku))))))
;;; ===== mutiere ===================================================
; Mutiert ein einzelnes Individuum.
; Dazu wird der Teil der Tour zwischen der ersten und der zweiten
; Position einschliesslich umgekehrt eingebaut.
; Hier muss die Bewertung bei den Individuen fehlen !
; Individuum -> Individuum
(define
(mutiere Individuum)
(letrec
((Laenge (length Individuum))
(Positionen (waehle-Positionen Laenge))
(vorn (car Positionen))
(hinten (cadr Positionen)))
(append
(Teilliste Individuum 0 vorn)
(reverse (Teilliste Individuum vorn hinten))
(Teilliste Individuum hinten (length Individuum)))))
;;;; ===== mutiere (alternativ) =======================================
;; Mutiert ein einzelnes Individuum.
;; Zweite Variante: Einzelne Elemente austauschen!
;; Hier muss die Bewertung bei den Individuen fehlen !
;; Individuum -> Individuum
;(define
; (mutiere Individuum)
; (letrec
; ((Laenge (length Individuum))
; (Positionen (waehle-Positionen Laenge))
; (vorn (car Positionen))
; (hinten (cadr Positionen)))
; (append
; (Teilliste Individuum 0 vorn)
; (list (list-ref Individuum hinten))
; (Teilliste Individuum (add1 vorn) hinten)
; (list (list-ref Individuum vorn))
; (Teilliste Individuum (add1 hinten) (length Individuum)))))
;
;;; ===== alle-ohne =================================================
; Entfernt aus der Liste 'aus' alle Elemente von 'ohne'
(define
(alle-ohne aus ohne)
(let
loop
((aus aus)
(akku ()))
(cond
((null? aus)
(reverse akku))
((member (car aus) ohne)
(loop (cdr aus) akku))
(else
(loop (cdr aus) (cons (car aus) akku))))))
;;; ===== Teilliste =================================================
; Schneidet eine Teilliste beginnend bei der Position vorn bis zur
; Position hinten (ausschliesslich) aus einer Liste heraus.
(define
(Teilliste Liste vorn hinten)
(let
((Laenge (length Liste)))
(reverse
(list-tail
(reverse
(list-tail Liste vorn))
(- Laenge hinten)))))
;;; ===== kreuze ====================================================
; Kreuzt zwei einzelne Individuen.
; Das Problem ist, dass eingekreuzte Abschnitte Staedte enthalten,
; die schon in der Resttour enthalten sind, andere aber z.T. nicht.
; Die Hilfsfunktion "fuege-Abschnitt-ein" sorgt jeweils dafür.
; Hier muss die Bewertung bei den Individuen fehlen !
; Individuum x Individuum -> (list Individuum Individuum)
(define
(kreuze Individuum-1 Individuum-2)
(letrec
((Laenge (length Individuum-1))
(Positionen (waehle-Positionen Laenge))
(ab-Position (car Positionen))
(bis-Position (cadr Positionen))
(raus-1 (Teilliste Individuum-1 ab-Position bis-Position))
(raus-2 (Teilliste Individuum-2 ab-Position bis-Position))
(temp-1 (alle-ohne Individuum-1 raus-2))
(temp-2 (alle-ohne Individuum-2 raus-1)))
(list
(append
(Teilliste temp-1 0 ab-Position)
raus-2
(Teilliste (append raus-1 temp-1) bis-Position Laenge))
(append
(Teilliste temp-2 0 ab-Position)
raus-1
(Teilliste (append raus-2 temp-2) bis-Position Laenge))
)))
;;; ===== Darstellung ===============================================
; Die Darstellung der 'besten' Lösung mit Grafik:
(define
(Darstellung Individuum)
(display (round (cadr Individuum)))
(newline)
(zeichne Individuum #f))
;;; ===== Laden der Grafik ==========================================
(load "tsp mit GA Grafik.scm")