Kreuzworträtsel und Rekursion

[endeffects]

Hallo,

ich arbeite seit gestern an einem Tool das Kreuzworträtsel dekodieren soll.
Angefangen habe ich ersteinmal mit einem Feld von 5 x 5 Buchstaben um es überschaubar zu halten.
In diesem Feld sind wahlos Buchstaben verteilt die es gilt zu sinnvollen Wörtern zu verbinden.
Um das Ganze noch unnötig schwierig zu gestalten sind Verbindungen sowohl horizontal, vertikal
als auch diagonal möglich und das von jedem Buchstaben aus.

Um einen Einstieg zu finden habe ich mit dem Buchstaben in der Mitte angefangen.
Nun hab ich mir also gedachte sammel ich alle möglichen und gültigen Buchstabenkombinationen
und gleiche diese dann anschließend mit der Wortliste ab.

Nun stehe ich aber vor dem Problem das ich nicht weiß welche Felder schon verbunden wurden
und welche noch ausstehen - letztendlich fehlen nämlich immer wieder Kombinationen.

Hier mal ein klein wenig Code:

PlayField ist ein Array in der Größe 5x5
und kann jederzeit erneuert werden.

Delphi-Quellcode:

procedure Find(X, Y: Integer);
var ActualChar: String; loop: Integer;
begin
  ActualChar:= PlayField[X, Y];

  if ActualChar= '#' then
    exit;

  Tracker:= Tracker+ActualChar;

  { Look left }
  if (X > 0) then
  begin
    PlayField[X, Y]:= '#';
    Find(X - 1, Y);
  end
  else

  { Look left up }
  if (X > 0) and (Y > 0) then
  begin
    PlayField[X, Y]:= '#';
    Find(X - 1, Y - 1);
  end
  else

  { Look up }
  if (Y > 0) then
  begin
    PlayField[X, Y]:= '#';
    Find(X, Y - 1);
  end
  else

  { Look right up}
  if (X < 4) and (Y > 0) then
  begin
    PlayField[X, Y]:= '#';
    Find(X + 1, Y - 1);
  end
  else

  { Look right }
  if (X < 4) then
  begin
    PlayField[X, Y]:= '#';
    Find(X + 1, Y);
  end
  else

  { Look right down}
  if (X < 4) and (Y < 4) then
  begin
    PlayField[X, Y]:= '#';
    Find(X + 1, Y + 1);
  end
  else

  { Look down }
  if (Y < 4) then
  begin
    PlayField[X, Y]:= '#';
    Find(X, Y + 1);
  end
  else

  { Look left down}
  if (X > 0) and (Y < 4) then
  begin
    PlayField[X, Y]:= '#';
    Find(X - 1, Y - 1);
  end;
end;

Wenn ich nun alles mit dem String '#' zupflaster dann wird
die Rekursion frühzeitig abgebrochen und es fehlen eine
Vielzahl von Möglichkeiten - z.B. wenn sich die Wörter
durch das ganze Feld schlängeln.

Wenn ich die 'else' Bedingung entferne dann entstehen
Kombinationen die nicht erlaubt sind, soll heißen
das Buchstaben an den String Tracker gehängt werden
die nicht an die aktuellen Koordinaten grenzen.

Momentan bin ich ein wenig ratlos wie ich an das Problem rangehen soll. :(
Hat Jemand vielleicht einen besseren Lösungsansatz?


MfG

[glkgereon]

hmm, also spontan würde ich das so machen:

Delphi-Quellcode:

type
  TArr = array [1..5,1..5] of char;

function Getwords(Arr: TArr; x,y, xchange, ychange:Integer):TStringList;
var Temp:String;
begin
  Result.Clear;
  Temp:='';
  while (x<6) and (x>0) and (y<6) and (y>0) do
    begin
    Temp:=Temp+Arr[x,y];
    Result.Add(Temp);
    x:=x+xchange;
    y:=y+ychange;
    end;    
end;

procedure GetAll(Arr: TArr; var Words: TStringList);
var x,y:Integer;
begin
  for x:=1 to 5 do
    for y:=1 to 5 do
      begin
      Words.AddStrings(GetWords(Arr,x,y,1,0));  //rechts
      Words.AddStrings(GetWords(Arr,x,y,-1,0)); //links
      Words.AddStrings(GetWords(Arr,x,y,0,1));  //unten
      Words.AddStrings(GetWords(Arr,x,y,0,-1)); //oben
      Words.AddStrings(GetWords(Arr,x,y,1,1));  //rechts unten
      Words.AddStrings(GetWords(Arr,x,y,1,-1)); //rechts oben
      Words.AddStrings(GetWords(Arr,x,y,-1,1)); //links unten
      Words.AddStrings(GetWords(Arr,x,y,-1,-1));//links oben
      end;
end;

es sind mit sicherheit noch fehler drin (kann man tstringlist als result machen?), ich erstelle keine einzige klasse, aber vom prinzip sollte es gehen...

es werden von allen punkten aus alle kombis aufgelistet die es gibt.

das sind viele :)

[endeffects]

wenn ich das nun richtig deute dann werden
auch kombinationen aufgenommen die nicht erlaubt sind,
z.b. werden bereits 'markierte' buchstaben wieder zu einer
buchstaben kombination herrangezogen

ich werde es mal über eine liste mit koordinaten probieren,
aber danke für deine Hilfe :)

[glkgereon]

achsoooo....jetzt kapier ich was du genau willst :)

ok, neuer versuch :)

2 Möglichkeiten: Permutationen erstellen, oder anhand des arrays finden

Delphi-Quellcode:

procedure GetAll(const Arr: TArr; var Words: TStringlist);

  procedure Find(const AktArr: TArr; const Rec,x,y:Integer; const T: String);
  var Temp:String;
      TA: TArr;
  begin
    TA:=AktArr;
    Temp:=T;
    if TA[x,y]='#' then Exit; //Wenn ungültig dann raus

    Temp:=Temp+TA[x,y];  //zu string
    if Rec=25 then Words.Add(Temp); //wenn tiefe maximum dann ergebnis

    TA[x,y]:='#'; //falsch setzen

    if x>1 then Find (TA,Rec+1,x-1,y,Temp);
    if x<5 then Find (TA,Rec+1,x+1,y,Temp);
    if y>1 then Find (TA,Rec+1,x,y-1,Temp);
    if y<5 then Find (TA,Rec+1,x,y+1,Temp);
    if (x>1) and (y>1) then Find (TA,Rec+1,x-1,y-1,Temp);
    if (x>1) and (y<5) then Find (TA,Rec+1,x-1,y-1,Temp);
    if (x<5) and (y>1) then Find (TA,Rec+1,x-1,y-1,Temp);
    if (x<5) and (y<5) then Find (TA,Rec+1,x-1,y-1,Temp);
  end;

var x, y:Integer;
begin
  for x:=1 to 5 do
    for y:=1 to 5 do
      Find(Arr,1,x,y,'');
end;

Edit: jetzt syntaktisch korrekt....