Đề thi HSG tin học lớp 9

writelnf,dem; closef; end; begin docf; xuly; end.

const fi= 'SORT.INP';

fo= 'SORT.OUT';

max= 10;

type mang1= array[1 max] of integer;

mang2= array[1 max] of boolean;

mang3= array[1 max,1 max,1 max] of boolean; var a,hoanvi:mang1;

chuaxet:mang2;

n:integer;

xet:mang3;

f:text;

dem:longint;

procedure docf;

var i:integer;

begin

assign(f,fi);

reset(f);

readln(f,n);

for i:=1 to n do

read(f,a[i]);

close(f);

end;

procedure ghif;

var t,i1,j1,k1:integer;

kt:boolean;

begin

kt:=true;

for i1:=1 to n-1 do

for j1:=i1+1 to n do

if (j1-i1>=2) then

for k1:=i1+1 to j1-1 do

if (xet[hoanvi[i1],hoanvi[k1],hoanvi[j1]]=false) then begin

kt:=false;

exit;

end;

if (kt=true) then

begin

for t:=1 to n do

write(f,a[hoanvi[t]],' ');

writeln(f);

inc(dem);

end;

end;

procedure try(i:integer);

var j:integer;

begin

for j:=1 to n do

if (chuaxet[j]) then

begin

hoanvi[i]:=j;

chuaxet[j]:=false;

if (i=n) then

ghif

else

try(i+1);

chuaxet[j]:=true;

hoanvi[i]:=0;

end;

end;

procedure xuly;

var i,j,k:integer;

begin

assign(f,fo);

rewrite(f);

fillchar(xet,sizeof(xet),true);

for i:=1 to n do

for j:=1 to n do

for k:=1 to n do

if (i<>j) and (j<>k) and (k<>i) and (2*a[k]=a[i]+a[j]) then begin

xet[i,k,j]:=false;

xet[j,k,i]:=false;

end;

fillchar(chuaxet,sizeof(chuaxet),true);

fillchar(hoanvi,sizeof(hoanvi),0);

try(1);

writeln(f,dem);

close(f);

end;

begin

docf;

xuly;

end

const fi='PCIRCLE.INP';

fo='PCIRCLE.OUT';

mangsnt:array[3 43] of byte =

(1,0,1,0,1,0,0,0,1,0,1,0,0,0,1,0,1,0,0,0,1,0,0,0,0,0,1,0,1,0,0,0,0,0,1,0,0,0,1,0,1); type mang=array[1 20] of byte;

mang1=array[1 20] of boolean;

var n:byte;

a:mang;

b:mang1;

f1:text;

dem,dem1:longint;

s:string;

i:integer;

procedure docf;

var f:text;

n1:byte;

begin

assign(f,fi);

reset(f);

readln(f,n1);

n:=n1*2;

close(f);

end;

procedure try(i1:integer);

var j:integer;

begin

if i1>n then

if (mangsnt[a[n]+a[1]]=1) then

begin

inc(dem1);

for i:=1 to n do

write(f1,a[i],' ');

writeln(f1);

end;

for j:=2 to n do

if (mangsnt[j+a[i1-1]]=1) and (b[j]=false) then begin

a[i1]:=j;

b[j]:=true;

try(i1+1);

b[j]:=false;

end;

end;

procedure xuly;

var k,i:integer;

begin

assign(f1,fo);

rewrite(f1);

dem1:=0;

a[1]:=1;

b[1]:=true;

try(2);

writeln(f1,dem1);

close(f1);

end;

begin

docf;

fillchar(b,sizeof(b),false);

dem:=0;

xuly;

end