einfache Variante oder verbesserte Variante
;;; [Graph fuer tsp.scm]
; Es werden zunächst mehrere Punkte als Knoten definiert.
; Typ (xPos yPos)
; Anschliessend werden alle Kanten eines vollständigen Graphen
; erzeugt mit diesen Knoten definiert und diese mit dem geometrischen
; Abstand bewertet.
(define P1 '(10 10))
(define P2 '(100 10))
(define P3 '(10 100))
(define P4 '(30 110))
(define P5 '(150 100))
(define P6 '(30 70))
(define P7 '(20 60))
(define P8 '(200 300))
(define P9 '(90 60))
(define P10 '(20 200))
(define P11 '(150 210))
(define P12 '(10 210))
(define P13 '(50 60))
(define P14 '(290 10))
(define P15 '(170 170))
(define P16 '(60 60))
(define P17 '(60 70))
(define P18 '(120 110))
(define P19 '(110 130))
(define P20 '(70 60))

(define
  alle-Knoten
  (list P1 P2 P3 P4 P5 P6 P7 P8 P9 P10
        P11 P12 P13 P14 P15 P16 P17 P18 P19 P20))

;;; ===== Hilfsfunktionen ====================================
(define (sqr a) (* a a))

(define
  (abstand P Q)
  (sqrt (+ (sqr (- (car P) (car Q)))
           (sqr (- (cadr P) (cadr Q))))))

;;; ===== alle-Kanten ========================================
(define
  (alle-Kanten Knotenliste)
  (let
      loop1
    ((k Knotenliste)
     (akku1 ()))
    (cond
      ((null? k) (reverse akku1))
      (else
       (loop1
        (cdr k)
        (cons
         (list
          (car k)
          (let
              loop2
            ((l  Knotenliste)
             (akku2 ()))
            (cond
              ((null? l) (reverse akku2))
              ((equal? (car k) (car l))
               (loop2 (cdr l) akku2))
              (else
               (loop2
                (cdr l)
                (cons
                 (list (car l) (abstand (car k) (car l)))
                 akku2))))))
         akku1))))))

;;; ===== vollstaendiger-Graph ======================================
(define
  vollstaendiger-Graph
  (alle-Kanten alle-Knoten))

;;; ===== bewerte-zum-Punkt =========================================
(define
  (bewerte-zum-Punkt Kanten)
  (let
      loop
    ((Ausgangspunkt (car Kanten))
     (Zielpunkte (cadr Kanten))
     (akku ()))
    (cond
      ((null? Zielpunkte) (list Ausgangspunkt (reverse akku)))
      (else
       (loop
        Ausgangspunkt
        (cdr Zielpunkte)
        (cons
         (list
          (car Zielpunkte)
          (Abstand Ausgangspunkt (car Zielpunkte)))
          akku))))))

;;; ===== bewerte-Graphen ===========================================
(define
  (bewerte-Graphen Graph)
  (cond
    ((null? Graph) ())
    (else
     (cons
      (bewerte-zum-Punkt (car Graph))
      (bewerte-Graphen (cdr Graph))))))

;;; ===== Grafik dazu ========================================
;;; 1. Nur die Punkte :
; Es wird mit doppelter Größe gezeichnet:

(define
  (alle-Punkte-zeichnen Liste)
  (require-library "graphic.ss" "graphics")
  (open-graphics)
  (let
      ((Grafik (open-viewport "Grafik" 620 620)))
    (let
        loop
      ((liste liste))
      (cond
        ((null? Liste)
         (display "Taste !")
         (get-key-press Grafik)
         (close-graphics))
        (else
         ((draw-solid-rectangle Grafik)
          (make-posn (* 2 (caar Liste)) (* 2 (cadar Liste)))
          4 4 (make-rgb 0 0 0))
         (loop (cdr Liste)))))))

;;; ----------------------------------------------------------
;;; 2. Nur die Kanten :
; Es wird mit doppelter Größe gezeichnet.

(define
  (alle-Kanten-zeichnen liste)
  (require-library "graphic.ss" "graphics")
  (open-graphics)
  (let
      ((Grafik (open-viewport "Grafik" 620 620)))
    (let
        loop
      ((liste liste))
      (cond
        ((null? (cdr Liste))
         (display "Taste !")
         (get-key-press Grafik)
         (close-graphics))
        (else
         ((draw-line Grafik)
          (make-posn (* 2 (caar Liste)) (* 2 (cadar Liste)))
          (make-posn (* 2 (caadr Liste)) (* 2 (cadadr Liste)))
          (make-rgb 0 0 0))
         (loop (cdr Liste)))))))

;;; ----------------------------------------------------------
;;; 3. Kanten und Punkte :
; Es wird mit doppelter Größe gezeichnet.

(define
  (alle-Kanten-und-Punkte-zeichnen liste)
  (require-library "graphics.ss" "graphics")
  (open-graphics)
  (let
      ((Grafik (open-viewport "Grafik" 620 620)))
    (let
        loop
      ((liste liste))
      (cond
        ((null? (cdr Liste))
         ((draw-string Grafik)
          (make-posn 250 100)
          "Taste zum Abbruch !")
         (viewport-flush-input Grafik)
         (get-key-press Grafik)
         (close-graphics))
        (else
         ((draw-line Grafik)
          (make-posn (* 2 (caar Liste)) (* 2 (cadar Liste)))
          (make-posn (* 2 (caadr Liste)) (* 2 (cadadr Liste)))
          (make-rgb 0 0 0))
         ((draw-rectangle Grafik)
          (make-posn
           (sub1 (* 2 (caar Liste)))
           (sub1 (* 2 (cadar Liste))))
          3 3 (make-rgb 1 0 0))
         (loop (cdr Liste)))))))