PROGRAM        travelling_salesman; {   Hubert Deitemann, WAF, Dez.1997
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Gegeben sind N Orte, die miteinander verbunden sind. In dieser Variante
sind die Orte symmetrisch miteinander verbunden, d.h. es gibt keine
Einbahnstraßen. Es dürfen aber Verbindungen fehlen. Gesucht ist eine
kürzeste Rundreise, die jeden Ort genau einmal besucht und zum Ausgangsort
zurückkehrt.}

CONST Nmax          = 20;                           {max. Zahl von Orten}
TYPE  vektortyp     = ARRAY [-1..Nmax] OF Integer;  {eine Rundreise
                         -1: Bewertung des Vektors, akkum.Streckenlängen
                          0: Stelligkeit des Vektors, fertig wenn gleich N
                       1..N: Nummern der Orte in Reihenfolge des Besuchens}
      inzidenztyp   = ARRAY [1..Nmax,1..NMax] OF Integer;{Entfernungen}
      wahltyp       = SET OF 1..Nmax;               {Menge für besuchte Orte}
CONST auswahlanfang : Integer = 1;
      standard      : inzidenztyp =
                     ((  0, -1, -1,221, 51, 76, 35, 49, 80, 97, 83,0,0,0,0,0,0,0,0,0),
                      ( -1,  0, -1,218, 21,150, 85, -1, 52,135, 38,0,0,0,0,0,0,0,0,0),
                      ( -1, -1,  0, -1, -1, 98,  5, 59,205,162, -1,0,0,0,0,0,0,0,0,0),
                      (221,218, -1,  0,253, -1,100, 42,107,177, 16,0,0,0,0,0,0,0,0,0),
                      ( 51, 21, -1,253,  0, 96,180, 65,172, 56, -1,0,0,0,0,0,0,0,0,0),
                      ( 76,150, 98, -1, 96,  0,245, 23, -1, 18, -1,0,0,0,0,0,0,0,0,0),
                      ( 35, 85,  5,100,180,245,  0, 17, -1,156, -1,0,0,0,0,0,0,0,0,0),
                      ( 49, -1, 59, 42, 65, 23, 17,  0,179,202, 35,0,0,0,0,0,0,0,0,0),
                      ( 80, 52,205,107,172, -1, -1,179,  0,203,165,0,0,0,0,0,0,0,0,0),
                      ( 79,135,162,177, 56, 18,156,202,203,  0,174,0,0,0,0,0,0,0,0,0),
                      ( 83, 38, -1, 16, -1, -1, -1, 35,165,174,  0,0,0,0,0,0,0,0,0,0),
                      (  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,0,0,0,0,0,0,0,0,0),
                      (  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,0,0,0,0,0,0,0,0,0),
                      (  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,0,0,0,0,0,0,0,0,0),
                      (  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,0,0,0,0,0,0,0,0,0),
                      (  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,0,0,0,0,0,0,0,0,0),
                      (  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,0,0,0,0,0,0,0,0,0),
                      (  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,0,0,0,0,0,0,0,0,0),
                      (  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,0,0,0,0,0,0,0,0,0),
                      (  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,0,0,0,0,0,0,0,0,0));
