Cod sursa(job #848758)

Utilizator akaprosAna Kapros akapros Data 5 ianuarie 2013 19:02:16
Problema Numarare triunghiuri Scor 20
Compilator fpc Status done
Runda Arhiva de probleme Marime 1.16 kb
program nrtri;
type vector=array[1..800] of integer;
var n,i,j,k,m,s,d,nr,suma:integer;
    a:vector;
    f,g:text;
procedure poz (li,ls:integer;
               var k:integer;
               var a:vector);
var i,j,c,i1,j1:integer;
begin
i1:=0;
j1:=-1;
i:=li;
j:=ls;
while i<j do begin
if a[i]>a[j] then begin
                  c:=a[j];
                  a[j]:=a[i];
                  a[i]:=c;
                  c:=i1;
                  i1:=-j1;
                  j1:=-c;
                  end;
                  i:=i+i1;
                  j:=j+j1;
                  end;
k:=i;
end;
procedure quick(li,ls:integer);
begin
if li<ls then begin
              poz(li,ls,k,a);
              quick(li,k-1);
              quick(k+1,ls);
              end
end;
begin
assign(f,'nrtri.in');
reset(f);
assign(g,'nrtri.out');
rewrite(g);
read(f,n);
for i:=1 to n do read(f,a[i]);
quick(1,n);
for i:=1 to n-2 do
for j:=i+1 to n do begin
s:=j;
d:=n+1;
suma:=a[i]+a[j];
while d-s>1 do begin
m:=(s+d) div 2;
if a[m]<=suma then s:=m
              else d:=m;
end;
if a[s]<=suma then nr:=nr+s-j;
end;
write(g,nr);
close(f);
close(g);
end.