Start       Delphi


Delphi

Backtracking

Delphi

Dieses Programm schrieb ich ursprünglich ca. 1987 für den Atari ST, den Nachfolger des C64 (Computerfreaks - ja das gab es einmal! - bekommen bei Erwähnung dieses Namens glänzende Augen), in Pascal.

Nebenbei erwähnt: Das Betriebssystem des Atari ST umfasste 192 KByte. Im Gegensatz zu Microsfts DOS hatte der Atari ST wie die Apple-Computer eine graphische Oberfläche. Das Betriebssystem passte in den ROM, d.h. nach dem Einschalten war der Computer sofort betriebsbereit. Windows XP benötigt rund 10 000 mal mehr Ressourcen. Die Größenordnung der dadurch entstehenden Sicherheitslücken vermag ich nicht abzuschätzen.

Das Programm besticht durch seine Einfachheit bedingt durch rekursives Programmieren.

Wenn man folgende zwei Regeln beachtet, wird das Programmieren einer rekursiven Prozedur zum Vergnügen: Download Quelltext und ausführbares Programm auf der Downloadseite unter dem Namen "Irrgarten" möglich.

Unter Backtracking versteht man einen Algorithmus, der mit Versuch und Irrtum arbeitet. Es wird hier am Beispiel eines Irrgartens veranschaulicht.

Im folgenden Programm wird zuerst ein Irrgarten erzeugt. Der Besucher soll dann den Weg von Nord-Westen (links-oben) nach Süd-Osten (rechts-unten) finden. Das Programm macht das nach folgender Strategie:

Gehe - wenn möglich - einen Schritt nach Osten und von dort aus ans Ziel, sonst - wenn möglich - einen Schritt nach Süden, Westen bzw. Norden.

Markiere Deinen Weg gelb. Falls Du jedoch in einer Sackgasse landest, markiere Deinen Weg rot, damit Du nicht im Kreis herumlaufen musst.

Labyrinth

Das Ganze wird mit der Prozedur FindePfad rekusiv berechnet.

Das Hauptprogramm besteht aus zwei Zeilen: 
if findepfad(0,0) then showmessage('Ziel erreicht') else
    showmessage('Ziel ist nicht erreichbar!');
Die wichhtigste Prozedur ist FindePfad: 
function findepfad(reihe,spalte: integer): boolean;
  var b: boolean;
      r: integer;
begin
  if (reihe=Row) and (spalte=Col) then Begin
    result := true; //Ziel erreicht
    zeichne(reihe,spalte,gelb);
    exit; //fertig
  End;
  if (reihe < 0) or (spalte < 0) or (reihe > Row) or (Spalte > Col) then Begin
    result := false; //Ziel ist nicht erreichbar
    exit;
  End;
  Case grid[reihe,spalte] of
     schwarz,gelb,rot: result := false; //Wand erreicht oder schon dagewesen
     weiss: BEgin //Stelle neu erreicht
              zeichne(reihe,spalte,gelb); //Zunächst einmal
              b := false;
              r := 1;
              while (not b) and (r < 5) do BEGin
                caSe r of
                  1: b := findepfad(reihe, spalte + 1, mitZiel);
                  2: b := findepfad(reihe + 1, spalte, mitZiel);
                  3: b := findepfad(reihe, spalte - 1, mitZiel);
                  4: b := findepfad(reihe - 1, spalte, mitZiel);
                enD;
                if b then break; //b=true: Von Hier aus gibt es einen Weg ans Ziel.
                                 //break heißt: Verlasse sofort die whileschleife
                inc(r);
              END;
              if not b then zeichne(reihe,spalte,rot); //Hier nie wieder starten!
              result := b;
            ENd;
  End;
end;
Hier das Wichtigst der Unit mit den Hilfsprozeduren. Einige Programmpunkte wurden noch hinzugefügt.

Der Zustand der Felder wird im Array grid[0..Row,0..Col] gespeichert. 
...
type TMeineFarben = (weiss, schwarz, gelb, rot);
const ModulFuerRandomfolge = 210018313; //Primzahl
      breite = 8;
      Row = 40; //Von 0 bis Row = Anzahl Row+1
      Col = 60; //Von 0 bis Col = Anzahl Col+1
var
  Form1: TForm1;
  grid: array[0..Row,0..Col] of TmeineFarben;
  zaehl: integer;
  verzoegerung: integer = 10;