VAR   N             : Integer;       {konkrete Anzahl der Orte, N<=Nmax}
      auswahlende   : Integer;       {ist gleich N}
      inzidenz      : inzidenztyp;   {Entfernungen}
      vektor        : vektortyp;
      gewaehlt      : wahltyp;
      akt_optimum   : Integer;
      loesung       : vektortyp;
      i, j          : Integer;
      c             : Char;

  PROCEDURE zahlein (VAR zahl: Integer; u,o: Integer; hinw: STRING);
  VAR s: STRING[5];                     {Zahleneingabeprozedur mit}
      c: Integer;                       {Plausibilitätskontrollen}
  BEGIN
    REPEAT
      Write(hinw);  Readln(s);          {Hinweistext, String einlesen}
      IF s='' THEN c:=1 ELSE Val(s,zahl,c); {String s in Zahl umwandeln}
      IF (c<>0) OR (zahl<u) OR (zahl>o) {keine Zahl, außerhalb Bereich}
         THEN Writeln('Eingabefehler !')
    UNTIL (c=0) AND (zahl>=u) AND (zahl<=o) {bis die Zahl OK ist}
  END;

  { T }
  PROCEDURE try (stufe: Integer; vektor: vektortyp; gewaehlt: wahltyp);
  VAR wahl     : Integer;
      lebend   : Boolean;
      neuwahl  : wahltyp;
      neuvektor: vektortyp;

    { T.1 }
    FUNCTION vollstaendig: Boolean;
    BEGIN  vollstaendig := (neuvektor[0]=N)  END;

    { T.2 }
    PROCEDURE vektor_bewerten;
    VAR strecke: Integer;
    BEGIN
      IF wahl IN gewaehlt                {tot, weil gewählter Ort bereits besucht}
        THEN lebend:=FALSE
        ELSE BEGIN
          lebend:=True;                  {gewählter Ort erstmal noch möglich}
          neuwahl:=gewaehlt;
          neuwahl:=neuwahl+[wahl];       {in Auswahlmenge Ort hinzufügen}
          IF stufe=1
            THEN neuvektor[-1]:=0
            ELSE BEGIN
              strecke:=inzidenz[neuvektor[stufe-1],neuvektor[stufe]];
              IF strecke<=0
                THEN lebend:=False       {tot, weil keine Verbindung}
                ELSE BEGIN
                  neuvektor[-1]:=neuvektor[-1]+strecke;
                  {Bewertung um neue Strecke ergänzen}
                  lebend:=(neuvektor[-1]<akt_optimum)
                  {auch tot, wenn Strecke schon länger als bisheriges Optimum}
                END
            END
        END
    END;

    { T.3 }
    FUNCTION neues_optimum: Boolean;
    VAR strecke: Integer;
    BEGIN
      IF NOT lebend
        THEN neues_optimum:=False  {wenn tot, dann erst recht kein Optimum}
        ELSE BEGIN
          strecke:=inzidenz[neuvektor[n],neuvektor[1]];
          IF strecke<=0
            THEN neues_optimum:=False {zurück zum Start geht nicht}
            ELSE BEGIN
              IF ((neuvektor[-1]+strecke)>=akt_optimum)
                THEN neues_optimum:=False {Strecke zu lang}
                ELSE BEGIN
                  neuvektor[-1]:=neuvektor[-1]+strecke;
                  neues_optimum:=True
                END
            END
        END
    END;

    { T.4 }
    PROCEDURE loesung_speichern;
    BEGIN
      akt_optimum:=neuvektor[-1];
      loesung:=neuvektor
    END;

  BEGIN { T }
    FOR wahl:=auswahlanfang TO auswahlende DO
    BEGIN
      neuvektor:=vektor;
      neuvektor[0]:=stufe;           {Stelligkeit setzen}
      neuvektor[stufe]:=wahl;        {Auswahl Objekt i treffen}
      vektor_bewerten;
      IF vollstaendig
        THEN BEGIN IF neues_optimum THEN loesung_speichern              END
        ELSE BEGIN IF lebend        THEN try(stufe+1,neuvektor,neuwahl) END
    END
  END;

BEGIN
  { Überschrift und kurze Hinweise, Eingaben }
  Writeln; Writeln ('BACKTRACKING: Travelling Salesman');
           Writeln ('---------------------------------');
  Write('E(ingabe oder S(tandardbeispiel ');
  REPEAT Readln(c) UNTIL c IN ['e','E','s','S',#13]; Writeln;
  IF c IN ['S','s']
  THEN BEGIN N:=11; inzidenz:=standard END
  ELSE BEGIN
    zahlein (N, 2, Nmax, 'Anzahl der Orte: ');
    Writeln('Entfernungen als ganze Zahlen eingeben. Falls keine');
    Writeln('Verbindung existiert, bitte -1 eingeben.');
    FOR i:=1 TO N-1 DO
    BEGIN
      inzidenz[i,i]:=0;
      FOR j:=i+1 TO N DO
      BEGIN
        write(i,'-',j,'-');
        zahlein (Inzidenz[i,j],-1,999,'Entfernung : ');
        Inzidenz[j,i]:=Inzidenz[i,j]
      END
    END;
    Writeln
  END;
  FOR i:=1 TO N DO
  BEGIN
    write(i:2,': ');
    FOR j:=1 TO N DO
      IF inzidenz[i,j]<0 THEN write('   -') ELSE write(Inzidenz[i,j]:4);
    Writeln
  END;
  { Initialisierung, Lösungssuche }
  auswahlende:=N;
  akt_optimum:=Maxint;
  gewaehlt:=[];
  vektor[0]:=0;
  vektor[-1]:=0;
  try (1,vektor,gewaehlt);
  { Ausgabe }
  Writeln;
  IF akt_optimum=Maxint THEN Writeln('Geht nicht !')
  ELSE  BEGIN
    Writeln('Entfernung: ',akt_optimum);
    FOR i:=1 TO N DO Write(loesung[i],', '); Writeln(loesung[1])
  END
END.