Vezérek elhelyezése a sakktáblán véletlen mutációval

Írjunk programot, mely véletlen mutáció segítségével ütésmentesen elhelyez 8 vezért a sakktáblán. Nem kell az összes megoldást megkeresnie, ha talál jó megoldást, a program álljon le. Az algoritmus megírásakor a következőket tartsuk be:

- az állapot leírására az 1-8 számok egy permutációját használjuk;

- a vezérek elhelyezkedését a következőképpen értelmezzük: a permutáció első helyén álló szám azt mutatja, hogy az ’a’ oszlopban melyik sorban van a vezér, a második helyen álló a ’b’, harmadik helyen a ’c’, … végül nyolcadik helyen lévő szám a ’h’ oszlopban lévő vezér sorának számát jelentse;

- a kezdőállapot az ’12345678’ permutáció legyen. Ez azt jelenti, hogy a vezérek az ’a1’-’h8’ átlón helyezkednek el. Minden sorban és oszlopban pontosan egy vezér. Így csak azért nem jó az elrendezés, mert a vezér átlós irányban is üt (nem úgy, mint a bástya), tehát ekkor minden vezér a többivel ütésben van;

- az elrendezéshez rendeljünk hibaszámot, mely legyen az összes bábu összesített ütési száma;

- ha az ütési számok összege (hibaszám) nulla, akkor a vezérek nem ütik egymást, a feladatot a program megoldotta;

- a kezdeti állapotból kiindulva cseréjük fel véletlen választással a permutáció két elemét (ez a csere nem hoz létre soron vagy oszlopon belüli ütközést, tehát továbbra is csak átlós ütközéseket kell számolni);

- nézzük meg, hogy a cserével létrejött permutációhoz tartozó felállás kisebb hibaszámú-e mint a csere előtti;

- ha igen, akkor a cserét tartsuk meg, ha nem, akkor figyelmen kívül hagyjuk;

- folytassuk addig a véletlen cserélgetés, ameddig jó megoldást nem kapunk.

A program jelenítse meg a feladat megoldását jelentő felállást, illetve minden a megoldást jelentő előtti állapotot is. Lehessen újra indítani a keresést.

A program futási képei. Az alapállapot:

Egy megtalált helyes felállás:

A program listája:

unit URndVezer;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes,

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

Const Max=8;

type
  TfmRndVezer = class(TForm)
    lbRndVezer: TLabel;
    btKilepes: TButton;
    sgRndVezer: TStringGrid;
    sgTabla: TStringGrid;
    btStart: TButton;
    btAlap: TButton;
    edN: TEdit;
Procedure Kepernyore;
Procedure Tablara;
Function HibaT: Byte;
Function HibaP: Byte;
Procedure Mutacio;
procedure btKilepesClick(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure sgTablaDrawCell(Sender: TObject; Col, Row: Integer;
      Rect: TRect; State: TGridDrawState);
procedure btStartClick(Sender: TObject);
procedure btAlapClick(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;

var
  fmRndVezer: TfmRndVezer;
  ACol, ARow: Integer;
  N: Word;
  T, P: Array[1..Max] Of Byte;

implementation

{$R *.dfm}

procedure TfmRndVezer.btKilepesClick(Sender: TObject);
begin
  Close;
end;

procedure TfmRndVezer.FormCreate(Sender: TObject);
Var I: Word;
    Ch: Char;
begin
With sgRndVezer Do
Begin
For I:= 1 To Max Do Cells[I,0]:= Chr(96+I);
End;

With sgTabla Do
Begin
    ColWidths[9]:= 0;
RowHeights[9]:= 0;
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:= 9; Row:= 9;
End;

  Randomize;
  N:= 1; For I:= 1 To Max Do T[I]:= I;
  Kepernyore;
  Tablara;
end;

procedure TfmRndVezer.sgTablaDrawCell(Sender: TObject; Col, Row: Integer;
  Rect: TRect; State: TGridDrawState);
begin
//a sakktáblát és felállást megjelenítő StringGrid beállításai
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
Begin
Case Odd(Col) XOr Odd(Row) Of
        False: Color:= clWindow;
        True: Color:= clSilver;
End;
End;
    sgTabla.Canvas.Font.Size:= 17;
End;
  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 TfmRndVezer.btAlapClick(Sender: TObject);
Var I,J: Word;
begin
  N:= 1; For I:= 1 To Max Do T[I]:= I;
With sgRndVezer Do
Begin
For I:= 1 To ColCount-1 Do For J:= 1 To RowCount-1 Do Cells[I,J]:= '';
    RowCount:= 5;
End;
  Kepernyore;
  Tablara;
end;

Procedure TfmRndVezer.Kepernyore;
Var I: Word;
Begin
With sgRndVezer Do
Begin
If RowCount-1<N Then RowCount:= N+1;
    Cells[0,N]:= IntToStr(N)+'.';
For I:= 1 To Max Do Cells[I,N]:= IntToStr(T[I]);
End;
  EdN.Text:= IntToStr(N); edN.Repaint;
End;

Procedure TfmRndVezer.Tablara;
Var I, J: Word;
Begin
With sgTabla Do
Begin
For I:= 1 To ColCount-1 Do For J:= 1 To RowCount-1 Do Cells[I,J]:= '';
For I:= 1 To Max Do
Begin
      Cells[I,Max-T[I]+1]:= 'V';
End;
End;
  sgTabla.Repaint;
End;

Function TfmRndVezer.HibaT: Byte;
Var I, J, H: Byte;
Begin
  HibaT:= 0; H:= 0;
For I:= 1 To Max-1 Do For J:= I+1 To Max Do
If Abs(T[I]-T[J])=J-I Then Inc(H);
  HibaT:= H;
End;

Function TfmRndVezer.HibaP: Byte;
Var I, J, H: Byte;
Begin
  HibaP:= 0; H:= 0;
For I:= 1 To Max-1 Do For J:= I+1 To Max Do
If Abs(P[I]-P[J])=J-I Then Inc(H);
  HibaP:= H;
End;

Procedure TfmRndVezer.Mutacio;
Var I, J, Puf: Byte;
Begin
  Inc(N);
  P:= T;
  I:= Random(Max)+1;
  J:= Random(Max)+1;
  Puf:= P[I]; P[I]:= P[J]; P[J]:= Puf;
Case N Mod 10 Of
    0..8: If HibaP<HibaT Then T:= P;
       9: If HibaP>0 Then T:= P;
End;
End;

procedure TfmRndVezer.btStartClick(Sender: TObject);
begin
While HibaT>0 Do
Begin
    Mutacio;
    Kepernyore;
    Tablara;
End;
end;

end.