Cod sursa(job #59543)

Utilizator radu_voroneanuVoroneanu Radu Stefan radu_voroneanu Data 9 mai 2007 18:08:13
Problema Numarare triunghiuri Scor 100
Compilator fpc Status done
Runda Arhiva de probleme Marime 0.88 kb
var a:array[1..1000] of longint;
    f,g:text;
    n,i,j,nr,w:longint;
procedure buble;
 var i,j,aux:longint;
 begin
  for i:=1 to n do
   for j:=i+1 to n do
    if a[i]>a[j] then begin
     aux:=a[j];
     a[j]:=a[i];
     a[i]:=aux;
    end;
 end;
function cauta(x,st,dr:longint):longint;
 var mij:longint;
 begin
  if st>dr then
   cauta:=0
  else begin
   mij:=(st+dr) div 2;
   if (a[mij]<=x) and ((a[mij+1]>x) or (mij=n)) then
    cauta:=mij
   else
    if a[mij]>x then
     cauta:=cauta(x,st,mij-1)
    else
     cauta:=cauta(x,mij+1,dr);
  end;
 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]);
 buble;
 nr:=0;
 for i:=1 to n-1 do
  for j:=i+1 to n do begin
   w:=cauta(a[i]+a[j],1,n);
   if w-j>0 then
    inc(nr,w-j);
  end;
 writeln(g,nr);
 close(f); close(g);
end.