Cod sursa(job #33850)

Utilizator floringh06Florin Ghesu floringh06 Data 19 martie 2007 21:09:28
Problema Numarare triunghiuri Scor 45
Compilator fpc Status done
Runda Arhiva de probleme Marime 1.39 kb

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

var fi,fo:text;
    i,j,n,x,y,z,t,step:integer;
    a:vect;
    ntri:qword;
   function part(st,dr:integer):integer;
   var p,i,j,aux:integer;
       sens:integer;
    begin

      p := st + random(dr-st+1);
      aux:=a[st];
      a[st]:=a[p];
      a[p]:=aux;

      i:=st; j:=dr; sens:=-1;
      while i<j do
        begin
          if a[i]>a[j] then
           begin
            aux:=a[i];
            a[i]:=a[j];
            a[j]:=aux;
            sens:=-sens;
           end;
           if sens=1 then inc(i)
               else dec(j);
        end;
      part:=i;
   end;
 procedure qsort(st,dr:integer);
   var p:longint;
   begin
     if st<dr then
       begin
        p:=part(st,dr);
        qsort(st,p-1);
        qsort(p+1,dr);
       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 t:=t+step;
       end;
      ntri:=ntri+t-j
    end;
write(fo,ntri);
close(fo);
end.