Cod sursa(job #688047)

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

procedure Sort(l, r: Integer);
var
  i, j, x, y: integer;
begin
  i := l; j := r; x := a[(l+r) DIV 2];
  repeat
    while a[i] < x do i := i + 1;
    while x < a[j] do j := j - 1;
    if i <= j then
    begin
      y := a[i]; a[i] := a[j]; a[j] := y;
      i := i + 1; j := j - 1;
    end;
  until i > j;
  if l < j then Sort(l, j);
  if i < r then Sort(i, 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.