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

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.