Cod sursa(job #227166)

Utilizator FllorynMitu Florin Danut Flloryn Data 3 decembrie 2008 21:09:06
Problema Numarare triunghiuri Scor 0
Compilator fpc Status done
Runda Arhiva de probleme Marime 1.41 kb
program pascal;
var f,g:text;
    v:array[1..800] of integer;
    n,i,j,mij,t,r,l:integer; nr:longint;
  procedure quicksort(s,d:integer);
  var a,b,aux,ia:integer;
  begin
     a:=s; b:=d;
     repeat
     while v[a]<v[b] do b:=b-1;
     aux:=v[a];
     v[a]:=v[b];
     v[b]:=aux;
     ia:=1; a:=a+1;
     if a<b then
          begin
           while v[a]<v[b] do a:=a+1;
           if a<>b then
             begin
              aux:=v[a];
              v[a]:=v[b];
              v[b]:=aux;
              ia:=0;
              b:=b-1;
             end;
           end;
   until a>=b;
   if s<a-ia then quicksort(s,a-ia);
   if a-ia+1<d then quicksort(a-ia+1,d);
  end;

  function caut(x,y:integer):integer;
  begin
   if x>y then
        begin
            caut:=mij;
            if v[mij]>t then caut:=caut-1;
        end
   else
   begin
   mij:=(x+y) div 2;
   if v[mij]=t then
          begin
              caut:=mij;
          end
        else
         if t>v[mij] then caut:=caut(mij+1,y)
                     else caut:=caut(x,mij-1);
   end;
  end;

begin
assign(f,'nrtri.in'); reset(f);
assign(g,'nrtri.out'); rewrite(g);
readln(f,n);
for i:=1 to n do read(f,v[i]);
quicksort(1,n);
nr:=0;
for i:=1 to n-3 do
   for j:=n downto i+2 do
     begin
     t:=v[j]-v[i];
     r:=caut(i,j);
     if r-i>-1 then  nr:=nr+r-i;
     end;

write(g,nr);
close(f);
close(g);
end.