# Cod sursa(job #20739)

Utilizator Data 21 februarie 2007 23:30:14 Numarare triunghiuri 50 fpc done Arhiva de probleme 1.87 kb
``````Var
db:longint;
i,j,a,b,c,k:word;
n:word;
et,v:array[-1..801] of 0..30000;
f:text;
kesz,jo:boolean;
Function szetvalogat(e,u:word):word;
var seged:integer;
begin
seged:=et[e];
while e<u do begin
while (e<u) and (et[u]>=seged) do
dec(u);
if e<u then begin
et[e]:=et[u];
inc(e);
while (e<u) and (et[e]<seged) do
inc(e);
et[u]:=et[e];
dec(u);
end;
end;
et[e]:=seged;
szetvalogat:=e;
end;
procedure gyors(ah,fh:integer);
var k:integer;
begin
if ah<fh then begin
k:=szetvalogat(ah,fh);
gyors(ah,k-1);
gyors(k+1,fh);
end;
end;
{function binker(e,u:integer):integer;
var k:integer;
begin
if e>u then binker:=0
else begin
k:=(e+u) div 2;
if (et[k]<=a+b) and then binker:=k
else
if mit<et[k] then binker:=binker(e,k-1,mit)
else binker:=binker(k+1,u,mit);
end;
end;               }
function binker(e,u:integer):integer;
var k:integer;
begin
if e>u then binker:=0
else begin
k:=(e+u) div 2;
c:=et[k];

if e=u then begin
if (a+b>=c)and(a+c>=b)and(b+c>=a) then binker:=e
else binker:=0;
end
else

if (a+b>=c)and(a+c>=b)and(b+c>=a) then begin
if (a+b>=et[k-1])and(a+et[k-1]>=b)and(b+et[k-1]>=a) then binker:=binker(e,k-1)
else binker:=k;
end
else if (a+b>=et[k+1])and(a+et[k+1]>=b)and(b+et[k+1]>=a)then binker:=k+1
else binker:=binker(k+1,u);

end;
end;

begin
Assign(f,'nrtri.in');
reset(f);
for i:=1 to n do
close(f);
gyors(1,n);
db:=0;
i:=n;
while i>2 do begin
a:=et[i];
j:=i-1;
while j>1 do begin
b:=et[j];
k:=binker(1,j-1);
if k<>0 then db:=db+(j-k);
j:=j-1;
end;
i:=i-1;
end;
assign(f,'nrtri.out');
rewrite(f);
writeln(f,db);
close(f)
end.``````