Cod sursa(job #33087)

Utilizator floringh06Florin Ghesu floringh06 Data 18 martie 2007 21:50:43
Problema Numarare triunghiuri Scor 45
Compilator fpc Status done
Runda Arhiva de probleme Marime 1.69 kb

type vect = array[1..803] of integer;

var fi,fo:text;
    i,j,n,x,y,z,mj,st,dr:integer;
    a:vect;
    gasit:boolean;
    ntri:longint;

 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
 ntri:=0;
 assign(fi,'nrtri.in'); reset(fi);
 assign(fo,'nrtri.out'); rewrite(fo);
 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
   begin
    x:=a[i];
    y:=a[j];
    st:=j+1;
    dr:=n;
    z:=x+y;
    gasit:=false;
    while st<=dr do
     begin
      mj:=(st+dr) div 2;
      if z<a[mj] then dr:=mj-1;
      if z>a[mj] then st:=mj+1;
      if z=a[mj] then break;
     end;
    while gasit=false do
    begin
     if   z<a[mj] then
      dec(mj);
     if a[mj]=z then
      begin
       while a[mj]=z do
        inc(mj);
        dec(mj);
      end;
     if mj<=n-1 then
     if (z>=a[mj]) and (z<a[mj+1]) then gasit:=true;
     if mj=n then gasit:=true;
    end;
    if mj>=j then inc(ntri,mj-j);
 //   writeln(fo,a[i],' ',a[j],' ',mj-j);
   end;
writeln(fo,ntri);
close(fo);
end.