Cod sursa(job #457201)

Utilizator gramatovici_paulGramatovici Paul gramatovici_paul Data 18 mai 2010 16:37:15
Problema Numarare triunghiuri Scor 0
Compilator fpc Status done
Runda Arhiva de probleme Marime 1.47 kb
var aux,i,n,j,s,d,k,p,u,m:longint;
    a:array[1..800] of longint;
{procedure sort(l,r:longint);
var i,j,x,aux:longint;
 begin
 if l<r then
  begin
    x:=a[(l+r) div 2];
    i:=l;
    j:=r;
    repeat
      while (i<=n) and (a[i]<x) do inc(i);
      while (j>0) and (a[j]>x) 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 i>l then sort(l+1,i);
    if j<r then sort(j,r-1);
  end;
end;              }
begin
  assign(input,'nrtri.in');
  assign(output,'nrtri.out');
  reset(input);
  rewrite(output);
  readln(n);
  for i:=1 to n do
     read(a[i]);
  //sort(1,n);
  for i:=1 to n-1 do
     for j:=i+1 to n do
        if a[i]>a[j] then
          begin
            aux:=a[i];
            a[i]:=a[j];
            a[j]:=aux;
          end;
  for i:=1 to n do
    for j:=i+1 to n do
      begin
        s:=a[i]+a[j];
        d:=a[j]-a[i];
        p:=1; u:=n;
        while p<=u do
          begin
            m:=(p+u) div 2;
            if a[m]<=s then
               p:=m+1
            else
               u:=m-1;
          end;
        k:=k+u;
        p:=1; u:=n;
        while p<=u do
          begin
            m:=(p+u) div 2;
            if a[m]>=d then
               p:=m+1
            else
               u:=m-1;
          end;
        k:=k-p+1;
      end;
  writeln(k div 3);
  close(output);
end.