Pagini recente » Cod sursa (job #1788083) | Cod sursa (job #1503594) | Cod sursa (job #2159950) | Cod sursa (job #734612) | Cod sursa (job #33889)
Cod sursa(job #33889)
type vect = array[1..802] of integer;
var fi,fo:text;
i,j,n,x,y,z,t,step:integer;
a:vect;
ntri:longint;
function part(st,dr:integer):integer;
var p,i,j,aux:integer;
sens:integer;
begin
p := st + random(dr-st+1);
aux:=a[st];
a[st]:=a[p];
a[p]:=aux;
i:=st; j:=dr; sens:=-1;
while i<j do
begin
if a[i]>a[j] then
begin
aux:=a[i];
a[i]:=a[j];
a[j]:=aux;
sens:=-sens;
end;
if sens=1 then inc(i)
else dec(j);
end;
part:=i;
end;
procedure qsort(st,dr:integer);
var p:longint;
begin
if st<dr then
begin
p:=part(st,dr);
qsort(st,p-1);
qsort(p+1,dr);
end;
end;
function binar(i,j:integer):integer;
var z,x,y:integer;
begin
z:=a[i]+a[j];
t:=j;
step:=1;
while step<=n do
begin
step:=step shl 1;
end;
while (step<>0) do
begin
step:=step shr 1;
if (t+step<=n) and (a[t+step]<=z) then t:=t+step;
end;
binar:=t-j;
end;
begin
assign(fi,'nrtri.in'); reset(fi);
assign(fo,'nrtri.out'); rewrite(fo);
readln(fi,n);
for i:=1 to n do
begin
read(fi,a[i]);
end;
qsort(1,n);
for i:=1 to n-1 do
for j:=i+1 to n do
ntri:=ntri+binar(i,j);
write(fo,ntri);
close(fo);
end.