Entwickler-Ecke

Sonstiges (Delphi) - Lösung des Damenproblem mit Backtracking, Rekursion


freak89 - So 13.05.07 16:25
Titel: Lösung des Damenproblem mit Backtracking, Rekursion
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.

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:
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
    { Public-Deklarationen }
  end;

var

  Form1: TForm1;
  n,z : integer;
  gesamt: Tmeinfeld;

implementation

{$R *.DFM}

procedure TForm1.Button1Click(Sender: TObject);
var i: integer;
begin
  z:=20;                      //MAximalgröße des Brettes
  n:=strtoint(eingabe.text);
  image1.Width:= Z*n       ;  //Passt Bildgröße an
  image1.height:= Z*n       ;
    with image1.canvas do begin
    for i:=0 to n do begin      //Zeichnet leeres Brett
      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;           //Vorbemerkung: im array steht 0 für unbesetzt
begin                      // 1 für Dame und 2 für geschlagenes Feld
lab1:
dame:=false;
x1:=x;                     //Sichert den Wert x am Anfang
feld2:=feld;               //Sichert feld am Anfang
  for a:=1 to n do begin     //Sucht nach freier, ungeschlagener Position
  for b:=1 to n do begin
    if feld[a,b]=0
      then begin
        for i:=1 to n do begin    //Schlägt Vertikale
          feld[a,i]:=2; end;
        for i:=1 to n do begin    //Schlägt Horizontale
          feld [i,b]:=2; end;
        for i:=1 to n do begin    //Schlägt Diagonale
          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  //Schlägt Diagonale
          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;          //Markiert die Positon der Dame
        e:=a;                  //Sichert Koordinaten
        f:=b;
        inc(x);               //Damenzähler erhöhen
        dame:=true;
        goto lab2;           //Springt aus der Schleife heraus
      end;
  end;
  end;
lab2:
if x=n               //wenn alle Damen vollständig, dann feld sichern
  then gesamt:=feld
  else if (x>x1)       //wenn Dame hinzugekommen
    then begin
      p:=0;
      jo:=dame(feld,x);    //rekursiver Aufruf
        if (jo=false) and (p<n)  //wenn keine neue Dame von hier aus möglich
          then begin
            inc(p);                  //erhöhe Versuchszähler
            x:=x1;                   //alter Wert von x
            feld:=feld2;             //altes feld
            feld[e,f]:=2;            //aktuelle Position als nicht möglich kennzeichnen
            goto lab1;               //an den anfang springen
          end
        else if (jo=false) and (p=n)  //wenn keine neue Dame von hier aus möglich und Versuchszähler voll
          then dame:=false;
    end;
end;

procedure TForm1.rechne;
var
feld: Tmeinfeld;
i,y,a,x,b : integer; jo: boolean;
begin
x:=0;                         //Damenzähler auf 0
  for i:=1 to n do begin        //leeres Brett erschaffen
  for y:=1 to n do begin
    feld[i,y]:=0;
  end;
  end;
x:=0;
dame(feld,x);
if x=n                       //wenn Damenanzahl erreicht
  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                 //wenn eine Dame auf der Position
      then
        for a:=1 to z-1 do begin         //dann makiere sie im Bild
        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 user profile iconraziel: Code- durch Delphi-Tags ersetzt


Christian V. - 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.


freak89 - 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 - So 13.05.07 21:12
Versuche doch mal, das Problem mit folgendem Schema zu lösen:

Delphi-Quelltext 
1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
 
Procedure Backtracking (Const Spielbrett : TSpielbrett);
Begin
  Für jeden möglichen Zug Do
    Führe den Zug auf dem Spielbrett aus
    If Lösung nicht vollständig then
       Backtracking (Spielbrett)
    Else if Lösung korrekt then
       Gib Lösung aus
    Mache den Zug rückgängig
End;

Du nimmst Dir Spalte für Spalte vor. 'Jeder mögliche Zug' ist (auf eine bestimmte Spalte bezogen) die Position der Dame in dieser Spalte.
Ein erster Ansatz wäre also:


Delphi-Quelltext 
1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
 
Procedure AchtDamen (aSpalte : Cardinal; Const SpielBrett : TSpielbrett);
Var
  iZeile : Cardinal;

