Добавил:
Studfiles2
Опубликованный материал нарушает ваши авторские права? Сообщите нам.
Вуз:
Предмет:
Файл:Задача о расстановке ферзей / QUEEN99 / QUEEN / QUEEN
.PAS {‡ ¤ з :
ђ ббв ўЁвм и е¬ в®© ¤®бЄҐ а §¬Ґа N N, N дҐа§Ґ© в Є,
зв®Ўл Ё ®¤Ё дҐа§м Ґ гЈа®¦ « ¤агЈ®¬г.}
{Џа®Ја ¬¬ ®вᥨў ой п ҐЄ®в®алҐ ў аЁ вл бЁ¬¬ҐваЁзле аҐиҐЁ©.}
Uses Dos,crt;
const MaxN=15;
type Nat=1..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; { а §¬Ґа ¤®бЄЁ(Є®«ЁзҐбвў® дҐа§Ґ©) }
X:array[1..MaxN] of Nat; { аҐиҐЁҐ }
fout:text; {ўл室®© д ©«}
{--------------------------------------------------------------------------}
t, t1,t2 : LongInt;
min, sec, s100 : Word;
countS, { Є®«ЁзҐбвў® аҐиҐЁ©(ЎҐ§ гзҐв бЁ¬¬ҐваЁЁ) }
count:Longint;{ Є®«ЁзҐбвў® ўҐаиЁ ў ¤ҐаҐўҐ }
n_div_2,j:integer;
{--------------------------------------------------------------------------}
procedure print;
{ ўлў®¤ аҐиҐЁп ў д ©«}
var k:Nat;
begin
countS:=countS+1;
write(fout,countS:8,':');
for k:=1 to N do write(fout,X[k]:3);
writeln(fout);
end{ print };
procedure Queen(i:Nat);
{ 室Ёв ўбҐ ў®§¬®¦лҐ аҐиҐЁп § ¤ зЁ (ЎҐ§ гзҐв бЁ¬¬ҐваЁЁ) }
var j:Nat;
begin
for j:=1 to N do
if H[j] and D1[i+j] and D2[i-j] then { ¬®¦® Ї®бв ўЁвм }
begin
X[i]:=j; count:=count+1;
H[j]:=false; D1[i+j]:=false; D2[i-j]:=false; { бв ўЁ¬ }
if i<N then Queen(i+1)
else print;
H[j]:=true; D1[i+j]:=true; D2[i-j]:=true; { гЎЁа Ґ¬ }
end;
end{ Ferz };
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 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;
Write('‚ўҐ¤ЁвҐ а §¬Ґал ¤®бЄЁ (N):'); ReadLn(n);
Assign(fout,'QOut___.DAT');
Rewrite(fout);
WriteLn(fout,'Є®«ЁзҐбвў® дҐа§Ґ© = ',n:2);
WriteLn(fout,'а Ґ и Ґ Ё п :');
MyGetTime(t1);
count:=0; countS:=0; Mass;
n_div_2:=(n div 2);
for j:=2 to n_div_2 do
begin
X[1]:=j; count:=count+1;
H[j]:=false; D1[1+j]:=false; D2[1-j]:=false;
Queen(2);
H[j]:=true; D1[1+j]:=true; D2[1-j]:=true;
end;
MyGetTime(t2);
t := t2 - t1; MyUnPackTime( t, min, sec, s100);
Writeln(fout,' ўбҐЈ® ўҐаиЁ = ',count);
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=15;
type Nat=1..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; { а §¬Ґа ¤®бЄЁ(Є®«ЁзҐбвў® дҐа§Ґ©) }
X:array[1..MaxN] of Nat; { аҐиҐЁҐ }
fout:text; {ўл室®© д ©«}
{--------------------------------------------------------------------------}
t, t1,t2 : LongInt;
min, sec, s100 : Word;
countS, { Є®«ЁзҐбвў® аҐиҐЁ©(ЎҐ§ гзҐв бЁ¬¬ҐваЁЁ) }
count:Longint;{ Є®«ЁзҐбвў® ўҐаиЁ ў ¤ҐаҐўҐ }
n_div_2,j:integer;
{--------------------------------------------------------------------------}
procedure print;
{ ўлў®¤ аҐиҐЁп ў д ©«}
var k:Nat;
begin
countS:=countS+1;
write(fout,countS:8,':');
for k:=1 to N do write(fout,X[k]:3);
writeln(fout);
end{ print };
procedure Queen(i:Nat);
{ 室Ёв ўбҐ ў®§¬®¦лҐ аҐиҐЁп § ¤ зЁ (ЎҐ§ гзҐв бЁ¬¬ҐваЁЁ) }
var j:Nat;
begin
for j:=1 to N do
if H[j] and D1[i+j] and D2[i-j] then { ¬®¦® Ї®бв ўЁвм }
begin
X[i]:=j; count:=count+1;
H[j]:=false; D1[i+j]:=false; D2[i-j]:=false; { бв ўЁ¬ }
if i<N then Queen(i+1)
else print;
H[j]:=true; D1[i+j]:=true; D2[i-j]:=true; { гЎЁа Ґ¬ }
end;
end{ Ferz };
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 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;
Write('‚ўҐ¤ЁвҐ а §¬Ґал ¤®бЄЁ (N):'); ReadLn(n);
Assign(fout,'QOut___.DAT');
Rewrite(fout);
WriteLn(fout,'Є®«ЁзҐбвў® дҐа§Ґ© = ',n:2);
WriteLn(fout,'а Ґ и Ґ Ё п :');
MyGetTime(t1);
count:=0; countS:=0; Mass;
n_div_2:=(n div 2);
for j:=2 to n_div_2 do
begin
X[1]:=j; count:=count+1;
H[j]:=false; D1[1+j]:=false; D2[1-j]:=false;
Queen(2);
H[j]:=true; D1[1+j]:=true; D2[1-j]:=true;
end;
MyGetTime(t2);
t := t2 - t1; MyUnPackTime( t, min, sec, s100);
Writeln(fout,' ўбҐЈ® ўҐаиЁ = ',count);
if(s100<10)
then Write(fout,'ўаҐ¬п = ', min,' ¬Ё ', sec,'.0', s100,' ᥪ')
else Write(fout,'ўаҐ¬п = ', min,' ¬Ё ', sec,'.', s100,' ᥪ');
Close (fout)
end.