Cod sursa(job #33832)

Utilizator floringh06Florin Ghesu floringh06 Data 19 martie 2007 20:49:46
Problema Numarare triunghiuri Scor 45
Compilator fpc Status done
Runda Arhiva de probleme Marime 1.55 kb

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

var fi,fo:text;
    i,j,n,x,y,z,t,step:integer;
    a:vect;
    ntri:longint;

  procedure part(left,right:integer; var stst,stdr,drst,drdr:integer);
   var piv:integer;
       i,j:integer;
       aux:integer;
     begin
      piv:=a[(left+right) div 2];
      i:=left-1;
      j:=right+1;
      while i<j do
        begin
          repeat inc(i); until a[i]>=piv;
          repeat dec(j); until a[j]<=piv;
         if i<j then
          begin
            aux:=a[i];
            a[i]:=a[j];
            a[j]:=aux;
          end;
        end;
        stst:=left; drdr:=right;
        if i=j then begin stdr:=j-1; drst:=i+1; end
          else begin stdr:=j; drst:=i; end;
     end;

 procedure qsort(left,right:integer);
   var stst,stdr,drst,drdr:integer;
    begin
     if left<right then
      begin
       part(left,right,stst,stdr,drst,drdr);
       qsort(stst,stdr);
       qsort(drst,drdr);
      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
  begin
   read(fi,a[i]);
  end;
 qsort(1,n);
 for i:=1 to n-1 do
  for j:=i+1 to n do
   begin
    x:=a[i];
    y:=a[j];
    z:=x+y;
    t:=j;
    step:=1;
    while step<=n do
     begin
      step:=step shl 1;
     end;
    while (step<>0) do
       begin
         step:=step shr 1;
         if (t+step<=n) and (a[t+step]<=z) then inc(t,step);
       end;
    inc(ntri,t-j);
  end;
writeln(fo,ntri);
close(fo);
end.