N-queens minimum and knights and bishops: Difference between revisions

Content added Content deleted
m (→‎{{header|J}}: remove an overly aggressive optimization..)
Line 458: Line 458:
=={{header|Pascal}}==
=={{header|Pascal}}==
==={{header|Free Pascal}}===
==={{header|Free Pascal}}===
At bishops I used a trick that at max only one row is left free.
<lang pascal>
program TestMinimalQueen;
<lang pascal>program TestMinimalQueen;
{$MODE DELPHI}{$OPTIMIZATION ON,ALL}


uses
sysutils;
const
const
KoorCOUNT = 16;
KoorCOUNT = 16;
Line 474: Line 477:
{$ALIGN 32}
{$ALIGN 32}
CPG :tCheckPG;
CPG :tCheckPG;
sol :tPlayGround;
Qsol,BSol,KSol :tPlayGround;
pgIdx,minIdx : nativeInt;
pgIdx,minIdx : nativeInt;
jumpedOver : boolean;


procedure pG_Out(pSol:tpPlayGround;lmt: NativeInt);
procedure pG_Out(pSol:tpPlayGround;ConvChar : string;lmt: NativeInt);
const
ConvChar = '_.Q';
var
var
row,col: NativeInt;
row,col: NativeInt;
begin
begin
iF length(ConvChar)<>3 then
EXIT;
for row := lmt downto 0 do
for row := lmt downto 0 do
Begin
Begin
Line 552: Line 556:


function check(lmt:nativeInt):boolean;
function check(lmt:nativeInt):boolean;
//check, if all fields are attacked
var
var
pPG :tpPlayGround;
pPG :tpPlayGround;
Line 572: Line 577:
EXIT;
EXIT;
inc(pgIdx);
inc(pgIdx);
//check every column
For col := 0 to lmt do
For col := 0 to lmt do
begin
begin
//copy last state
CPG[pgIdx]:=CPG[pgIdx-1];
CPG[pgIdx]:=CPG[pgIdx-1];
if CPG[pgIdx][row,col] <> 0 then
pPG := @CPG[pgIdx];
if pPG^[row,col] <> 0 then
continue;
continue;

CPG[pgIdx]:=CPG[pgIdx-1];
RightAscDia(row,col,lmt);
RightAscDia(row,col,lmt);
LeftAscDia(row,col,lmt);
LeftAscDia(row,col,lmt);
//set row and column as attacked
pPG := @CPG[pgIdx];
For i := 0 to lmt do
For i := 0 to lmt do
Begin
Begin
Line 586: Line 594:
pPG^[i,col] := 1;
pPG^[i,col] := 1;
end;
end;
//set position of queen
pPG^[row,col] := 2;
pPG^[row,col] := 2;

if check(lmt) then
if check(lmt) then
begin
begin
Line 592: Line 602:
begin
begin
minIdx := pgIdx;
minIdx := pgIdx;
sol := CPG[pgIdx];
Qsol := pPG^;
end;
end;
end
end
Line 599: Line 609:
BREAK
BREAK
else
else
//check next rows
For t := row+1 to lmt do
For t := row+1 to lmt do
SetQueen(t,lmt);
SetQueen(t,lmt);
Line 605: Line 616:
end;
end;


procedure SetBishop(row,lmt: NativeInt);
var
pPG :tpPlayGround;
col,t: NativeInt;
begin
if pgIdx = minIDX then
EXIT;
inc(pgIdx);
For col := 0 to lmt do
begin
CPG[pgIdx]:=CPG[pgIdx-1];
pPG := @CPG[pgIdx];
if pPG^[row,col] <> 0 then
continue;

RightAscDia(row,col,lmt);
LeftAscDia(row,col,lmt);

//set position of bishop
pPG^[row,col] := 2;

if check(lmt) then
begin
if minIdx> pgIdx then
begin
minIdx := pgIdx;
Bsol := pPG^;
end;
end
else
if row > lmt then
BREAK
else
begin
//check next row
t := row+1;
if (t <= lmt) then
begin
SetBishop(t,lmt);
//left out max one row on field
if jumpedOver then
Begin
inc(t);
jumpedOver := false;
if t <= lmt then
SetBishop(t,lmt);
jumpedOver := true;
end;
end;
end;
end;
dec(pgIdx);
end;


var
var
lmt : NativeInt;
lmt,max : NativeInt;


BEGIN
BEGIN
For lmt := 0 to 11 do
max := 10;
write(' nxn n=:');
For lmt := 1 to max do
write(lmt:3);
writeln;

write(' Queens :');
For lmt := 0 to max-1 do
begin
begin
pgIdx := 0;
pgIdx := 0;
minIdx := 2*(lmt+1);
minIdx := 2*(lmt+1);
jumpedOver := true;
setQueen(0,lmt);
setQueen(0,lmt);
writeln(lmt+1:3,minIDX:3);
write(minIDX:3);
// pG_Out(@sol,lmt);
end;
end;
writeln;
pG_Out(@sol,lmt);

write(' Bishop :');
For lmt := 0 to max-1 do
begin
pgIdx := 0;
minIdx := 2*(lmt+1);
jumpedOver := true;
setBishop(0,lmt);
write(minIDX:3);
end;
writeln;
pG_Out(@Qsol,'_.Q',max-1);
writeln;
pG_Out(@Bsol,'_.B',max-1);
END.</lang>
END.</lang>
{{out|@TIO.RUN}}
{{out|@TIO.RUN}}
<pre>
<pre>
nxn min. queens
1 1
2 1
3 2
4 3
5 3
6 4
7 4
8 5
9 5
10 5
11 6 //Real time: 3.241 s
12 7
.Q..........
............
........Q...
............
...Q........
............
............
..........Q.
............
.....Q......
..Q.........
Q...........


Real time: 45.856 s CPU share: 99.24 % // below the time limit of 60 secs</pre>
nxn n=: 1 2 3 4 5 6 7 8 9 10
Queens : 1 1 2 3 3 4 4 5 5 5
Bishop : 1 2 3 4 5 6 7 8 9 10
..........
......Q...
..........
Q.........
..........
....Q.....
..........
........Q.
..........
..Q.......


B.........
.....B....
...B......
.....B....
...B......
........B.
....B.....
....B.....
....B.....
B.........

Real time: 4.740 s CPU share: 99.06 %</pre>


=={{header|Phix}}==
=={{header|Phix}}==
Retrieved from "https://rosettacode.org/wiki/N-queens_minimum_and_knights_and_bishops"