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


Haupt - 'Programm'


Startseite Seitenanfang Seitenende Progamm Seite 3