Добавил:
Studfiles2
Опубликованный материал нарушает ваши авторские права? Сообщите нам.
Вуз:
Предмет:
Файл:Задача о расстановке ферзей / QUEEN99 / QUEEN1 / MONTECAR / MONTECAR
.PAS {‡ ¤ з :
ђ ббв ўЁвм и е¬ в®© ¤®бЄҐ а §¬Ґа N N, N дҐа§Ґ© в Є,
зв®Ўл Ё ®¤Ё дҐа§м Ґ гЈа®¦ « ¤агЈ®¬г.
‚ ®ЇЁб ®© ўлиҐ § ¤ зҐ ®жҐЁвм Є®«ЁзҐбвў® 㧫®ў ¤ҐаҐў
Ї®ЁбЄ Ї® ¬Ґв®¤г Њ®вҐ-Љ а«®.}
Uses Dos,crt;
const MaxN=16;
type Nat=1..MaxN;
Nat0=0..MaxN;
var
H:array[1..MaxN] of boolean; { § пв (false) Ј®аЁ§®в «м }
D1:array[2..2*MaxN] of boolean; { § пв (false) /-¤Ё Ј® «м }
D2:array[1-MaxN..MaxN-1] of boolean;{ § пв (false) \-¤Ё Ј® «м }
N:Nat;
nExp:integer; { Є®«ЁзҐбвў® Їа®е®¤®ў Ї® ¤ҐаҐўг }
v:Real; { Є®«ЁзҐбвў® Є®аҐ© }
fout:text; {ўл室®© д ©«}
{--------------------------------------------------------------------------}
t, t1,t2 : LongInt;
min, sec, s100 : Word;
{--------------------------------------------------------------------------}
procedure Mass;
{ Ё§ з «м® ¬ ббЁўл Їгбвл(Ґв § пвле Ї®§ЁжЁ©) }
var i:integer;
begin
for i:=1 to N do H[i]:=true;
for i:=2 to 2*N do D1[i]:=true;
for i:=1-N to N-1 do D2[i]:=true;
end{ Mass };
procedure FormS( num:Nat0;i:Nat );
{ ўлЎЁа Ґв 室 б ®¬Ґа®¬ (num) Ё§ ўбҐе ў®§¬¦ле }
var j:Nat;
k:Nat0;
begin
k:=0; j:=1;
while (j<=n)and(k<>num) do
begin
if H[j] and D1[i+j] and D2[i-j] then k:=k+1;
j:=j+1;
end;
H[j-1]:=false; D1[i+j-1]:=false; D2[i-j+1]:=false;
end{ FormS };
function ModS(i:Nat):Nat0;
{ 室Ёв Є®«ЁзҐбвў® ў®§¬®¦ле 室®ў }
var j:Nat;
m:Nat0;
begin
m:=0;
if i<=N then
for j:=1 to N do
if H[j] and D1[i+j] and D2[i-j] then m:=m+1;
ModS:=m;
end { ModS };
procedure MonteCarlo( nExp:integer; var v: Real );
var iExp:integer;
num,m:Nat0;
all,sum, prod : Real;
i:Nat;
begin { MonteCarlo }
Randomize;
all:=0;
for iExp:=1 to nExp do
begin { ®зҐаҐ¤®Ґ ЁбЇлв ЁҐ }
Mass; prod:=1; i:=1; m:=N; sum:=0;
while m<>0 do
begin
prod:=prod*m;
sum:=sum+prod;
num:=Random(m); if (num=0) then num:=m;
FormS(num,i); i:=i+1; m:=ModS(i);
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
clrscr;
WriteLn(' n = ?'); ReadLn(n);
WriteLn(' nExp = ?'); ReadLn(nExp);
Assign(fout,'MONTE‘.DAT');
Rewrite(fout);
WriteLn(fout,'Є®«ЁзҐбвў® дҐа§Ґ© = ',n:2);
WriteLn(fout,'Є®«ЁзҐбвў® ЁбЇлв Ё© = ',nExp:2);
MyGetTime(t1);
MonteCarlo ( nExp, v );
MyGetTime(t2);
WriteLn(fout,'Є®«ЁзҐбвў® 㧫®ў ў ¤ҐаҐўҐ Ї®ЁбЄ :', v :12:1 );
t := t2 - t1; MyUnPackTime( t, min, sec, s100);
if(s100<10)
then Write(fout,'ўаҐ¬п = ', min,' ¬Ё ', sec,'.0', s100,' ᥪ')
else Write(fout,'ўаҐ¬п = ', min,' ¬Ё ', sec,'.', s100,' ᥪ');
Close (fout)
end.
ђ ббв ўЁвм и е¬ в®© ¤®бЄҐ а §¬Ґа N N, N дҐа§Ґ© в Є,
зв®Ўл Ё ®¤Ё дҐа§м Ґ гЈа®¦ « ¤агЈ®¬г.
‚ ®ЇЁб ®© ўлиҐ § ¤ зҐ ®жҐЁвм Є®«ЁзҐбвў® 㧫®ў ¤ҐаҐў
Ї®ЁбЄ Ї® ¬Ґв®¤г Њ®вҐ-Љ а«®.}
Uses Dos,crt;
const MaxN=16;
type Nat=1..MaxN;
Nat0=0..MaxN;
var
H:array[1..MaxN] of boolean; { § пв (false) Ј®аЁ§®в «м }
D1:array[2..2*MaxN] of boolean; { § пв (false) /-¤Ё Ј® «м }
D2:array[1-MaxN..MaxN-1] of boolean;{ § пв (false) \-¤Ё Ј® «м }
N:Nat;
nExp:integer; { Є®«ЁзҐбвў® Їа®е®¤®ў Ї® ¤ҐаҐўг }
v:Real; { Є®«ЁзҐбвў® Є®аҐ© }
fout:text; {ўл室®© д ©«}
{--------------------------------------------------------------------------}
t, t1,t2 : LongInt;
min, sec, s100 : Word;
{--------------------------------------------------------------------------}
procedure Mass;
{ Ё§ з «м® ¬ ббЁўл Їгбвл(Ґв § пвле Ї®§ЁжЁ©) }
var i:integer;
begin
for i:=1 to N do H[i]:=true;
for i:=2 to 2*N do D1[i]:=true;
for i:=1-N to N-1 do D2[i]:=true;
end{ Mass };
procedure FormS( num:Nat0;i:Nat );
{ ўлЎЁа Ґв 室 б ®¬Ґа®¬ (num) Ё§ ўбҐе ў®§¬¦ле }
var j:Nat;
k:Nat0;
begin
k:=0; j:=1;
while (j<=n)and(k<>num) do
begin
if H[j] and D1[i+j] and D2[i-j] then k:=k+1;
j:=j+1;
end;
H[j-1]:=false; D1[i+j-1]:=false; D2[i-j+1]:=false;
end{ FormS };
function ModS(i:Nat):Nat0;
{ 室Ёв Є®«ЁзҐбвў® ў®§¬®¦ле 室®ў }
var j:Nat;
m:Nat0;
begin
m:=0;
if i<=N then
for j:=1 to N do
if H[j] and D1[i+j] and D2[i-j] then m:=m+1;
ModS:=m;
end { ModS };
procedure MonteCarlo( nExp:integer; var v: Real );
var iExp:integer;
num,m:Nat0;
all,sum, prod : Real;
i:Nat;
begin { MonteCarlo }
Randomize;
all:=0;
for iExp:=1 to nExp do
begin { ®зҐаҐ¤®Ґ ЁбЇлв ЁҐ }
Mass; prod:=1; i:=1; m:=N; sum:=0;
while m<>0 do
begin
prod:=prod*m;
sum:=sum+prod;
num:=Random(m); if (num=0) then num:=m;
FormS(num,i); i:=i+1; m:=ModS(i);
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
clrscr;
WriteLn(' n = ?'); ReadLn(n);
WriteLn(' nExp = ?'); ReadLn(nExp);
Assign(fout,'MONTE‘.DAT');
Rewrite(fout);
WriteLn(fout,'Є®«ЁзҐбвў® дҐа§Ґ© = ',n:2);
WriteLn(fout,'Є®«ЁзҐбвў® ЁбЇлв Ё© = ',nExp:2);
MyGetTime(t1);
MonteCarlo ( nExp, v );
MyGetTime(t2);
WriteLn(fout,'Є®«ЁзҐбвў® 㧫®ў ў ¤ҐаҐўҐ Ї®ЁбЄ :', v :12:1 );
t := t2 - t1; MyUnPackTime( t, min, sec, s100);
if(s100<10)
then Write(fout,'ўаҐ¬п = ', min,' ¬Ё ', sec,'.0', s100,' ᥪ')
else Write(fout,'ўаҐ¬п = ', min,' ¬Ё ', sec,'.', s100,' ᥪ');
Close (fout)
end.