Cod sursa(job #113221)

Utilizator RobybrasovRobert Hangu Robybrasov Data 9 decembrie 2007 11:43:52
Problema Numarare triunghiuri Scor 80
Compilator fpc Status done
Runda Arhiva de probleme Marime 1.16 kb
var v:array[1..801] of integer;
    i,j,n:integer;
    kont:longint;
    f:text;

procedure cit_sort;
var i,j,val,ls,k:integer;
begin
  read(f,v[1]);
  read(f,val);
  if val>v[1] then v[2]:=val
  else begin v[2]:=v[1]; v[1]:=val; end;
  ls:=2;
  for i:=1 to n-2 do
    begin
      read(f,val);
      j:=1;
      while (val>=v[j]) and (j<=ls) do inc(j);
      if j>ls then begin inc(ls); v[ls]:=val; end
      else
        begin
          inc(ls);
          for k:=ls downto j do v[k]:=v[k-1];
          v[j]:=val;
        end;
    end;
end;

procedure cauta;
var val:longint;
    c,rez:integer;
begin
  val:=v[i]+v[j];
  c:=j+1;
  while (val>=v[c]) and (c<=n) do inc(c);
  rez:=c-1-j;
  inc(kont,rez);
end;

begin
  assign(f,'nrtri.in');
  reset(f);
  readln(f,n);
  if n>2 then
    begin
      cit_sort;
      close(f);
      kont:=0;
      assign(f,'nrtri.out');
      rewrite(f);
      for i:=1 to n-2 do
        for j:=i+1 to n-1 do
          cauta;
      write(f,kont);
      close(f);
    end
  else
    begin
      close(f);
      assign(f,'nrtri.out');
      rewrite(f);
      write(f,0);
      close(f);
    end;
end.