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.