Autor |
Beitrag |
freak89
      
Beiträge: 29
|
Verfasst: So 13.05.07 16:25
Hallo,
ich habe versucht das Damenproblem mit Backtracking zu lösen, allerdings spuckt mein Programm mir nur bei n=1, n=2, n=3, n=5 und n=7 das richtige aus. Sieht jemand den Fehler in meinem Programm?
Kurze Erläuterung: Das Damenproblem sucht eine Möglichkeit n Damen auf einem n*n großen Schachbrett zu verteilen, ohne dass sie sich gegenseitig schlagen.
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: 79: 80: 81: 82: 83: 84: 85: 86: 87: 88: 89: 90: 91: 92: 93: 94: 95: 96: 97: 98: 99: 100: 101: 102: 103: 104: 105: 106: 107: 108: 109: 110: 111: 112: 113: 114: 115: 116: 117: 118: 119: 120: 121: 122: 123: 124: 125: 126: 127: 128: 129: 130: 131: 132: 133: 134: 135: 136: 137: 138: 139: 140: 141: 142: 143: 144: 145: 146: 147: 148: 149: 150: 151: 152: 153: 154: 155: 156: 157: 158:
| unit Unit1;
interface
uses Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls, ExtCtrls; const max=15; type Tmeinfeld=array[1..max,1..max] of integer; TForm1 = class(TForm) Image1: TImage; eingabe: TEdit; Button1: TButton; Button2: TButton; procedure Button1Click(Sender: TObject); procedure Button2Click(Sender: TObject); private procedure rechne; function dame(feld:Tmeinfeld;var x:integer) : boolean; procedure ausgabe; public end;
var
Form1: TForm1; n,z : integer; gesamt: Tmeinfeld;
implementation
{$R *.DFM}
procedure TForm1.Button1Click(Sender: TObject); var i: integer; begin z:=20; n:=strtoint(eingabe.text); image1.Width:= Z*n ; image1.height:= Z*n ; with image1.canvas do begin for i:=0 to n do begin moveto(i*Z,0); lineto(i*Z,Z*n); end; for i:=0 to n do begin moveto(0,i*Z); lineto(n*Z,i*Z); end; end; end;
function Tform1.dame(feld:Tmeinfeld;var x: integer): boolean; var a,x1,i,r,p,q,c,d,b,e,f : integer; jo: boolean; feld2:Tmeinfeld; label lab1,lab2; begin lab1: dame:=false; x1:=x; feld2:=feld; for a:=1 to n do begin for b:=1 to n do begin if feld[a,b]=0 then begin for i:=1 to n do begin feld[a,i]:=2; end; for i:=1 to n do begin feld [i,b]:=2; end; for i:=1 to n do begin c:=a+i; if c>n then c:=c-n; d:=b+i; if d>n then d:=d-n; feld[c,d]:=2; end; for i:=1 to n do begin c:=a+i; if c>n then c:=c-n; d:=b-i; if d<1 then d:=n+d; feld[c,d]:=2; end; feld[a,b]:=1; e:=a; f:=b; inc(x); dame:=true; goto lab2; end; end; end; lab2: if x=n then gesamt:=feld else if (x>x1) then begin p:=0; jo:=dame(feld,x); if (jo=false) and (p<n) then begin inc(p); x:=x1; feld:=feld2; feld[e,f]:=2; goto lab1; end else if (jo=false) and (p=n) then dame:=false; end; end;
procedure TForm1.rechne; var feld: Tmeinfeld; i,y,a,x,b : integer; jo: boolean; begin x:=0; for i:=1 to n do begin for y:=1 to n do begin feld[i,y]:=0; end; end; x:=0; dame(feld,x); if x=n then ausgabe else showmessage('Es gibt keine Loesungen für n Damen auf diesem n mal n großen Feld'); end;
procedure Tform1.ausgabe; var i,a,b,y: integer; begin for i:=1 to n do begin for y:=1 to n do begin if gesamt[i,y]=1 then for a:=1 to z-1 do begin with image1.canvas do begin moveto(i*Z-Z+1,y*Z-Z+a); lineto(i*Z,y*Z-Z+a); end; end; end; end; end;
procedure TForm1.Button2Click(Sender: TObject); begin rechne; end;
end. |
Vielen Dank im voraus.
Moderiert von raziel: Code- durch Delphi-Tags ersetzt
|
|
Christian V.
      
Beiträge: 311
Win Xp Prof
Turbo Delphi 2005
|
Verfasst: So 13.05.07 18:04
So wie ich das sehe, kann dein Programm nur einen Schritt zurückgehen, allerdings nicht zwei:
Dein Programm verscuht eine Dame zu setzten, findet aber keine Stelle, dann lädt dein Programm wider die Daten vor dem Durchgang, und setzt das feld, wo die Dame gestanden ist auf unmöglich. Nun wird die nächste Dame gesucht. Was aber wenn die nun zuletzt gesetzte dame auch schon falsch ist? Ich denke dein Programm kann diese nicht mehr löschen.
_________________ Hardware runs the world, software controls the hardware, code generates software - Have You already coded today?
|
|
freak89 
      
