Autor Beitrag
DerNetteNachbar
ontopic starontopic starontopic starontopic starontopic starontopic starofftopic starofftopic star
Beiträge: 224



BeitragVerfasst: Fr 14.11.08 15:57 
Schönen Guten Tag an alle, hab ein Problem, aber für euch sicher nichts neues ;-)
Komm ab einer Stelle einfach nicht weiter, es wird zwar ganze Zeit ein Weg gesucht sprich ausprobiert Markierungen zu setne was auch völlig richtig ist, aber nach ein paar Schritten werden alle Markierungen zurückgesetzt und ich bin aufeinmal bei 0,0 und ab da beginnt dann die Endlosschleife.

ausblenden volle Höhe Delphi-Quelltext
1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:
30:
31:
32:
33:
34:
35:
36:
37:
38:
39:
40:
41:
42:
43:
44:
45:
46:
47:
48:
49:
50:
51:
52:
53:
54:
55:
56:
57:
58:
59:
60:
61:
62:
63:
64:
65:
66:
67:
68:
69:
70:
71:
72:
73:
74:
75:
76:
77:
78:
unit LabyrintPro;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, Grids, ExtCtrls, jpeg;

type
  TForm1 = class(TForm)
    btn1: TButton;
    strngrd1: TStringGrid;
    procedure FormActivate(Sender: TObject);
    procedure btn1Click(Sender: TObject);
  private
    { Private-Deklarationen }
  public
    { Public-Deklarationen }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure MarkeSetzen(x,y: integer; c: char);
begin
Form1.strngrd1.Cells[x, y] := c;
end;

