Schachproblem

[nailor]

So hier mal mein BEitrag zu dem Schach/Programmier-Problem von wegen acht Damen so auf ein Schachbrett packen, das keine einen andere schlagen kann. Ich hab von dem Problem gehört, und von der Möglichkeit es zu proggen, indem man immer die nächstmöglich Lösung nimmt, und sobald es nicht mehr geht, seine Züge soweit zurücknimmt, bis wieder eine Möglichkeit besteht. Hab noch keinen Code gesehen, alles selber gedacht/gemacht.

Und das heißt hier ja:

Zitat:

Freeware-Programme (mit oder ohne Sourcecode) zum Testen und Diskutieren

und mich würde mal interessieren, wo ihr verbesserungwürdige Punkte seht. Allerdings nur was den Algo und die Darstellung angeht. So Sachen, dass man im Moment einen InputQuery hat und auf das Bild klicken muss, ist deshalb, dass man sich den Code schneller Cut&Pasten kann, weil man nur ein 160*160 (oder größer) Image braucht.

So, dann viel Spass bei diskutieren: :wink:

Delphi-Quellcode:

unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    Image1: TImage;
    procedure Image1Click(Sender: TObject);
  end;

var
  Form1: TForm1;


implementation

{$R *.dfm}

procedure TForm1.Image1Click(Sender: TObject);
var
  Schachbrett: array[0..7] of array[0..7] of boolean;
  ReiheAktuell: byte;
  SpalteMindest: byte;
  SpalteAktuell: byte;
  i,j: byte;
  b: boolean;
  t: TBitMap;
  times_s: string;
  times_i: byte;
begin
times_s := '1';
if not InputQuery('Lösungs-ID', 'Zeige Lösung Nummer:', times_s) then
  exit;
if (strtoint(times_s)) in [1..92] then
  times_i := strtoint(times_s)
else
  begin
    ShowMessage('Zu hoch ->  1 --- 92');
    exit;
  end;

for i := 0 to 7 do
  for j := 0 to 7 do
    Schachbrett[i,j] := false;
ReiheAktuell := 0;
SpalteMindest := 0;

