Cod sursa(job #1096263)

Utilizator laura.calimanLaura Caliman laura.caliman Data 1 februarie 2014 19:31:45
Problema Numarare triunghiuri Scor 50
Compilator fpc Status done
Runda Arhiva de probleme Marime 1.03 kb
var n,i,j,l,m:longint;
    a:array[1..100000] of longint;

procedure sw(var x,y:longint);
var t:longint;
begin
  t:=x;
  x:=y;
  y:=t;
end;

procedure qs(i,j:longint);
var s,d,m:longint;
begin
  s:=i;
  d:=j;
  m:=a[(s+d) div 2];
  while s<d do begin
    while a[s]<m do inc(s);
    while a[d]>m do dec(d);
    if s<=d then begin
      sw(a[s],a[d]);
      inc(s);
      dec(d);
    end;
    if s<j then qs(s,j);
    if i<d then qs(i,d);
  end;
end;
    
function bin(x,y,sum:longint):longint;
var m,s,d:longint;
begin
  s:=x;
  d:=y;
  while s<d do begin
    m:=(s+d) div 2; 
    if sum>a[m] then
      s:=m+1
    else
      d:=m;
  end;
  if a[s]<=sum then
    bin:=s
  else
    bin:=s-1;
end;
    
begin
  assign(input,'nrtri.in');
  assign(output,'nrtri.out');
  reset(input);
  rewrite(output);
  read(n);
  for i:=1 to n do 
    read(a[i]);
  
  qs(1,n);
  
  for i:=1 to n-2 do
    for j:=i+1 to n-1 do begin
      l:=bin(j,n,a[i]+a[j]);
      m:=m+l-j;
    end;  
  writeln(m);
end.