Eight Queen Problem/밥벌레

No older revisions available

일단 찍어 놓을테니까 좀 세줘- 라는 개념의 소스...다소 엽기 소스라 볼 수있을지도...-_-;;;
버튼1을 누르면 찾는 과정이 애니메이션(?) 됩니다..
여기 있는 소스들중 가장 인간적인(?) 소스라 자부함.. (다들 어쩌면 그렇게 아이디어들이 번뜩이시는지)

~cpp 
unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    Button1: TButton;
    procedure FormPaint(Sender: TObject);
    procedure Button1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.DFM}

var
  Table: array[0..8-1, 0..8-1] of Boolean;

procedure ClearTable;
var
  i, j: Integer;
begin
  for i := 0 to 8 -1 do
    for j := 0 to 8 -1 do
      Table[i, j] := False;
end;

function CountRow(row: Integer): Integer;
var
  i: Integer;
begin
  Result := 0;
  for i := 0 to 8-1 do
    if Table[i, row] then
      Inc(Result);
end;

procedure SetQueens(n: Integer);   // 퀸 배치하기. 이 소스의 핵심함수. n은 현재 사용안한다. 처음엔 RandomSeed로 쓰려했음..-_-;
var
  i, row: Integer;
begin
  ClearTable;
  for i := 0 to 8-1 do    //  가로 세로만 조건에 일치하도록 랜덤하게 배치함.
    while True do
    begin
      row := random(8);
      Table[i, row] := True;
      if CountRow(row) > 1 then
        Table[i, row] := False
      else
        Break;
    end;
end;

function CheckQueens: Boolean; // 제대로 배치되었는지 검사하는 함수.
  function CountColumn(column: Integer): Integer;
  var
    i: Integer;
  begin
    Result := 0;
    for i := 0 to 8-1 do
      if Table[column, i] then
        Inc(Result);
  end;

  function CountSlash(column: Integer): Integer;
  var
    i: Integer;
    x, y: Integer;
  begin
    Result := 0;
    for i := 0 to 8*2-1 do
    begin
      x := column - i;
      y := i;
      if (x > 7) or (y > 7) or (x < 0) or (y < 0) then
        Continue;
      if Table[x, y] then
        Inc(Result);
    end;
  end;

  function CountBackSlash(column: Integer): Integer;
  var
    i: Integer;
    x, y: Integer;
  begin
    Result := 0;
    for i := 0 to 8*2-1 do
    begin
      x := column + i;
      y := i;
      if (x > 7) or (y > 7) or (x < 0) or (y < 0) then
        Continue;
      if Table[x, y] then
        Inc(Result);
    end;
  end;

var
  i: Integer;
begin
  Result := False;
  for i := 0 to 8-1 do
  begin
    if CountRow(i) > 1 then
      Exit;
    if CountColumn(i) > 1 then
      Exit;
  end;

  for i := 0 to 16-1 do
    if CountSlash(i) > 1 then
      Exit;
  for i := -8 to 8-1 do
    if CountBackSlash(i) > 1 then
      Exit;
  Result := True;
end;

procedure DrawQueens;
var
  i, j: Integer;
  x, y: Integer;
  r: TRect;
begin
  for i := 0 to 8 -1 do
    for j := 0 to 8 -1 do
    begin
      x := i * 32;
      y := j * 32;
      r := Bounds(x, y, 32, 32);
      if Table[i, j] then
        Form1.Canvas.Brush.Color := clRed
      else
        Form1.Canvas.Brush.Color := clWhite;
      Form1.Canvas.Rectangle(r);
    end;
end;

procedure TForm1.FormPaint(Sender: TObject);
begin
  DrawQueens;
end;

procedure TForm1.Button1Click(Sender: TObject);
var
  n: Integer;
begin
  Randomize;
  n := 0;
  repeat
    SetQueens(n);
    Inc(n);
    DrawQueens;
  until CheckQueens;
end;

end.

~cpp  
procedure FindAllQueens;
var
  n: Integer;
  i0, i1, i2, i3, i4, i5, i6, i7: Integer;
begin
  n := 0;
  for i0 := 0 to 8-1 do
  for i1 := 0 to 8-1 do
  for i2 := 0 to 8-1 do
  for i3 := 0 to 8-1 do
  for i4 := 0 to 8-1 do
  for i5 := 0 to 8-1 do
  for i6 := 0 to 8-1 do
  for i7 := 0 to 8-1 do
  begin
    ClearTable;
    Table[0, i0] := True;
    Table[1, i1] := True;
    Table[2, i2] := True;
    Table[3, i3] := True;
    Table[4, i4] := True;
    Table[5, i5] := True;
    Table[6, i6] := True;
    Table[7, i7] := True;
    if CheckQueens then
    begin
      DrawQueens;
      Inc(n);
      form1.Caption := inttostr(n);
    end;
  end;
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
  FindAllQueens;
end;