Cod sursa(job #113393)

Utilizator RobybrasovRobert Hangu Robybrasov Data 9 decembrie 2007 21:23:29
Problema Numarare triunghiuri Scor 80
Compilator fpc Status done
Runda Arhiva de probleme Marime 2.24 kb
type nod=record
       urm,info:integer;
     end;
var v:array[1..801] of nod;
    mat: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 cit_sort;
var a,a1,val,i,ca,ls:integer;
begin
  read(f,v[1].info,v[2].info);
  if v[1].info<v[2].info then begin v[1].urm:=2; v[2].urm:=0; a:=1; ls:=2; end
  else begin v[2].urm:=1; v[1].urm:=0; a:=2; ls:=1; end;
  for i:=3 to n do
    begin
      read(f,v[i].info);
      ca:=a;
      a1:=ca;
      while (v[i].info>=v[ca].info) and (v[ca].urm<>0) do begin a1:=ca; ca:=v[ca].urm; end;
      if v[ca].urm=0 then
        if v[i].info<v[ca].info then
          begin
            v[i].urm:=ls;
            v[a1].urm:=i;
          end
        else
          begin
            v[ls].urm:=i;
            ls:=i;
            v[i].urm:=0;
          end
      else
        if v[i].info<v[a].info then
          begin
            v[i].urm:=ca;
            a:=i;
          end
        else
          begin
            v[i].urm:=ca;
            v[a1].urm:=i;
          end;
    end;
  for i:=1 to n do
    begin
      mat[i]:=v[a].info;
      a:=v[a].urm;
    end;
end;

procedure cauta;
var val:longint;
    c,rez:integer;
begin
  val:=mat[i]+mat[j];
  c:=j+1;
  while (val>=mat[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.