Nyolc vezér a sakktáblán (minden lehetséges eset)

Feladat: írjunk programot, mely nyolc vezérnek egy sakktáblán való ütésmentes elhelyezését oldja meg. A programnak az összes lehetséges felállítást meg kell keresnie. (Ha valaki nem tudná: a vezér minden irányba, akárhányat léphet, az irány lehet oldallal párhuzamos és átlós is.)

A megoldásnál egy olyan alapfelállásból indulunk, amikor soronként és oszloponként nincs ütközés. Ha nyolc különböző számot (1..8) permutálunk, és azt mondjuk, hogy az egyes oszlopokon a vezér abban a sorban legyen, amit a permutáció megfelelő helyén álló szám mutat, akkor egy ilyen felállításban biztosan nincs két vagy több vezér egy sorban vagy oszlopban. Mivel az ilyen alapesetek száma 8! = 40320, először egy elegáns rekurzióval ezeket állítjuk elő, tároljuk egy táblázatban, majd ezek közül kiválogatjuk azokat, amelyek ütközésmentesek. 92 ilyen, átlós ütközésmentes permutációt találunk. Ezeket a képernyőn megjelenő sakktáblán el is lehet helyezni, ellenőrizhetjük, hogy valóban ütközésmentes a felállás. Ezen 92 között találhatók olyanok, melyek egymásnak elemi geometriai transzformációi (eltolás, tükrözés). Utolsó lépésben ezeket is kiszórjuk, vagyis meghatározzuk azt a 12-t, amelyből az összes többi geometriai transzformációval származtatható. A szűrést a következőkre hajtottam végre: 8 vízszintes eltolás, 8 függőleges eltolás, 4 szimmetriatengelyre való tükrözés, középpontos tükrözés, 90 fokos elforgatás jobbra és végül 90 fokos elforgatás balra. Az alapesetek táblán való kattintás is megmutatja a vezérek elhelyezkedését a sakktáblán.

A program futási képe:

A program listája:

unit UVezer;

interface

uses
  Windows, Messages, SysUtils, Classes,

Graphics, Controls, Forms, Dialogs, Grids, StdCtrls;

type
  St8= String[8];
  TfmVezer = class(TForm)
    sgMind: TStringGrid;
    lbOsszes: TLabel;
    sgJo: TStringGrid;
    lbJo: TLabel;
    sgTabla: TStringGrid;
    lbTabla: TLabel;
    sgAlap: TStringGrid;
    lbAlap: TLabel;
Function Ugyanaz(A,B: St8): Boolean;
procedure FormCreate(Sender: TObject);
procedure sgTablaDrawCell(Sender: TObject; Col, Row: Integer;
      Rect: TRect; State: TGridDrawState);
