Cod sursa(job #141967)

Utilizator antoanelaAntoanela Siminiuc antoanela Data 23 februarie 2008 22:43:51
Problema Numarare triunghiuri Scor 80
Compilator fpc Status done
Runda Arhiva de probleme Marime 0.98 kb
program numarare_triunghiuri;
var f,g:text;
    v:array[1..800]of 0..30000;
    n,i,j,y,c,k: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
      y:=j+1;
      while (v[y]<=v[i]+v[j])do
        begin
          inc(c);
          if (y=n)then break;
          inc(y);
        end;
    end;
write(g,c);
close(f);
close(g);
end.