Cod sursa(job #145958)

Utilizator antoanelaAntoanela Siminiuc antoanela Data 29 februarie 2008 19:39:01
Problema Numarare triunghiuri Scor 0
Compilator fpc Status done
Runda Arhiva de probleme Marime 1.28 kb
program numarare_triunghiuri;
var f,g:text;
    v:array[1..800]of 0..30000;
    n,i,j,a,b,k,c,ca,cb: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;

procedure caut(a,b:longint);
var ca,cb:longint;
begin
  k:=a-b;
  ca:=a;
  cb:=b;
  while (a<=b)do
    begin
      k:=a+(k div 2);
      if (v[k]<v[i]+v[j])then a:=k+1 else
      if (v[k]>v[i]+v[j])then b:=k-1 else
      if (v[k]=v[i]+v[j])then break;
      if (b=cb)and(a=ca)then
        break;
      ca:=a;
      cb:=b;
    end;
  if (v[k]>v[i]+v[j])then dec(k);
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
      caut(j+1,n);
      if (k>j)then inc(c);
    end;
write(g,c);
close(f);
close(g);
end.