procedure sgJoClick(Sender: TObject);
procedure sgAlapClick(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;

Const M=1*2*3*4*5*6*7*8;

var
  fmVezer: TfmVezer;
  S: St8;
  PT: Array[1..M] Of St8;
  Ind: Word;


implementation

{$R *.DFM}

Procedure Permut(I: Word);
Var J: Word;
    Ch: Char;
Begin
If I=1 Then Begin Inc(Ind); PT[Ind]:= S End Else
Begin
    Permut(I-1);
For J:= 1 To I-1 Do
Begin
      Ch:= S[J]; S[J]:= S[I]; S[I]:= Ch; Permut(I-1);
      Ch:= S[J]; S[J]:= S[I]; S[I]:= Ch;
End;
End;
End;

Function TfmVezer.Ugyanaz(A,B: St8): Boolean;
Var I: Word;
    Ws: St8;

Function EltolasVB(C: St8): St8; //vizszintesen balra
Begin
    C:= Copy(C+C[1],2,8);
    EltolasVB:= C;
End;

Function EltolasFF(C: St8): St8; //függőlegesen felfelé
Var J, X: Word;
Begin
For J:= 1 To 8 Do
Begin
      X:= Ord(C[J]); Inc(X); If X=57 Then X:= 49; C[J]:= Chr(X);
      EltolasFF:= C;
End;
End;

Function TukrozesVT(C: St8): St8;  //vízsintes tengelyre
Var J: Word;
Begin
For J:= 1 To 8 Do C[J]:= Chr(105-Ord(C[J]));
    TukrozesVT:= C;
End;

Function TukrozesFT(C: St8): St8;  //függőleges tengelyre
Var J: Word;
      X: St8;
Begin
X:= '12345678';
For J:= 1 To 8 Do X[J]:= C[9-J];
    TukrozesFT:= X;
End;

Function TukrozesLA(C: St8): St8;  //lefutó átlóra
Var I: Word;
      X: St8;
      S: String;
Begin
    X:= '12345678';
For I:= 1 To 8 Do
Begin Str(9-I,S); X[9-StrToInt(C[I])]:= S[1] End;
    TukrozesLA:= X;
End;

Function TukrozesFA(C: St8): St8;  //felfutó átlóra
Var I: Word;
      X: St8;
      S: String;
Begin
    X:= '12345678';
For I:= 1 To 8 Do
Begin Str(I,S); X[StrToInt(C[I])]:= S[1] End;
    TukrozesFA:= X;
End;

Function ForgatasJ(C: St8): St8; //forgatás jobbra
Var I: Word;
      X: St8;
      S: String;
Begin
    X:= '12345678';
For I:= 1 To 8 Do
Begin Str(9-I,S); X[StrToInt(C[I])]:= S[1] End;
    ForgatasJ:= X;
End;

Function ForgatasB(C: St8): St8; //forgatás balra
Var I: Word;
      X: St8;
      S: String;
Begin
    X:= '12345678';
For I:= 1 To 8 Do
Begin Str(I,S); X[9-StrToInt(C[I])]:= S[1] End;
    ForgatasB:= X;
End;

Function KozeppontosT(C: St8): St8; //középpontos tükrözés
Begin
    KozeppontosT:= TukrozesVT(TukrozesFT(C));
End;

Begin
  Ugyanaz:= False;
//eltolás víszsintesen balra
Ws:= B; For I:= 1 To 7 Do
Begin Ws:= EltolasVB(Ws); If A=Ws Then Ugyanaz:= True End;
//eltolás függőlegesen felfelé
  Ws:= B; For I:= 1 To 7 Do
Begin Ws:= EltolasFF(Ws); If A=Ws Then Ugyanaz:= True End;
//vízszintes tengelyre való tükrözés
If A=TukrozesVT(B) Then Ugyanaz:= True;
//függőleges tengelyre való tükrözés
If A=TukrozesFT(B) Then Ugyanaz:= True;
//lefutó átlóra való tükrözés
If A=TukrozesLA(B) Then Ugyanaz:= True;
//felfutó átlóra való tükrözés
If A=TukrozesFA(B) Then Ugyanaz:= True;
//forgatas jobbra
If A=ForgatasJ(B) Then Ugyanaz:= True;
//forgatás balra
If A=ForgatasB(B) Then Ugyanaz:= True;
//középpontos tükrözes
If A=KozeppontosT(B) Then Ugyanaz:= True;
End;

procedure TfmVezer.FormCreate(Sender: TObject);
Var I, J, K, N: Word;
    Jo: Boolean;
    Ch: Char;
    SI,SJ: St8;
begin
With sgAlap Do
Begin
For I:= 1 To 8 Do Cells[I,0]:= IntToStr(I)+'.';
End;
With sgJo Do
Begin
    ColWidths[0]:= 42;
For I:= 1 To 8 Do Cells[I,0]:= IntToStr(I)+'.';
End;
With sgTabla Do
Begin
For I:= 1 To 8 Do Cells[0,I]:= IntToStr(9-I);
For Ch:= 'a' To 'h' Do Cells[Ord(Ch)-96,0]:= Ch;
    Col:= 1; Row:= 8;
End;
With sgMind Do
Begin
    ColWidths[0]:= 42;
    RowCount:= M+1;
For I:= 1 To M Do Cells[0,I]:= IntToStr(I)+'.';
For I:= 1 To 8 Do Cells[I,0]:= IntToStr(I)+'.';
    Ind:= 0; S:= '12345678'; Permut(8);
For J:= 1 To M Do For I:= 1 To 8 Do Cells[I,J]:= PT[J,I];
    N:= 1;
For J:= 1 To M Do
Begin
      Jo:= True; For I:= 1 To 7 Do For K:= I+1 To 8 Do
If Abs(StrToInt(Cells[I,J])-StrToInt(Cells[K,J]))= K-I Then
      Jo:= False;
If Jo Then
Begin
For I:= 1 To 8 Do sgJo.Cells[I,N]:= Cells[I,J];
        sgJo.Cells[0,N]:= IntToStr(N)+'.'; Inc(N);
If sgJo.RowCount<N Then sgJo.RowCount:= sgJo.RowCount+1;
End;
End;
End;
With sgJo Do
Begin
    N:= RowCount-1;
For I:= 1 To N-1 Do If Cells[0,I]<>'' Then
For J:= I+1 To N Do If Cells[0,J]<>'' Then
Begin
      SI:= ''; SJ:= '';
For K:= 1 To 8 Do SI:= SI+Cells[K,I];
For K:= 1 To 8 Do SJ:= SJ+Cells[K,J];
If Ugyanaz(SI,SJ) Then Cells[0,J]:= '';
End;
    K:= 0;
For I:= 1 To RowCount-1 Do If Cells[0,I]<>'' Then
Begin
      Inc(K);
      sgAlap.Cells[0,K]:= IntToStr(K)+'.';
For J:= 1 To 8 Do sgAlap.Cells[J,K]:= Cells[J,I];
End;
End;
end;

procedure TfmVezer.sgTablaDrawCell(Sender: TObject; Col, Row: Integer;
  Rect: TRect; State: TGridDrawState);
begin
With sgTabla.Canvas.Brush Do
Begin
{rögzített cellák}
If gdFixed In State Then Color:=clWhite;

{kiválasztott cella}
If gdSelected In State Then Color:= clSilver;

{a táblázat belseje}
If Not((gdSelected In State) Or (gdFixed In State)) Then
Case Odd(Col) XOr Odd(Row) Of
      False: Color:= clWindow;
      True: Color:= clSilver;
End;
    sgTabla.Canvas.Font.Size:= 17;
End;
{szöveg beállítása rácson belül: +6 +4}
{kövér betüket akkor tud, ha DefaultDrawing=True}
  sgTabla.Canvas.TextRect(Rect,Rect.Left+16,Rect.Top+4,sgTabla.Cells[Col,Row]);
If gdFocused In State Then sgTabla.Canvas.DrawFocusRect(Rect);
end;

procedure TfmVezer.sgJoClick(Sender: TObject);
Var I, J: Word;
begin
With sgJo Do
Begin
For I:= 1 To 8 Do For J:= 1 To 8 Do sgTabla.Cells[I,J]:= '';
For I:= 1 To 8 Do sgTabla.Cells[I,9-StrToInt(Cells[I,Row])]:= 'V';
End;
end;

procedure TfmVezer.sgAlapClick(Sender: TObject);
Var I, J: Word;
begin
With sgAlap Do
Begin
For I:= 1 To 8 Do For J:= 1 To 8 Do sgTabla.Cells[I,J]:= '';
For I:= 1 To 8 Do sgTabla.Cells[I,9-StrToInt(Cells[I,Row])]:= 'V';
End;
end;

end.