# Cod sursa(job #20435)

Utilizator Data 21 februarie 2007 15:06:48 Numarare triunghiuri 0 fpc done Arhiva de probleme 1.65 kb
program numtri;
var v:Array[1..800]of integer;
n,i,j,x,p:integer;
g:text;
procedure citire;
var f:text;
begin
assign(f,'nrtri.in'); reset(f);
for i:=1 to n do read(f,v[i]);
close(f);
end;
procedure quicksort(s,d:integer);
var i,j,e,aux:integer;
begin
i:=s;
j:=d;
e:=v[(i+j)div 2];
repeat
while v[i]<e do inc(i);
while v[j]>e do dec(j);
if i<=j then
begin
aux:=v[i];
v[i]:=v[j];
v[j]:=aux;
inc(i);
dec(j);
end;
until i>j;
if i<d then quicksort(i,d);
if j>s then quicksort(s,j);
end;
function search(x:integer):integer;
var e,s,d,pozitie:integer;
ok:boolean;
begin
search:=0;
pozitie:=0;
s:=j+1;
d:=n;
ok:=true;

while (s<=d)and ok do
begin
e:=(s+d)div 2;
if x=v[e] then begin
pozitie:=e; ok:=false; end
else if x>v[e] then begin
pozitie:=e;
s:=e+1;
end

else
begin
d:=e-1;
pozitie:=e;
end;
end;
if v[pozitie]>x then dec(pozitie);
if (pozitie<1)or(pozitie<j+1)or(pozitie>n)or(v[pozitie]>x) then search:=0
else search:=pozitie;
end;
begin {pp}
citire;
quicksort(1,n);
writeln('solutii wrong');
for i:=1 to n-2 do
for j:=i+1 to n-1 do
begin
p:=search(v[i]+v[j]);
if p<>0 then begin
x:=x+(p-j);
writeln(v[i],' ',v[j],' ',v[p]);
end;
end;
assign(g,'nrtri.out');rewrite(g);
write(g,x);
close(g);
end.