Задача о расстановке ферзей / QUEEN95 / QUEEN1 / MONTECAR / MONTECAR

{$E+,N+}
program Monte_Carlo;
Uses Crt, Dos;
const maxN = 20;
type Nat = 1..maxN;
Nat0 = 0..maxN;
pos = array[Nat] of Nat;
var n : Nat;
nExp : integer;
v : Double;
fout : Text;
t, t1,t2 : LongInt;
min, sec, s100 : Word;

procedure MonteCarlo ( nExp : integer; n : Nat; var v: Double );
var k : Nat0;
m_k, num : Nat0;
i : Nat;
iExp : Word;
a, S_k : pos;
n_div_2 : Nat0;
all, sum, prod : Double;
function NoFerz ( k: Nat; s: Nat) : Boolean;
{ NoFerz = 'дҐа§м ­Ґ ¬®¦Ґв Ўлвм Ї®бв ў«Ґ­ ў бва®Єг s бв®«Ўж  k' }
{ ¬ ббЁў a[*] - ў­Ґи­Ё© }
var Flag : Boolean;
i : Nat;
begin {NoFerz}
Flag := True;
i := 1;
while (i<k) and Flag do
begin { Flag='дҐа§Ё [1..i) ­Ґ  в Єгов Ї®«Ґ <k,s>'}
{  в ЄгҐв «Ё дҐа§м Ё§ i-Ј® бв®«Ўж  Ї®«Ґ <k,s>?}
Flag := not ( (a[i]=s) or (abs(a[i]-s)=k-i) );
i := i+1
end {while};
NoFerz := not Flag
end {NoFerz};

procedure FormSk ( k: Nat; var m_k: Nat0; var S_k: pos );
{ д®а¬ЁагҐв "¬­®¦Ґбвў®" (ўҐЄв®а) S_k ў®§¬®¦­ле 室®ў Ё
ҐЈ® ¬®й­®бвм m_k; Ґб«Ё S_k Їгбв®, в® m_k=0 }
var s: Nat;
begin
m_k := 0;
for s:=1 to n do
if not NoFerz( k, s) then
begin { ¬®¦­® бв ўЁвм }
m_k := m_k + 1;
S_k[m_k] := s
end;
end {FormSk};

begin { MonteCarlo }
Randomize;
n_div_2 := n div 2;
all := 0;
for iExp:=1 to nExp do
begin { ®зҐаҐ¤­®Ґ ЁбЇлв ­ЁҐ }
m_k :=n-1;
num := Random ( m_k )+1;
a[1] := num+1;
k := 1;
prod :=1;
sum := prod;
FormSk ( k, m_k, S_k );

while m_k<>0 do
begin
prod := prod*m_k;
sum := sum + prod;
num := Random ( m_k ) + 1;
a[k] := S_k[num];
k := k + 1;
FormSk ( k, m_k, S_k );
end {while};

all := all + sum
end {for};
v := all/nExp
end { MonteCarlo };

procedure MyGetTime ( var t : LongInt );
{ўл¤ Ґв ўаҐ¬п ў б®вле ¤®«пе ᥪ㭤л}
var h, m, s , hund : Word;
begin
GetTime( h, m , s, hund);
t := s + 60 * m;
t := hund + 100 * t
end { MyGetTime };

procedure MyUnPackTime ( t: LongInt; var m, s, hund : Word );
{ЇҐаҐў®¤Ёв ўаҐ¬п t (ў б®вле ¤®«пе ᥪ㭤л)
ў ¬Ё­гвл m, ᥪ㭤л s, б®влҐ hund }
begin
hund := t mod 100;
t := t div 100; {ў ᥪ㭠е}
s := t mod 60;
m := t div 60
end { MyUnPackTime };
begin
WriteLn(' n = ?'); ReadLn(n);
WriteLn(' nExp = ?'); ReadLn(nExp);
Assign(fout,'MONTEC.DAT');
Rewrite{Append}(fout);
WriteLn(fout,'Є®«ЁзҐбвў® дҐа§Ґ© = ',n:2);
WriteLn(fout,'Є®«ЁзҐбвў® ЁбЇлв ­Ё© = ',nExp:2);

MyGetTime(t1);

MonteCarlo ( nExp, n, v );

MyGetTime(t2);
WriteLn(fout,'Є®«ЁзҐбвў® 㧫®ў ў ¤ҐаҐўҐ Ї®ЁбЄ  :', v :12:1 );
t := t2 - t1; MyUnPackTime( t, min, sec, s100);
if(s100<10)
then WriteLn(fout,'ўаҐ¬п = ', min,' ¬Ё­ ', sec,'.0', s100,' ᥪ')
else WriteLn(fout,'ўаҐ¬п = ', min,' ¬Ё­ ', sec,'.', s100,' ᥪ');
Close (fout)
end.