Cod sursa(job #1654857)

Utilizator laura.calimanLaura Caliman laura.caliman Data 17 martie 2016 16:01:14
Problema Numarare triunghiuri Scor 100
Compilator fpc Status done
Runda Arhiva de probleme Marime 1.09 kb
var n,i,j,k:longint;
    a:array[1..800] of longint;
    
procedure sw(var a,b:longint);
var c:longint;
begin
  c:=a;
  a:=b;
  b:=c;
end;

procedure qs(st,dr:longint);
var i,j,m:longint;
begin
  i:=st;
  j:=dr;
  m:=a[(i+j) div 2];
  while i<j do begin
    while a[i]<m do inc(i);
    while a[j]>m do dec(j);
    if i<=j then begin
      sw(a[i],a[j]);
      inc(i); dec(j);
    end;
  end;
  if i<dr then qs(i,dr);
  if st<j then qs(st,j);
end;
    
function triunghi(st,dr,s:longint):longint;
var m:longint;
begin
  if st=dr then begin
    if a[st]<=s then triunghi:=st
    else triunghi:=st-1;
  end else begin
    m:=(st+dr) div 2;
    if s>=a[m] then triunghi:=triunghi(m+1,dr,s)
    else triunghi:=triunghi(st,m,s);
  end;
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);
  k:=0;
//  for i:=1 to n do write(a[i],' ');
  for i:=1 to n-2 do
    for j:=i+1 to n-1 do begin
      k:=k+triunghi(j,n,a[i]+a[j])-j;
    end;
  writeln(k);
end.