Cod sursa(job #177615)

Utilizator tamas_iuliaTamas Iulia tamas_iulia Data 13 aprilie 2008 13:07:44
Problema Numarare triunghiuri Scor 100
Compilator fpc Status done
Runda Arhiva de probleme Marime 1.08 kb
var a : array[0..801] of longint;
    i,j,n,k,p,nr,aux : longint;
    f,g : text;
procedure caut_bin(x,l,r : longint);
var m : longint;
begin
  if l>r then
  begin
    if p=0 then p:=-1
  end
  else
  begin
    m:=(l+r)div 2;
      if a[m]<=x then
      begin
        p:=m;
        caut_bin(x,m+1,r);
      end
      else
        caut_bin(x,l,m-1);
  end;
end;
procedure sort(l,r : integer);
var i,j,x,y : integer;
begin
     i:=l; j:=r; x:=a[(l+r)div 2];
     repeat
           while (a[i]<x) do inc(i);
           while (x<a[j]) do dec(j);
           if i<=j then
           begin
                aux:=a[i];a[i]:=a[j];a[j]:=aux;
                inc(i); dec(j);
           end;
     until i>j;
     if l<j then sort(l,j);
     if i<r then sort(i,r);
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]);
sort(1,n);
for i:=1 to n-2 do
  for j:=i+1 to n-1 do
  begin
    p:=0;
    caut_bin(a[i]+a[j],1,n);
      if p<>-1 then
        inc(nr,p-j);
  end;
writeln(g,nr);
close(g);
end.