Cod sursa(job #15196)

Utilizator icetTamas Radu icet Data 11 februarie 2007 02:19:03
Problema Numarare triunghiuri Scor 0
Compilator fpc Status done
Runda Arhiva de probleme Marime 1 kb
 program triunghiuri;
 type vect = array[0..800] of integer;
 var a,b: vect;
     i,j,n: integer;
     sol: longint;
     f: text;

 procedure quick(s,d: integer);
 var i,j,aux,e: integer;
 begin
  i:=s; j:=d; e:=a[(i+j) div 2];

  repeat

   while a[i] > e do inc(i);
   while a[j] < e do dec(j);

   if i<=j then begin
     aux := a[i];
     a[i]:=a[j];
     a[j]:=aux;
     inc(i); dec(j);
   end;

  until i>j;

   if s<j then Quick(s,j);
   if d>i then Quick(i,d);

 end;

 function caut(s,d: integer): integer;
 begin

   if a[i] + a[i+1] >= a[(s+d) div 2] then caut := (s+d) div 2
   else
     if s<d then
       if a[i] + a[i+1] < a[(s+d) div 2] then caut((s+d) div 2+1,d);

 end;


 begin
   assign(f,'nrtri.in'); reset(f);
    readln(f,n);
    for i:=1 to n do read(f,a[i]);
   Close(f);

   Quick(1,n);

   sol:=0;

   for i:=1 to n-1 do
      inc(sol,caut(i+2,n)-(i+1));

   assign(f,'nrtri.out'); rewrite(f);
     write(f,sol);
   Close(f);

 end.