{###}repeat      {die einzelnen Lösungen}
    dec(times_i);
repeat           {eine einzelne Lösung}
  for SpalteAktuell := SpalteMindest to 7 do
    begin               {Feld-Test}
      b := false;
      for i := 0 to 7 do
        begin
          b := (b or Schachbrett[ReiheAktuell, i] or Schachbrett[i, SpalteAktuell]); {senkrecht, waagrecht}
            if ((SpalteAktuell + abs(ReiheAktuell - i)) in [0..7]) then
          b := (b or Schachbrett[i, SpalteAktuell + abs(ReiheAktuell - i)]);         {diagonal oben}
            if ((SpalteAktuell - abs(ReiheAktuell - i)) in [0..7]) then
          b := (b or Schachbrett[i, SpalteAktuell - abs(ReiheAktuell - i)]);         {diagonal unten}
        end;            {Feld-Test}
      if not b then
        begin           {Feld frei}
          Schachbrett[ReiheAktuell, SpalteAktuell] := true;
          SpalteMindest := 0;
          inc(ReiheAktuell);
          Break;
        end
      else              {Feld nicht frei}
      if SpalteAktuell = 7 then
        begin {zurücknehmen}
          repeat
            dec(ReiheAktuell);
            for j := 0 to 7 do
              if Schachbrett[ReiheAktuell, j] then
                begin
                  Schachbrett[ReiheAktuell, j] := false;
                  SpalteMindest := j + 1;
                  Break;
                end;
          until
            SpalteMindest < 8;
        end;  {zurücknehmen}
    end;
until
  ReiheAktuell = 8;
{###}until
    times_i = 0;

t := TBitMap.Create;
t.Width := 160;
t.Height := 160;
t.Canvas.Brush.Color := clBlack;
t.Canvas.Pen.Color := clGray;

for i := 0 to 7 do
  for j := 0 to 7 do
    if Schachbrett[i, j] then
      begin
        t.Canvas.Brush.Color := clRed;
        t.Canvas.Rectangle(20*i, 20*j, 20*i+20, 20*j+20);
        t.Canvas.Brush.Color := clBlack;
      end
    else
      t.Canvas.Rectangle(20*i, 20*j, 20*i+20, 20*j+20);

Image1.Picture.Bitmap := t;
t.Free;
end;

end.

[Daniel B]

Hallo Nailor,

Zitat:

Zitat von Nailor

Und das heißt hier ja:

Zitat:

Freeware-Programme (mit oder ohne Sourcecode) zum Testen und Diskutieren

Es wäre aber auch ganz hilfreich wenn Du die .exe dazu anhängen würdest.
Es steht ja nicht nur die Unit als Beitrag posten.
Danke.

Grüsse, Daniel :hi:

[d3g]

Um die Diskussion zu beginnen...
Was ich ändern würde:

• Freiheit für Kylix-Benutzer :mrgreen:!
  
  Delphi-Quellcode:

  {$IFDEF LINUX}
  uses
    SysUtils, Types, Classes, Variants, QTypes, QGraphics, QControls, QForms,
    QDialogs, QStdCtrls, QExtCtrls;
  {$ELSEIF WIN32}
  uses
    Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
    Dialogs, StdCtrls, ExtCtrls;
  {$IFEND}
  
  // ...
  
  {$IFDEF LINUX}
  {$R *.xfm}
  {$ELSEIF WIN32}
  {$R *.dfm}
  {$IFEND}

• Die if-Anweisungen bei der Feld-Überprüfung kannst du dir sparen:
  
  Delphi-Quellcode:

  b := false;
  for i := 0 to 7 do {Feld-Test}
    b := (b or Schachbrett[ReiheAktuell, i] or Schachbrett[i, SpalteAktuell]) or {senkrecht, waagrecht}
         (((SpalteAktuell + abs(ReiheAktuell - i)) in [0..7]) and
         (b or Schachbrett[i, SpalteAktuell + abs(ReiheAktuell - i)])) or        {diagonal oben}
         (((SpalteAktuell - abs(ReiheAktuell - i)) in [0..7]) and
         (b or Schachbrett[i, SpalteAktuell - abs(ReiheAktuell - i)]));          {diagonal unten}

• Für mein Gefüh schöner gewesen wäre eine rekursive Lösung, aber dann dürftest du deinen Code sowieso komplett umpkrempeln und diese iterative Lösung ist wahrscheinilich auch schneller, weil nicht ständig Variablen auf den Stack gedrückt oder wieder heruntergeholt werden müssen.

Soviel für meinen Teil...

d3g

[nailor]

zu den ifs: dann kann man ja eine ganze Variable sparen (b) :wink:

Kann ich ändern. Und was ist mit rekursiv? Was will man denn dabei rekursiv machen?

Kylix: So einer bist du also :twisted:

[d3g]

Zitat:

Zitat von Nailor

Und was ist mit rekursiv? Was will man denn dabei rekursiv machen?

Einmal schnell in meine Tastatur gehackt (sollte aber funktionieren...)

Delphi-Quellcode:

type
  TBoard = array[0..7, 0..7] of Boolean;

procedure EightQueens(Level: Integer; Board: TBoard);
var
  i: Integer;
begin
  for i := 0 to 7 do begin
    Board[Level, i] := True;
    if (TestCorrectSituation(Board)) then
      // Damen stehen korrekt
      if (Level > 0) then
        EightQueens(Level - 1, Board)
      else
        PaintSituation(Board); // Zeichnen
    Board[Level, i] := False;
  end;    
end;

Zitat:

Zitat von Nailor

Kylix: So einer bist du also :twisted:

Steht doch neben jedem meiner Beiträge :mrgreen:.

MfG,
d3g

[nailor]

(TestCorrectSituation(Board)) ist klar

PaintSituation(Board) auch

aber was für ne Rolle spielt "Level" ???

[d3g]

Die Prozedur probiert praktisch alle möglichen Stellungen für die acht Damen aus. Ruft man die Funktion mit EightQueens(7, Board) auf, so wird eine Dame in die 8. Reihe auf das erste Feld gestellt. Dann springt die Prozedur in einen niedrigeren Level und stellt in der 7. Reihe (Level 6) eine Dame auf das erste Feld dadurch entsteht eine inkorrekte Situation, daher wird die Dame auf das 2. Feld der 7. Reihe gestellt. Das ist auch illegal, auf dem 3. Feld klappts dann und die Prozedur springt in das nächsttiefere Level. Das geht so weiter bis entweder das letzte Level erreicht wurde und alles korrekt ist (dann wird gezeichnet) oder alle Felder einer Reihe nicht besetzbar sind, dann springt die Prozedur wieder ein Level hinauf und stellt eine Reihe weiter rechts wieder die Dame ein Feld weiter nach unten, usw.

MfG,
d3g

[nailor]

Und wo liegt jetzt der Unterschied zu meinem Programm? Bei mir wird das gleiche gemacht, nur durch "Neustart" der repeat-Schleife...

[d3g]

Der Unterschied ist nicht groß, nur wäre eine rekursive Lösung für mein Gefühl einfach eleganter. Deine Lösung ist so ganz gut wie sie ist, wahrscheinlich schneller als jede rekursive Lösung, weil man sich die ganzen "push"s und "pop"s von den Stackoperationen spart und die brauchen je 11 bzw. 8 Takte.

[janjan]

Schreibt doch mal eben ein Programm das beide Verfahren benutzt, da sollte man ja sehen was besser funktioniert...