Version:0.9 StartHTML:0000000105 EndHTML:0000034631 StartFragment:0000001053 EndFragment:0000034615
//shows the recursive solution to the 8 queens chess problem, max@kleiner.com
//small output of solutions codestring in text mode or file list!, #locs=118
//Performance tester for N solutions {N8 = 92 solutions] - see below
Program Performer_QueensSolutions2;
Const NB = 8;
N_LEFT = 2 * NB;
N_RIGHT_R = NB - 1;
N_RIGHT_L = 1 - NB;
FILESAVE = 'ChessSolution_Res8codes.txt';
Type
TPlay = array[1..NB] of boolean;
TPlay2 = array[1..NB] of TPlay;
RowCheck = array[1..NB] of boolean;
LDiagCheck = array[2..N_LEFT] of boolean;
RDiagCheck = array[N_RIGHT_L..N_RIGHT_R] of boolean;
var
safeRow: RowCheck;
safeLD: LDiagCheck; safeRD: RDiagCheck;
RList: TStringList;
Time1: TDateTime;
Count: integer;
function Safe(row,col: shortint; asaferow: rowCheck; sLDia: LDiagCheck;
sRDia: RDiagCheck): boolean;
//true if queen can be safely placed in current position
begin
result:= asafeRow[row] And sLDia[row+col] And sRDia[row-col]
end;
procedure chessPrint(board: TPlay2);
var i,j: integer;
stmp,scod: string;
begin
stmp:=''; scod:='';
RList.add(inttostr(count+1))
//i is column, j is row !
for j:= 1 to NB do begin
for i:= 1 to NB do
if (board[i][j]) then begin
stmp:= stmp+ 'Q'
scod:= scod+ inttostr(i)+'/'
end else stmp:= stmp+'-';
RList.add(stmp)
stmp:= '';
{ write('Q') else write('*');
writeln('');}
end;//for
RList.add(scod);
RList.add('-----------------');
inc(Count)
end;
procedure TryColumn(col: integer; aboard: TPlay2);
//recursive procedure for attempting queen placement
var row: integer;
begin
row:= 1
repeat
if Safe(row,col,saferow, safeLD,safeRD) then begin
//set a queen
safeRow[row]:= false;
safeLD[row+col]:= false;
safeRD[row-col]:= false;
aboard[row][col]:= true;
if col < NB then
Trycolumn(col+1, aboard) else
chessPrint(aboard);
//remove queens
safeRow[row]:= true;
safeLD[row+col]:= true;
safeRD[row-col]:= true;
aBoard[row][col]:= false;
end; //row was safe
inc(row);
until row > NB
end;
function initAndStartBoard: boolean;
var row,col, i: integer;
board : TPlay2;
begin
RList:= TStringlist.Create;
Count:= 0;
result:= false;
try
for row:= 1 to NB do safeRow[row]:= true;
for i:= 2 to N_LEFT do safeLD[i]:= true;
for i:= N_RIGHT_L to N_RIGHT_R do safeRD[i]:= true;
for row:= 1 to NB do
for col:= 1 to NB do
board[row][col]:= false;
//first recursive call
tryColumn(1, board);
PrintF('Solutions: %d -ASCIITest: %s',[Count,Chr(64)]);
finally
RList.saveToFile(FILESAVE)
RList.Free;
result:= true;
end;
end;
begin //init & main
//processMessagesOFF; //performance gain
Time1:= Time;
writeln(formatdatetime('"start:" hh:mm:ss:zzz',Time))
if initAndStartBoard then
writeln('Filesize: '+inttoStr(filesize(FILESAVE)));
writeln(formatDateTime('"stop:" hh:mm:ss:zzz',Time))
PrintF('%d %s',[Trunc((Time-Time1)*24),
FormatDateTime('"h runtime:" nn:ss:zzz',Time-Time1)])
OpenDoc(Exepath+FILESAVE);
End.
Doc: Change N as Const in line 7 for another NB
start is: 21:30:32:233
all codestrings of solutions
stop is: 23:19:44:183
1 h run time: 49:11:950
mX3 executed: 23.05.2014 23:19:44 Runtime: 1:49:13.10 Memoryload: 52% use
Ref:
08 Queens: 92 solutions: 0 h run time: 00:00:376
09 Queens: 352 solutions: 0 h run time: 00:01:493
10 Queens: 724 solutions: 0 h run time: 00:06:460
11 Queens: 2680 solutions: 0 h run time: 00:32:107
12 Queens: 14200 solutions: 0 h run time: 02:58:011
13 Queens: 73712 solutions: 0 h run time: 17:24:995
old code:
writeln(IntToStr(Trunc(Dif * 24)) +
FormatDateTime('" h run time:" nn:ss:zzz',Dif));