Cod sursa(job #113413)

Utilizator info_arrandrei gigea info_arr Data 9 decembrie 2007 22:19:41
Problema Numarare triunghiuri Scor 100
Compilator fpc Status done
Runda Arhiva de probleme Marime 1.26 kb
type vect = array[1..802] of longint;

var fi,fo:text;
    i,j,n,t,step:longint;
    a:vect;
    ct:int64;

 function part(st,dr:longint):longint;
   var i,j,aux:longint;
       sens:integer;
    begin
      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 sort(st,dr:longint);
   var p:longint;
   begin
     if st<dr then
       begin
        p:=part(st,dr); sort(st,p-1); sort(p+1,dr);
       end;
   end;


  function binar(i,j:longint):longint;
   var z:longint;
    begin
    // initializari
    z:=a[i]+a[j]; t:=j; step:=1;
    while step<=n do step:=step shl 1;
    while (step<>0) do
       begin
         if (t+step<=n) and (a[t+step]<=z) then t:=t+step;
         step:=step shr 1;
       end;
     binar:=t-j;
   end;



begin
 ct:=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]);
 sort(1,n);
 ct := 0;
 for i:=1 to n-1 do
  for j:=i+1 to n do
      ct:=ct+binar(i,j);
 writeln(fo,ct);
 close(fi);
 close(fo);
end.