Cod sursa(job #113676)

Utilizator RobybrasovRobert Hangu Robybrasov Data 10 decembrie 2007 23:35:08
Problema Numarare triunghiuri Scor 50
Compilator fpc Status done
Runda Arhiva de probleme Marime 2.11 kb
type nod=record
       urm,info:integer;
     end;
var v:array[1..801] of nod;
    mat:array[1..801] of integer;
    i,j,n,rez:integer;
    kont:longint;
    f:text;

procedure cit_sort;
var a,a1,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 binary_search;
var li,ls,m:integer;
    val:longint;
    ok:boolean;
begin
  li:=j+1; ls:=n; ok:=true; val:=mat[i]+mat[j];
  if val>=mat[ls] then begin ok:=false; rez:=ls; end;
  if val<mat[li] then begin ok:=false; rez:=j; end;
  while (li<=ls) and ok do
    begin
      m:=(li+ls) div 2;
      if mat[m]=val then begin ok:=false; rez:=m; end
      else
        if val<mat[m] then ls:=m-1
        else li:=m+1;
    end;
  if ok then
    if val<mat[li] then rez:=li-1;
  inc(kont,rez-j);
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
          binary_search;
      write(f,kont);
      close(f);
    end
  else
    begin
      close(f);
      assign(f,'nrtri.out');
      rewrite(f);
      write(f,0);
      close(f);
    end;
end.