Beiträge: 29
|
Verfasst: So 13.05.07 21:05
Vielen Dank, leider kann ich diesen Fehler nicht nachvollziehen, wo genau entsteht er? Ist es möglich das Programm mit wenigen Handgriffen funktionsfähig zu machen?
|
|
alzaimar
      
Beiträge: 2889
Erhaltene Danke: 13
W2000, XP
D6E, BDS2006A, DevExpress
|
Verfasst: So 13.05.07 21:12
_________________ Na denn, dann. Bis dann, denn.
|
|
Christian V.
      
Beiträge: 311
Win Xp Prof
Turbo Delphi 2005
|
Verfasst: Mo 14.05.07 17:08
Nun, du speicherst ja immer dein feld bevor du veränderungen machst. Falls die Dame die zuletzt gesetzt wuder falsch ist, wird das alte wider geladen, schön und gut. Nun fängst du wieder an, und speicherst dein aktuelles Feld. In der die 2. letzte Dame(nach dem löschen ist diese nun die zu letzt gesetzte Dame) was aber wenn diese auch falsch war? Du kannst den vorherigen Stand nicht mehr zurückholen. (Ich bin mir aber nicht ganz sicher, da die Sprünge die du machst ein wenig verwirrend sind.)
Ich würde noch ein neues Array hinzufügen, in dem die Zahl des Feldes steht, die es auf 2(also unmöglich) gesetzt hat speichern. So kannst du beim entfernen auch prüfen, ob nicht falshce einträge gelöscht werden. Ansonsten orientier dich am Verfahren, das alzaimar gepostet hat.
_________________ Hardware runs the world, software controls the hardware, code generates software - Have You already coded today?
|
|
Horst_H
      
