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")