Cod sursa(job #33030)

Utilizator floringh06Florin Ghesu floringh06 Data 18 martie 2007 20:38:40
Problema Numarare triunghiuri Scor 70
Compilator fpc Status done
Runda Arhiva de probleme Marime 1.04 kb
var fi,fo:text;
    i,j,n,k:integer;
    rez:int64;
    a:array[1..800] of integer;

  procedure heapsort(n:integer);
  var aux,k:integer;
  begin
   for i:=1 to n do
    begin
     j:=i;
     while (j div 2<>0) and (a[j div 2]<a[j]) do
      begin
        aux:=a[j div 2];
        a[j div 2]:=a[j];
        a[j]:=aux;
        j:=j div 2;
      end;
    end;
   i:=n;
   while i>1 do
    begin
     aux:=a[1];
     a[1]:=a[i];
     a[i]:=aux;
     dec(i);
     j:=1;
     while (1>0) do
      begin
       k:=2*j;
       if (k>i) then  break;
       if (k+1<=i) and (a[k+1]>a[k]) then inc(k);
       if a[j]>=a[k] then break;

       aux:=a[j];
       a[j]:=a[k];
       a[k]:=aux;
       j:=k;
      end;
     end;
  end;

begin
 assign(fi,'nrtri.in'); reset(fi);
 assign(fo,'nrtri.out'); rewrite(fo);
 rez:=0;
 readln(fi,n);
 for i:=1 to n do
  read(fi,a[i]);
 heapsort(n);
 for i:=1 to n-2 do
  for j:=i+1 to n-1 do
   for k:=j+1 to n do
     if a[i]+a[j]>=a[k] then inc(rez);
 writeln(fo,rez);
close(fo);
end.