Cod sursa(job #1213880)

Utilizator valen.valentinValentin Valeanu valen.valentin Data 29 iulie 2014 09:11:25
Problema Numarare triunghiuri Scor 100
Compilator fpc Status done
Runda Arhiva de probleme Marime 0.97 kb
program nrtri;
type
tabel=array [0..801] of integer;
var
v,c:tabel;
n,i,j,k,l,nr,s:longint;
f1,f2:text;
procedure interclaseaza(s,m,d:longint);
var k,i,j:longint;
begin
i:=s;j:=m+1;k:=0;
while (i<=m)and(j<=d) do
if v[i]<v[j] then begin inc(k);c[k]:=v[i];inc(i); end
else begin inc(k);c[k]:=v[j];inc(j); end;
while (i<=m) do begin inc(k);c[k]:=v[i];inc(i); end;
while (j<=d) do begin inc(k);c[k]:=v[j];inc(j); end;
k:=0;
for i:=s to d do
begin
inc(k);v[i]:=c[k];
end;
end;
procedure mergesort(s,d:longint);
var m:longint;
begin
if s<d then
begin
m:=(s+d) div 2;
mergesort(s,m);
mergesort(m+1,d);
interclaseaza(s,m,d);
end;
end;
begin
assign (f1,'nrtri.in');
assign (f2,'nrtri.out');
reset (f1);
rewrite (f2);
readln (f1,n);
for i:=1 to n do read (f1,v[i]);
mergesort(1,n);
for k:=1 to n-1 do
for j:=k+1 to n do
begin
s:=v[k]+v[j];
for i:=j+1 to n do
if s>=v[i] then nr:=nr+1 else
break;
end;
writeln (f2,nr);
close (f1);
close (f2);
end.