Cod sursa(job #694340)

Utilizator teban.mihaiTeban Mihai Andrei teban.mihai Data 27 februarie 2012 20:01:30
Problema Numarare triunghiuri Scor 30
Compilator fpc Status done
Runda Arhiva de probleme Marime 0.82 kb
var i,j,k,nr,n,max:word;
    a:array[1..802] of word;
    f,g:text;

procedure Sort(l, r: word);
var
  i, j, k:word;
begin
  i := l;
  j := r;
  k:=a[i];
  while (i<j) do
  begin
    while (i<j) and (a[j]>=k) do
      dec(j);
    a[i]:=a[j];
    while (i<j) and (a[i]<=k) do
      inc(i);
    a[j]:=a[i];
  end;
  a[i]:=k;
  if (l<i-1) then
    sort(l,i-1);
  if (i+1<r) then
    sort(i+1,r);
  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,a[i]);
  nr:=0;
  sort(1,n);
  for i:=1 to n-2 do
    for j:=i+1 to n-1 do
      for k:=j+1 to n do
        if (a[i]+a[j]>=a[k]) then
          inc(nr)
        else
          if (a[i]+a[j]<a[k]) then
            break;
  writeln(g,nr);
  close(f);
  close(g);
end.