function ZielErreicht(x, y: integer): boolean;
begin
  if (Form1.strngrd1.Cells[x, y] = '10'then
    result := true
  else
    result := false;
end;

function WegSuche(x, y: integer): integer;
begin
ShowMessage(IntToStr(x));
MarkeSetzen(x,y,'M');
    if ZielErreicht(x,y) then
    begin
    ShowMessage('Ziel erreicht');
    end
    else
    begin
    if (x <> 0and (x < 9and (Form1.strngrd1.Cells[x-1,y] = '')  then WegSuche(x-1,y);
    if (y <> 0and (y < 9and (Form1.strngrd1.Cells[x,y-1] = ''then WegSuche(x,y-1);
    if (x <> 0and (x < 9and (Form1.strngrd1.Cells[x+1,y] = ''then WegSuche(x+1,y);
    if (y <> 0and (y < 9and (Form1.strngrd1.Cells[x,y+1] = ''then WegSuche(x,y+1);
    end;
MarkeSetzen(x,y,' ');
end;

procedure TForm1.FormActivate(Sender: TObject);
var i, j: integer;
begin
  for i := 0 to strngrd1.ColCount - 1 do
    for j := 0 to strngrd1.RowCount - 1 do
      if (i mod 2 = 0and (j mod 2 = 0then
      begin
        strngrd1.Cells[i, j] := 'L';
      end;
  strngrd1.Cells[22] := '10';
  //strngrd1.Cells[0, 0] := '10';
    strngrd1.Cells[00] := '';
end;

procedure TForm1.btn1Click(Sender: TObject);
begin
  WegSuche(33);
end;

end.



Danke schon mal für euere Mühe ;-)
SvenAbeln
ontopic starontopic starontopic starontopic starontopic starontopic starontopic starontopic star
Beiträge: 334
Erhaltene Danke: 3



BeitragVerfasst: Fr 14.11.08 16:13 
Hallo,

ohne dein Programm genau anzusehen, solltest du dies aber noch mal überdenken:
ausblenden Delphi-Quelltext
1:
2:
MarkeSetzen(x,y,'M');
    if ZielErreicht(x,y) then


Zelle[x,y] auf 'M' setzten und dann schauen ob Zelle[x,y] = '10'.
Das macht nicht viel Sinn, denn dort steht nun 'M'.
bummi
ontopic starontopic starontopic starontopic starontopic starontopic starontopic starontopic star
Beiträge: 1248
Erhaltene Danke: 187

XP - Server 2008R2
D2 - Delphi XE
BeitragVerfasst: Fr 14.11.08 16:27 
Titel: Zelle wird niemals geprüft
MarkeSetzen(x,y,'M');
nach Prüfen auf Ziel

und

Searchable(Form1.strngrd1.Cells[x-1,y])
statt
Form1.strngrd1.Cells[x-1,y]=''

sollte helfen

ausblenden Delphi-Quelltext
1:
2:
3:
4:
Function Searchable(const s:String):Boolean;
begin
  Result := (s = '10'or (s='');
end;


MfG
bummi

Moderiert von user profile iconmatze: Delphi-Tags hinzugefügt
DerNetteNachbar Threadstarter
ontopic starontopic starontopic starontopic starontopic starontopic starofftopic starofftopic star
Beiträge: 224



BeitragVerfasst: Fr 14.11.08 16:56 
Dank euch, hat hingehauen....;-)
Sagt mal wie kann man diesen Algorithmus jetzt von der Laufzeit her verbessern bzw. optimieren.
Flamefire
ontopic starontopic starontopic starontopic starontopic starontopic starontopic starhalf ontopic star
Beiträge: 1207
Erhaltene Danke: 31

Win 10
Delphi 2009 Pro, C++ (Visual Studio)
BeitragVerfasst: Fr 14.11.08 18:56 
ich hätte eine: guck dir backtracking nochmal an!

das was du machst, ist die schlechteste variante nen weg zu suchen: sternförmige suche bis weg gefunden

backtracking heißt: probiere immer die erste möglichkeit, bis ein fehler auftritt, dann mach einen schritt zurück und probiere dort den nächsten schritt, dann weiter bis wieder ein fehler auftritt usw.
alzaimar
ontopic starontopic starontopic starontopic starontopic starontopic starontopic starofftopic star
Beiträge: 2889
Erhaltene Danke: 13

W2000, XP
D6E, BDS2006A, DevExpress
BeitragVerfasst: Fr 14.11.08 19:39 
So ein Backtracking-Algorithmus ist eigentlich sehr einfach:
Zunächst überlegst Du Dir 'einen Schritt' deines Algorithmus. Hier z.B. von einem Feld ins nächste zu laufen. ein Anderer Ansatz wäre, von einer Verzweigung zur nächsten zu laufen. Welchen Weg Du wählst, hängt von der internen Darstellung deines Labyrinthes zusammen (Matrix oder Graph).

So geht Backtracking:

ausblenden Delphi-Quelltext
1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
Var
  LoesungGefunden : Boolean;

Procedure FindeDenAusang (Labyrinth : TLabyrinth; Position : TPosition);
Var
  ErreichbareNachbarPunkte : TPositionList;
  Kandidat : TPosition;

Begin
  Labyrinth.MarkierePositionAlsBesucht (Position);
  ErreichbareNachbarPunkte := Labyrinth.ErzeugeNachbarPunkte (Position);
  For Kandidat in ErreichbareNachbarPunkte Do Begin
    If Labyrinth.IstAusgang (Kandidat) Then Begin
      Labyrinth.ZeigeLoesung;
      LoesungGefunden := True;
    End
    Else 
       FindeDenAusgang (Labyrinth, Kandidat);
    if LoesungGefunden Then Break;
  End;

  Labyrinth.EntferneMarkierung(Position);
End;

Es wird also an jeder Position zunächst eine Liste von möglichen nächsten Schritten erzeugt. Ob man die nun wirklich explizit vorher erzeugt, oder im Labyrinth einfach alle direkten Nachbarn auf Erreichbarkeit prüft, ist hier erstmal egal. Es geht ja nur um das Prinzip.

Ich markiere also die Position, an der ich mich befinde und schaue, in welche Richtung ich gehen könnte.
Wenn ich mich in einem Gang befinde, gibt es nur einen erreichbaren nächsten Punkt, nämlich den nächsten im Gang. Also gehe ich einen Schritt vorwärts.
In einer Sackgasse gibt es keinen erreichbaren Gang, ich muss also zurück (backtracking) und entferne dabei jedesmal den Marker.
An einer Weggabelung existieren mehrere Möglichkeiten. Ich wähle den ersten aus und versuche mein Glück (rekursiver aufruf).
Wenn der rekursive Aufruf hier zurückkommt, führte dieser Weg in eine Sackgasse. Ich versuche dann einfach den nächsten Weg. Wenn alle Wege dieser Gabelung durchprobiert wurden, ist auch der Weg, der zu dieser Gabelung führte eine Sackgasse.
Usw. Usw.

_________________
Na denn, dann. Bis dann, denn.
DerNetteNachbar Threadstarter
ontopic starontopic starontopic starontopic starontopic starontopic starofftopic starofftopic star
Beiträge: 224



BeitragVerfasst: Mo 17.11.08 10:57 
Kann mir vielleicht jemand den Unterschied zwischen den ganzen Varianten des Backtracking erklären. Das verwirrt mich jetzt ein wenig.

Danke im Vorraus.
alzaimar
ontopic starontopic starontopic starontopic starontopic starontopic starontopic starofftopic star
Beiträge: 2889
Erhaltene Danke: 13

W2000, XP
D6E, BDS2006A, DevExpress
BeitragVerfasst: Mo 17.11.08 11:02 
Welche 'ganzen Varianten' ?

_________________
Na denn, dann. Bis dann, denn.
DerNetteNachbar Threadstarter
ontopic starontopic starontopic starontopic starontopic starontopic starofftopic starofftopic star
Beiträge: 224



BeitragVerfasst: Mo 17.11.08 11:05 
Na von der einfachsten Implementierung bis zu der kompliziertesten die auch von der Laufzeit her am besten ist.
bummi
ontopic starontopic starontopic starontopic starontopic starontopic starontopic starontopic star
Beiträge: 1248
Erhaltene Danke: 187

XP - Server 2008R2
D2 - Delphi XE
BeitragVerfasst: Mo 17.11.08 12:10 
Titel: vieleicht hilfreicher Artikel