Cod sursa(job #148519)

Utilizator antoanelaAntoanela Siminiuc antoanela Data 4 martie 2008 14:12:19
Problema Numarare triunghiuri Scor 100
Compilator fpc Status done
Runda Arhiva de probleme Marime 1.44 kb
program numarare_triunghiuri;
var f,g:text;
    v:array[1..800]of 0..30000;
    x,n,i,j,a,b,k,c,ca,cb,y:longint;

function poz(li,ls:longint):longint;
var i,j,modi,modj,m,man:longint;
begin
i:=li;
j:=ls;
modi:=0;
modj:=-1;
while (i<=j)do
  begin
    if (v[i]>v[j])then
      begin
        man:=v[i];
        v[i]:=v[j];
        v[j]:=man;
        m:=modi;
        modi:=-modj;
        modj:=-m;
      end;
    i:=i+modi;
    j:=j+modj;
  end;
poz:=i;
end;

procedure quick(li,ls:longint);
begin
if (li<ls)then
  begin
    k:=poz(li,ls);
    quick(li,k-1);
    quick(k+1,ls);
  end;
end;

begin
assign(f,'nrtri.in');
assign(g,'nrtri.out');
reset(f);
rewrite(g);
read(f,n);
for i:=1 to n do read(f,v[i]);
quick(1,n);
c:=0;
for i:=1 to n-2 do
  for j:=i+1 to n-1 do
    begin
      a:=j+1;
      b:=n;
      ca:=a;
      cb:=b;
      while (a<=b)do
        begin
          if ((a+b) div 2>n)then break;
          x:=(a+b) div 2;
          if (v[x]<v[i]+v[j])then a:=x+1 else
          if (v[x]>v[i]+v[j])then b:=x-1 else
          if (v[x]=v[i]+v[j])then break;
          {if (b=cb)and(a=ca)then break;
          ca:=a;
          cb:=b; }
        end;
      if (v[x]>v[i]+v[j])then dec(x);
      y:=x+1;
      while (v[y]=v[x])do
        begin
          inc(y);
          if (y>n)then break;
        end;
      x:=y-1;
      if (x>j)then inc(c,x-j);
    end;
write(g,c);
close(f);
close(g);
end.