Cod sursa(job #1213575)

Utilizator RusuAlexeiRusu Alexei RusuAlexei Data 28 iulie 2014 15:44:18
Problema Numarare triunghiuri Scor 0
Compilator fpc Status done
Runda Arhiva de probleme Marime 1.66 kb
program betisoare;
  var n,i,j,l,r,ans:longint;
      a:array[1..800] of longint;

procedure sort(l,r:longint);
  var i,j,x,y:longint;
  begin
    x:=(l+r)div 2;
    i:=l;j:=r;
    while i<=j do
      begin
        while a[i]<a[x] do inc(i);
        while a[j]>a[x] do dec(j);
        if i<=j then
          begin
            y:=a[i];
            a[i]:=a[j];
            a[j]:=y;
            inc(i);
            dec(j);
          end;


      end;
    if j>l then sort(l,j);
    if i<r then sort(i,r);
  end;

function cbin(l,r,val:longint):longint;
  var m:longint;
  begin
    if l=r then cbin:=l else
      begin
        m:=(l+r)div 2;
        if a[m]>=val then cbin:=cbin(l,m,val)
                     else cbin:=cbin(m+1,r,val);
      end;

  end;

function cbin2(l,r,val:longint):longint;
  var m:longint;
  begin
    if l=r then cbin2:=l else
      begin
        m:=(l+r)div 2;
        if a[m+1]<=val then cbin2:=cbin2(m+1,r,val)
                       else cbin2:=cbin2(l,m,val);
      end;

  end;

begin
  assign(input,'nrtri.in');
  reset(input);
  assign(output,'nrtri.out');
  rewrite(output);

  readln(n);
  for i:=1 to n do read(a[i]);

  sort(1,n);

  for i:=1 to n do
    for j:=i+1 to n do
      if i<>j then
        begin
          if a[1]>=abs(a[i]-a[j]) then l:=1 else l:=cbin(1,n,abs(a[i]-a[j]));
          if a[n]<=a[i]+a[j] then r:=n else r:=cbin2(1,n,a[i]+a[j]);
          while (l=i)or(l=j) do inc(l);
          while (r=i)or(r=j) do dec(r);
          if l<j then l:=j+1;
          if l<i then l:=i+1;
          if l<=r then ans:=ans+r+1-l;
        end;
  writeln(ans);
  close(output);
end.