implementation
{$R *.DFM}
procedure zeichne(reihe,spalte: integer; farbe: TMeineFarben); //Farbe von 0 bis Maxfarbe
begin
 grid[reihe,spalte] := farbe;
 with form1.image1.Canvas do Begin
   pen.Width := 1;
   pen.Color := clblack;
   Case farbe of weiss:   brush.color := clwhite;
                 schwarz: brush.color := clblack;
                 gelb:    brush.color := clyellow;
                 rot:     brush.Color := clred;
   End;
     rectangle(breite*spalte,breite*reihe,breite*succ(spalte),breite*succ(reihe));
   end;
end;
procedure zeichneAlles;
   const rand = 20;
   var i,j: integer;
begin
  with Form1 do Begin
    top := 0;
    left := 0;
    clientwidth := (col+1)*breite + 2*rand;
    clientHeight := (Row+1)*breite + 2*rand;
    color := clblue;
    with image1 do BEgin
      width := (Col+1)*breite;
      height := (Row+1)*breite;
      left := rand;
      top := rand;
    ENd;
  End;
  for i := 0 to Row do for j := 0 to Col do
      zeichne(i,j,grid[i,j]);
end;
procedure TForm1.FormCreate(Sender: TObject);
  var i,j: Integer;
begin
   for i := 0 to Row do for j := 0 to Col do grid[i,j] := weiss;
   zeichneAlles;
end;
procedure Anfangszustand(SetzteRandseed,prozent: integer);
  var i, j: integer;
begin
  randseed := SetzteRandseed;
  form1.Caption := 'Anfangswert =' + inttostr(SetzteRandseed);
  zaehl := 0;
  for i := 0 to Row do for j := 0 to Col do
    if random(100) < prozent then grid[i,j] := schwarz else grid[i,j] := weiss;
  grid[0,0] := weiss;
  grid[row,col] := weiss;
  zeichneAlles;
end;
function findepfad(reihe,spalte: integer; mitZiel: boolean): boolean;
  var b: boolean;  //MitZiel = false: Siehe unten "WelchesZielisterreichbar1Click"
      r: integer;
begin
  inc(zaehl);
  if verzoegerung > 0 then Begin
     sleep(verzoegerung);
     application.ProcessMessages;
  End;
  if (reihe=Row) and (spalte=Col) then Begin
    result := true;
    zeichne(reihe,spalte,gelb);
    if Mitziel then exit; //fertig
  End;
  if (reihe < 0) or (spalte <0) or (reihe > Row) or (Spalte > Col) then Begin
    result := false;
    exit;
  End;
  Case grid[reihe,spalte] of schwarz,gelb,rot: result := false;
                                    //Wand oder Stelle schon rerreicht
                    weiss: BEgin//Stelle neu erreicht
                      zeichne(reihe,spalte,gelb);
                      b := false;
                      r := 1;
                      while (not b) and (r < 5) do BEGin
                        caSe r of
                          1: b := findepfad(reihe, spalte + 1, mitZiel);
                          2: b := findepfad(reihe + 1, spalte, mitZiel);
                          3: b := findepfad(reihe, spalte - 1, mitZiel);
                          4: b := findepfad(reihe - 1, spalte, mitZiel);
                        enD;
                        if b then break; //b=true: Von Hier aus gibt es einen Weg ans Ziel
                        inc(r);
                      End;
                      if not b then zeichne(reihe,spalte,rot);
                      result := b;
                    ENd;
                    else result := false; //kommt nicht vor. Beruhigt aber Compiler.
  End;
end;
procedure TForm1.ZuflligeVerteilung1Click(Sender: TObject);
begin
  randomize;
  Anfangszustand(randseed,33);
end;
procedure TForm1.Beispiel11Click(Sender: TObject);
begin
  Anfangszustand(38,33);
end;
procedure TForm1.Bisrechtsunten1Click(Sender: TObject);
begin
 if findepfad(0,0,true) then showmessage('Ziel erreicht') else
    showmessage('Ziel nicht erreicht!');
  form1.Caption :=  form1.Caption  + ' Schritte =' + inttostr(zaehl);
end;
procedure TForm1.WelchesZielisterreichbar1Click(Sender: TObject);
begin //Hier wid getestet, welche Felder überhaupt erreichbar sind.
  if findepfad(0,0,false) then {};
  showmessage('Gelb: Ziel erreicht.'#13+
     'Weiss: Felder die nicht erreicht werden können');
end;
procedure TForm1.KeineVerzgerung1Click(Sender: TObject);
begin
  verzoegerung := 0;
end;
procedure TForm1.Verzoegerung10msClick(Sender: TObject);
begin
  verzoegerung := 10;
end;
  nach oben weiter Kryptologie