Cod sursa(job #1108403)

Utilizator DjokValeriu Motroi Djok Data 15 februarie 2014 17:20:49
Problema Numarare triunghiuri Scor 0
Compilator fpc Status done
Runda Arhiva de probleme Marime 1.62 kb
var i,j,x,k,n,boom:longint;
    a:array[1..802] of longint;
    buf1,buf2:array[1..1 shl 16] of char;

    procedure swap(var a,b:longint);
     var aux:longint;
      begin
       aux:=a;
       a:=b;
       b:=aux;
      end;

    procedure qsort(left,right:longint);
      var i,j,pivot:longint;
       begin
        i:=left; j:=right; pivot:=a[((left+right) div 2)+1];
         repeat
          while a[i]<pivot do inc(i);
          while a[j]>pivot do dec(j);
           if i<=j then begin
                         swap(a[i],a[j]);
                         inc(i);
                         dec(j);
                        end;

         until i>j;
          if i<right then qsort(i,right);
          if j>left then qsort(left,j);
       end;


    procedure bs(x,y:longint);
     var i,j,pivot:longint;
      begin
       i:=x; j:=y;
        while i<j do
         begin
          pivot:=(i+j) div 2;
           if a[i]+a[j]>=a[pivot] then begin
                                        boom:=pivot;
                                        i:=pivot+1;
                                       end
                                  else j:=pivot-1;
         end;

      end;




begin
assign(input,'nrtri.in');
assign(output,'nrtri.out');
reset(input);
rewrite(output);
settextbuf(input,buf1);
settextbuf(output,buf2);
  readln(n);
   for x:=1 to n do
    read(a[x]);

  qsort(1,n);

   for i:=1 to n-2 do
    for j:=i+1 to n-1 do
      begin
      bs(i,j);
      inc(k,boom);
      end;

                   writeln(k);



close(input);
close(output);
{Totusi este trist in lume}
end.