Autor |
Beitrag |
DerNetteNachbar
      
Beiträge: 224
|
Verfasst: 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.
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 public 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 <> 0) and (x < 9) and (Form1.strngrd1.Cells[x-1,y] = '') then WegSuche(x-1,y); if (y <> 0) and (y < 9) and (Form1.strngrd1.Cells[x,y-1] = '') then WegSuche(x,y-1); if (x <> 0) and (x < 9) and (Form1.strngrd1.Cells[x+1,y] = '') then WegSuche(x+1,y); if (y <> 0) and (y < 9) and (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 = 0) and (j mod 2 = 0) then begin strngrd1.Cells[i, j] := 'L'; end; strngrd1.Cells[2, 2] := '10'; strngrd1.Cells[0, 0] := ''; end;
procedure TForm1.btn1Click(Sender: TObject); begin WegSuche(3, 3); end;
end. |
Danke schon mal für euere Mühe 
|
|
SvenAbeln
      
Beiträge: 334
Erhaltene Danke: 3
|
Verfasst: Fr 14.11.08 16:13
Hallo,
ohne dein Programm genau anzusehen, solltest du dies aber noch mal überdenken:
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
      
Beiträge: 1248
Erhaltene Danke: 187
XP - Server 2008R2
D2 - Delphi XE
|
Verfasst: 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
Delphi-Quelltext 1: 2: 3: 4:
| Function Searchable(const s:String):Boolean; begin Result := (s = '10') or (s=''); end; |
MfG
bummi
Moderiert von matze: Delphi-Tags hinzugefügt
|
|
DerNetteNachbar 
      
Beiträge: 224
|
Verfasst: 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
      
Beiträge: 1207
Erhaltene Danke: 31
Win 10
Delphi 2009 Pro, C++ (Visual Studio)
|
Verfasst: 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
      
Beiträge: 2889
Erhaltene Danke: 13
W2000, XP
D6E, BDS2006A, DevExpress
|
Verfasst: 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:
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 
      
Beiträge: 224
|
Verfasst: 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
      
Beiträge: 2889
Erhaltene Danke: 13
W2000, XP
D6E, BDS2006A, DevExpress
|
Verfasst: Mo 17.11.08 11:02
Welche 'ganzen Varianten' ?
_________________ Na denn, dann. Bis dann, denn.
|
|
DerNetteNachbar 
      
Beiträge: 224
|
Verfasst: 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
      
Beiträge: 1248
Erhaltene Danke: 187
XP - Server 2008R2
D2 - Delphi XE
|
Verfasst: Mo 17.11.08 12:10
Titel: vieleicht hilfreicher Artikel
|
|
|