Begin
  For iZeile := 1 to 8 do
     If Spielbrett.DameKannHierPositioniertwerden (iZeile, iSpalte) Then Begin
       Spielbrett.SetzeDameAnPosition (iZeile, iSpalte);
       If iSpalte < 8 Then
          AchtDamen (iSpalte + 1, Spielbrett)
       else
          Spielbrett.ZeigeStellung;
       Spielbrett.EntferneDameAnPosition (iZeile, iSpalte);
     End
End;


Moderiert von user profile iconUGrohne: Code- durch Delphi-Tags ersetzt


Christian V. - 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.


Horst_H - 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.
http://www.mactech.com/articles/mactech/Vol.13/13.12/TheEightQueensProblem/
Ich habe meine Uralt Version (in der Kante von 2001) nicht mehr gefunden, aber rekonstruiert.


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:
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
  //Probiere jede noch freie Spalte aus
  For i := Zeile to n do
    begin
    Spalte := FreieSpalte[i];
    //Diagonalen noch unbedroht?
    If LR_Diagonale[Zeile-Spalte] AND RL_Diagonale[Zeile+Spalte] then
      begin
      //Jetzt ist eine mögliche Position gefunden
      LR_Diagonale[Zeile-Spalte] := false;
      RL_Diagonale[Zeile+Spalte] := false;
      //Tausche FreieSpalte[Zeile,i]
      FreieSpalte[i] := FreieSpalte[Zeile];
      FreieSpalte[Zeile] := Spalte;
        //Weiter in der nächsten Zeile
        SetzeDame(Zeile+1);
      //BeiRückkehr alles rüchgängig
      FreieSpalte[Zeile] := FreieSpalte[i];
      FreieSpalte[i] := Spalte;
      LR_Diagonale[Zeile-Spalte] := true;
      RL_Diagonale[Zeile+Spalte] := true;
      end;
    end;
  end
else
  begin
  //Lösung gefunden!

  inc(gblCount);
  {
  If gblCount AND $FFF = 0 then
    writeln(gblCount);

  For i := 1 to n do
    write(FreieSpalte[i]:4);
  writeln;
  }
  end;
end;


begin
  //Freie Spalten belegen
  For i := 1 to nmax do
    FreieSpalte[i] := i;
  //Diagonalen mit true= unbesetzt vorbelegen
  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:
 
//tIstFreieSpalte = array [1..nmax] of boolean;//Oder set of 1..nmax oder wie auch immer
//Probiere jede Spalte, ob Sie frei ist
  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 :
http://www.ic-net.or.jp/home/takaken/e/queen/

Gruß Horst


freak89 - Do 17.05.07 17:39
Vielen Dank für eure Hilfe, meine Lösung sieht nun wie folgt aus:

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:
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
    { Private-Deklarationen }
    function dame(zeile:integer) : boolean;
    procedure ausgabe;
  public
    { Public-Deklarationen }
  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                 //wenn eine Dame auf der Position
      then
        for a:=1 to q-1 do begin         //dann makiere sie im Bild
        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;                      //MAximalgröße des Brettes
  n:=strtoint(edit1.text);
  image1.Width:= p*n       ;  //Passt Bildgröße an
  image1.height:= p*n       ;
    with image1.canvas do begin
    for q:=0 to n do begin      //Zeichnet leeres Brett
      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;                         //Damenzähler auf 0
  for i:=1 to n do begin        //leeres Brett erschaffen
  for y:=1 to n do begin
    feld[i,y]:=0;
  end;
  end;
if dame(1) = true                      //wenn Damenanzahl erreicht
  then
    ausgabe
  else
    showmessage('Es gibt keine Loesungen für n Damen auf diesem n mal n großen Feld');
end;

end.


Jann1k - 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


Entwickler-Ecke.de based on phpBB
Copyright 2002 - 2011 by Tino Teuber, Copyright 2011 - 2025 by Christian Stelzmann Alle Rechte vorbehalten.
Alle Beiträge stammen von dritten Personen und dürfen geltendes Recht nicht verletzen.
Entwickler-Ecke und die zugehörigen Webseiten distanzieren sich ausdrücklich von Fremdinhalten jeglicher Art!