Beiträge: 1654
Erhaltene Danke: 244
WIN10,PuppyLinux
FreePascal,Lazarus
|
Verfasst: Mo 14.05.07 22:04
Hallo,
Nikolaus Wirth hatte doch eine schöne Lösung komponiert, mit der die Prüfung auf Diagonalen ganz simpel ist.
www.mactech.com/arti...eEightQueensProblem/
Ich habe meine Uralt Version (in der Kante von 2001) nicht mehr gefunden, aber rekonstruiert.
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: 79: 80: 81: 82: 83: 84: 85:
| program NQueens; {$Apptype console} uses sysutils; const nmax = 15; type tLR_diagonale = array[-nmax+1..nmax-1] of boolean; tRL_diagonale = array[2..nmax+nmax] of boolean; tFreieSpalte = array[1..nmax] of integer; var LR_diagonale:tLR_diagonale; RL_diagonale:tRL_diagonale; FreieSpalte : tFreieSpalte; i, n : integer; gblCount : integer; T0,T1 : TdateTime;
procedure SetzeDame(Zeile:integer); var i,Spalte : integer; begin IF Zeile <= n then begin For i := Zeile to n do begin Spalte := FreieSpalte[i]; If LR_Diagonale[Zeile-Spalte] AND RL_Diagonale[Zeile+Spalte] then begin LR_Diagonale[Zeile-Spalte] := false; RL_Diagonale[Zeile+Spalte] := false; FreieSpalte[i] := FreieSpalte[Zeile]; FreieSpalte[Zeile] := Spalte; SetzeDame(Zeile+1); FreieSpalte[Zeile] := FreieSpalte[i]; FreieSpalte[i] := Spalte; LR_Diagonale[Zeile-Spalte] := true; RL_Diagonale[Zeile+Spalte] := true; end; end; end else begin inc(gblCount); end; end;
begin For i := 1 to nmax do FreieSpalte[i] := i; fillchar(LR_Diagonale[low(LR_Diagonale)],sizeof(tLR_Diagonale),#255); fillchar(RL_Diagonale[low(RL_Diagonale)],sizeof(tRL_Diagonale),#255);
For n := 1 to 15 do begin t0 := time; gblCount := 0; SetzeDame(1); t1:= time; WriteLn(n:6,gblCount:13,FormatDateTime(' hh:mm:ss.zzz',T1-t0)); end;
Readln; end. |
Das Programm nutzt eine Liste der verfügbaren Spalten FreieSpalten.
Wenn eine Spalte genutzt wird , wird Sie praktisch für die nachfolgenden Zeilen aus dem Zugriff entfernt in dem Sie weggetauscht wird.
Das heisst, das Feld freieSpalten ist aufgeteilt:
Im Bereich 1..Zeile-1 stehen die benutzten Spalten und im Bereich Zeile..n die noch freien Spalten.
Ich hoffte, damit ein If zu sparen und es schneller zu machen.
Delphi-Quelltext 1: 2: 3: 4: 5: 6:
| For Spalte := 1 to n do begin IF IstFreieSpalte[Spalte] then begin |
Die Zeiten steigen gegenüber dem Vorgänger um ~n/2 dass heißt n=15 dauert ~7 mal so lang wie n= 14
Performanter geht es natürlich durch ausnutzen der Symmetrien :
www.ic-net.or.jp/home/takaken/e/queen/
Gruß Horst
Für diesen Beitrag haben gedankt: Mathematiker
|
|
freak89 
      
Beiträge: 29
|
Verfasst: Do 17.05.07 17:39
Vielen Dank für eure Hilfe, meine Lösung sieht nun wie folgt aus:
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: 79: 80: 81: 82: 83: 84: 85: 86: 87: 88: 89: 90: 91: 92: 93: 94: 95: 96: 97: 98: 99: 100: 101: 102: 103: 104: 105: 106: 107: 108: 109: 110: 111: 112: 113: 114: 115: 116: 117: 118: 119: 120: 121: 122: 123: 124: 125: 126: 127: 128: 129: 130: 131: 132: 133: 134: 135: 136: 137: 138: 139: 140: 141: 142: 143: 144: 145:
| unit Unit1;
interface
uses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls, ExtCtrls; const nmax=15; type Tfeld = array[1..nmax,1..nmax]of integer; Tfeld2 = array[1..nmax,1..nmax,1..nmax+1]of integer; TForm1 = class(TForm) Button1: TButton; Button2: TButton; Image1: TImage; Edit1: TEdit; procedure Button1Click(Sender: TObject); procedure Button2Click(Sender: TObject); private function dame(zeile:integer) : boolean; procedure ausgabe; public end;
var Form1: TForm1; feld : Tfeld; backup: Tfeld2; n: integer;
implementation
{$R *.dfm}
function Tform1.dame(zeile:integer) : boolean; var i,a,b,z,x, y:integer; label lap1; begin lap1: for i:=1 to n do begin for y:=1 to n do begin backup[i,y,zeile]:=feld[i,y]; end; end; if zeile=n+1 then dame:=true else begin x:=1; for i:=1 to n do begin if feld[zeile,i]=0 then begin for y:=zeile to n do begin feld[y,i]:=2; end; for y:=1 to n do begin a:=zeile+y; b:=i+y; if (a<=n) and (b<=n) then feld[a,b]:=2; end; for y:=1 to n do begin a:=zeile+y; b:=i-y; if (a<=n) and (b>=1) then feld[a,b]:=2; end; feld[zeile,i]:=1; z:=i; inc(x); break; end; end; if x=1 then dame:=false else if Dame(zeile+1)=true then Dame:=true else begin for i:=1 to n do begin for y:=1 to n do begin feld[i,y]:=backup[i,y,zeile]; end; end; feld[zeile,z]:=2; goto lap1; end; end; end;
procedure Tform1.ausgabe; var i,a,b,q,y: integer; begin q:=20; for i:=1 to n do begin for y:=1 to n do begin if feld[i,y]=1 then for a:=1 to q-1 do begin with image1.canvas do begin moveto(i*q-q+1,y*q-q+a); lineto(i*q,y*q-q+a); end; end; end; end; end;
procedure TForm1.Button1Click(Sender: TObject); var q,p: integer; begin p:=20; n:=strtoint(edit1.text); image1.Width:= p*n ; image1.height:= p*n ; with image1.canvas do begin for q:=0 to n do begin moveto(q*p,0); lineto(q*p,p*n); end; for q:=0 to n do begin moveto(0,q*p); lineto(n*p,q*p); end; end; end;
procedure TForm1.Button2Click(Sender: TObject); var i,y,a,x,b : integer; jo: boolean; begin x:=0; for i:=1 to n do begin for y:=1 to n do begin feld[i,y]:=0; end; end; if dame(1) = true then ausgabe else showmessage('Es gibt keine Loesungen für n Damen auf diesem n mal n großen Feld'); end;
end. |
|
|
Jann1k
      
Beiträge: 866
Erhaltene Danke: 43
Win 7
TurboDelphi, Visual Studio 2010
|
Verfasst: Fr 18.05.07 00:00
Zitat: | Das Damenproblem sucht eine Möglichkeit n Damen auf einem n*n großen Schachbrett zu verteilen, ohne dass sie sich gegenseitig schlagen. |
zwar etwas OT aber, so kann das ja nicht stimmen oder? ich meine bei einer dame gäbs noch ne lösung aber es ist doch schon unmöglich 2 damen auf einem 2x2 großen feld zu platzieren, ohne dass sie sich schlagen können.
€: ahh okay, grad den wiki artikel dazu durchgelesen...vergesst den post
|
|
|