Data update
This commit is contained in:
Ingy döt Net
parent
29a5eea0d4
commit
5c1bb7bfa9
2011 changed files with 35081 additions and 3229 deletions
|
|
@ -1,81 +1,34 @@
|
|||
program queens;
|
||||
program eightqueens(output);
|
||||
var i: integer;
|
||||
a: array [1..8] of boolean; { a[j]: no queen in row j }
|
||||
b: array [2..16] of boolean; { b[k]: no queen in kth diagonal down-left }
|
||||
c: array [-7..7] of boolean; { c[k]: no queen in kth diagonal down-right }
|
||||
x: array [1..8] of integer; { x[i]: position of queen in column i }
|
||||
procedure print;
|
||||
var k: integer;
|
||||
begin
|
||||
for k := 1 to 8 do write(x[k]: 4);
|
||||
writeln
|
||||
end { print } ;
|
||||
|
||||
const l=16;
|
||||
|
||||
var i,j,k,m,n,p,q,r,y,z: integer;
|
||||
a,s: array[1..l] of integer;
|
||||
u: array[1..4*l-2] of integer;
|
||||
|
||||
label L3,L4,L5,L6,L7,L8,L9,L10;
|
||||
procedure try(i: integer);
|
||||
var j: integer;
|
||||
begin
|
||||
for j := 1 to 8 do
|
||||
if a[j] and b[i+j] and c[i-j] then
|
||||
begin
|
||||
{ place queen }
|
||||
x[i] := j;
|
||||
a[j] := false; b[i+j] := false; c[i-j] := false;
|
||||
if i < 8 then try(i+1) else print;
|
||||
{ remove queen }
|
||||
a[j] := true; b[i+j] := true; c[i-j] := true
|
||||
end
|
||||
end { try } ;
|
||||
|
||||
begin
|
||||
for i:=1 to l do a[i]:=i;
|
||||
for i:=1 to 4*l-2 do u[i]:=0;
|
||||
for n:=1 to l do
|
||||
begin
|
||||
m:=0;
|
||||
i:=1;
|
||||
r:=2*n-1;
|
||||
goto L4;
|
||||
L3:
|
||||
s[i]:=j;
|
||||
u[p]:=1;
|
||||
u[q+r]:=1;
|
||||
i:=i+1;
|
||||
L4:
|
||||
if i>n then goto L8;
|
||||
j:=i;
|
||||
L5:
|
||||
z:=a[i];
|
||||
y:=a[j];
|
||||
p:=i-y+n;
|
||||
q:=i+y-1;
|
||||
a[i]:=y;
|
||||
a[j]:=z;
|
||||
if (u[p]=0) and (u[q+r]=0) then goto L3;
|
||||
L6:
|
||||
j:=j+1;
|
||||
if j<=n then goto L5;
|
||||
L7:
|
||||
j:=j-1;
|
||||
if j=i then goto L9;
|
||||
z:=a[i];
|
||||
a[i]:=a[j];
|
||||
a[j]:=z;
|
||||
goto L7;
|
||||
L8:
|
||||
m:=m+1;
|
||||
{ uncomment the following to print solutions }
|
||||
{ write(n,' ',m,':');
|
||||
for k:=1 to n do write(' ',a[k]);
|
||||
writeln; }
|
||||
L9:
|
||||
i:=i-1;
|
||||
if i=0 then goto L10;
|
||||
p:=i-a[i]+n;
|
||||
q:=i+a[i]-1;
|
||||
j:=s[i];
|
||||
u[p]:=0;
|
||||
u[q+r]:=0;
|
||||
goto L6;
|
||||
L10:
|
||||
writeln(n,' ',m);
|
||||
end;
|
||||
end.
|
||||
|
||||
{ 1 1
|
||||
2 0
|
||||
3 0
|
||||
4 2
|
||||
5 10
|
||||
6 4
|
||||
7 40
|
||||
8 92
|
||||
9 352
|
||||
10 724
|
||||
11 2680
|
||||
12 14200
|
||||
13 73712
|
||||
14 365596
|
||||
15 2279184
|
||||
16 14772512 }
|
||||
for i := 1 to 8 do a[i] := true;
|
||||
for i := 2 to 16 do b[i] := true;
|
||||
for i := -7 to 7 do c[i] := true;
|
||||
try(1)
|
||||
end .
|
||||
|
|
|
|||
|
|
@ -1,112 +1,81 @@
|
|||
program NQueens;
|
||||
{$IFDEF FPC}
|
||||
{$MODE DELPHI}
|
||||
{$OPTIMIZATION ON}{$OPTIMIZATION REGVAR}{$OPTIMIZATION PeepHole}
|
||||
{$OPTIMIZATION CSE}{$OPTIMIZATION ASMCSE}
|
||||
{$ELSE}
|
||||
{$Apptype console}
|
||||
{$ENDIF}
|
||||
program queens;
|
||||
|
||||
const l=16;
|
||||
|
||||
var i,j,k,m,n,p,q,r,y,z: integer;
|
||||
a,s: array[1..l] of integer;
|
||||
u: array[1..4*l-2] of integer;
|
||||
|
||||
label L3,L4,L5,L6,L7,L8,L9,L10;
|
||||
|
||||
uses
|
||||
sysutils;// TDatetime
|
||||
const
|
||||
nmax = 17;
|
||||
type
|
||||
{$IFNDEF FPC}
|
||||
NativeInt = longInt;
|
||||
{$ENDIF}
|
||||
//ala Nikolaus Wirth A-1 = H - 8
|
||||
//diagonal left (A1) to rigth (H8)
|
||||
tLR_diagonale = array[-nmax-1..nmax-1] of char;
|
||||
//diagonal right (A8) to left (H1)
|
||||
tRL_diagonale = array[0..2*nmax-2] of char;
|
||||
//up to Col are the used Cols, after that the unused
|
||||
tFreeCol = array[0..nmax-1] of nativeInt;
|
||||
var
|
||||
LR_diagonale:tLR_diagonale;
|
||||
RL_diagonale:tRL_diagonale;
|
||||
//Using pChar, cause it is implicit an array
|
||||
//It is always set to
|
||||
//@LR_diagonale[row] ,@RL_diagonale[row]
|
||||
pLR,pRL : pChar;
|
||||
FreeCol : tFreeCol;
|
||||
i,
|
||||
n : nativeInt;
|
||||
gblCount : nativeUInt;
|
||||
T0,T1 : TdateTime;
|
||||
procedure Solution;
|
||||
var
|
||||
i : NativeInt;
|
||||
begin
|
||||
// Take's a lot of time under DOS/Win32
|
||||
If gblCount AND $FFF = 0 then
|
||||
write(gblCount:10,#8#8#8#8#8#8#8#8#8#8);
|
||||
// IF n< 9 then
|
||||
IF n < 0 then
|
||||
for i:=1 to l do a[i]:=i;
|
||||
for i:=1 to 4*l-2 do u[i]:=0;
|
||||
for n:=1 to l do
|
||||
begin
|
||||
For i := 1 to n do
|
||||
write(FreeCol[i]:4);
|
||||
writeln;
|
||||
m:=0;
|
||||
i:=1;
|
||||
r:=2*n-1;
|
||||
goto L4;
|
||||
L3:
|
||||
s[i]:=j;
|
||||
u[p]:=1;
|
||||
u[q+r]:=1;
|
||||
i:=i+1;
|
||||
L4:
|
||||
if i>n then goto L8;
|
||||
j:=i;
|
||||
L5:
|
||||
z:=a[i];
|
||||
y:=a[j];
|
||||
p:=i-y+n;
|
||||
q:=i+y-1;
|
||||
a[i]:=y;
|
||||
a[j]:=z;
|
||||
if (u[p]=0) and (u[q+r]=0) then goto L3;
|
||||
L6:
|
||||
j:=j+1;
|
||||
if j<=n then goto L5;
|
||||
L7:
|
||||
j:=j-1;
|
||||
if j=i then goto L9;
|
||||
z:=a[i];
|
||||
a[i]:=a[j];
|
||||
a[j]:=z;
|
||||
goto L7;
|
||||
L8:
|
||||
m:=m+1;
|
||||
{ uncomment the following to print solutions }
|
||||
{ write(n,' ',m,':');
|
||||
for k:=1 to n do write(' ',a[k]);
|
||||
writeln; }
|
||||
L9:
|
||||
i:=i-1;
|
||||
if i=0 then goto L10;
|
||||
p:=i-a[i]+n;
|
||||
q:=i+a[i]-1;
|
||||
j:=s[i];
|
||||
u[p]:=0;
|
||||
u[q+r]:=0;
|
||||
goto L6;
|
||||
L10:
|
||||
writeln(n,' ',m);
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure SetQueen(Row:nativeInt);
|
||||
var
|
||||
i,Col : nativeInt;
|
||||
begin
|
||||
IF row <= n then
|
||||
begin
|
||||
For i := row to n do
|
||||
begin
|
||||
Col := FreeCol[i];
|
||||
//check diagonals occupied
|
||||
If (ORD(pLR[-Col]) AND ORD(pRL[Col]))<>0 then
|
||||
begin
|
||||
//a "free" position is found
|
||||
//mark it
|
||||
pRL[ Col]:=#0; //RL_Diagonale[ Row +Col] := 0;
|
||||
pLR[-Col]:=#0; //LR_Diagonale[ Row -Col] := 0;
|
||||
//swap FreeRow[Row<->i]
|
||||
FreeCol[i] := FreeCol[Row];
|
||||
//next row
|
||||
inc(pRL);
|
||||
inc(pLR);
|
||||
FreeCol[Row] := Col;
|
||||
// check next row
|
||||
SetQueen(Row+1);
|
||||
//Undo
|
||||
dec(pLR);
|
||||
dec(pRL);
|
||||
FreeCol[Row] := FreeCol[i];
|
||||
FreeCol[i] := Col;
|
||||
pRL[ Col]:=#1;
|
||||
pLR[-Col]:=#1;
|
||||
end;
|
||||
end;
|
||||
end
|
||||
else
|
||||
begin
|
||||
//solution ist found
|
||||
inc(gblCount);
|
||||
//Solution
|
||||
end;
|
||||
end;
|
||||
|
||||
begin
|
||||
For i := 0 to nmax-1 do
|
||||
FreeCol[i] := i;
|
||||
//diagonals filled with True = #1 , something <>0
|
||||
fillchar(LR_Diagonale[low(LR_Diagonale)],sizeof(tLR_Diagonale),#1);
|
||||
fillchar(RL_Diagonale[low(RL_Diagonale)],sizeof(tRL_Diagonale),#1);
|
||||
For n := 1 to nMax do
|
||||
begin
|
||||
t0 := time;
|
||||
pLR:=@LR_Diagonale[0];
|
||||
pRL:=@RL_Diagonale[0];
|
||||
gblCount := 0;
|
||||
SetQueen(1);
|
||||
t1:= time;
|
||||
WriteLn(n:6,gblCount:12,FormatDateTime(' NN:SS.ZZZ',T1-t0),' secs');
|
||||
end;
|
||||
WriteLn('Fertig');
|
||||
end.
|
||||
|
||||
{ 1 1
|
||||
2 0
|
||||
3 0
|
||||
4 2
|
||||
5 10
|
||||
6 4
|
||||
7 40
|
||||
8 92
|
||||
9 352
|
||||
10 724
|
||||
11 2680
|
||||
12 14200
|
||||
13 73712
|
||||
14 365596
|
||||
15 2279184
|
||||
16 14772512 }
|
||||
|
|
|
|||
112
Task/N-queens-problem/Pascal/n-queens-problem-3.pas
Normal file
112
Task/N-queens-problem/Pascal/n-queens-problem-3.pas
Normal file
|
|
@ -0,0 +1,112 @@
|
|||
program NQueens;
|
||||
{$IFDEF FPC}
|
||||
{$MODE DELPHI}
|
||||
{$OPTIMIZATION ON}{$OPTIMIZATION REGVAR}{$OPTIMIZATION PeepHole}
|
||||
{$OPTIMIZATION CSE}{$OPTIMIZATION ASMCSE}
|
||||
{$ELSE}
|
||||
{$Apptype console}
|
||||
{$ENDIF}
|
||||
|
||||
uses
|
||||
sysutils;// TDatetime
|
||||
const
|
||||
nmax = 17;
|
||||
type
|
||||
{$IFNDEF FPC}
|
||||
NativeInt = longInt;
|
||||
{$ENDIF}
|
||||
//ala Nikolaus Wirth A-1 = H - 8
|
||||
//diagonal left (A1) to rigth (H8)
|
||||
tLR_diagonale = array[-nmax-1..nmax-1] of char;
|
||||
//diagonal right (A8) to left (H1)
|
||||
tRL_diagonale = array[0..2*nmax-2] of char;
|
||||
//up to Col are the used Cols, after that the unused
|
||||
tFreeCol = array[0..nmax-1] of nativeInt;
|
||||
var
|
||||
LR_diagonale:tLR_diagonale;
|
||||
RL_diagonale:tRL_diagonale;
|
||||
//Using pChar, cause it is implicit an array
|
||||
//It is always set to
|
||||
//@LR_diagonale[row] ,@RL_diagonale[row]
|
||||
pLR,pRL : pChar;
|
||||
FreeCol : tFreeCol;
|
||||
i,
|
||||
n : nativeInt;
|
||||
gblCount : nativeUInt;
|
||||
T0,T1 : TdateTime;
|
||||
procedure Solution;
|
||||
var
|
||||
i : NativeInt;
|
||||
begin
|
||||
// Take's a lot of time under DOS/Win32
|
||||
If gblCount AND $FFF = 0 then
|
||||
write(gblCount:10,#8#8#8#8#8#8#8#8#8#8);
|
||||
// IF n< 9 then
|
||||
IF n < 0 then
|
||||
begin
|
||||
For i := 1 to n do
|
||||
write(FreeCol[i]:4);
|
||||
writeln;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure SetQueen(Row:nativeInt);
|
||||
var
|
||||
i,Col : nativeInt;
|
||||
begin
|
||||
IF row <= n then
|
||||
begin
|
||||
For i := row to n do
|
||||
begin
|
||||
Col := FreeCol[i];
|
||||
//check diagonals occupied
|
||||
If (ORD(pLR[-Col]) AND ORD(pRL[Col]))<>0 then
|
||||
begin
|
||||
//a "free" position is found
|
||||
//mark it
|
||||
pRL[ Col]:=#0; //RL_Diagonale[ Row +Col] := 0;
|
||||
pLR[-Col]:=#0; //LR_Diagonale[ Row -Col] := 0;
|
||||
//swap FreeRow[Row<->i]
|
||||
FreeCol[i] := FreeCol[Row];
|
||||
//next row
|
||||
inc(pRL);
|
||||
inc(pLR);
|
||||
FreeCol[Row] := Col;
|
||||
// check next row
|
||||
SetQueen(Row+1);
|
||||
//Undo
|
||||
dec(pLR);
|
||||
dec(pRL);
|
||||
FreeCol[Row] := FreeCol[i];
|
||||
FreeCol[i] := Col;
|
||||
pRL[ Col]:=#1;
|
||||
pLR[-Col]:=#1;
|
||||
end;
|
||||
end;
|
||||
end
|
||||
else
|
||||
begin
|
||||
//solution ist found
|
||||
inc(gblCount);
|
||||
//Solution
|
||||
end;
|
||||
end;
|
||||
|
||||
begin
|
||||
For i := 0 to nmax-1 do
|
||||
FreeCol[i] := i;
|
||||
//diagonals filled with True = #1 , something <>0
|
||||
fillchar(LR_Diagonale[low(LR_Diagonale)],sizeof(tLR_Diagonale),#1);
|
||||
fillchar(RL_Diagonale[low(RL_Diagonale)],sizeof(tRL_Diagonale),#1);
|
||||
For n := 1 to nMax do
|
||||
begin
|
||||
t0 := time;
|
||||
pLR:=@LR_Diagonale[0];
|
||||
pRL:=@RL_Diagonale[0];
|
||||
gblCount := 0;
|
||||
SetQueen(1);
|
||||
t1:= time;
|
||||
WriteLn(n:6,gblCount:12,FormatDateTime(' NN:SS.ZZZ',T1-t0),' secs');
|
||||
end;
|
||||
WriteLn('Fertig');
|
||||
end.
|
||||
Loading…
Add table
Add a link
Reference in a new issue