Cod sursa(job #116912)

Utilizator RobybrasovRobert Hangu Robybrasov Data 19 decembrie 2007 20:06:53
Problema Numarare triunghiuri Scor 25
Compilator fpc Status done
Runda Arhiva de probleme Marime 2.3 kb
type nod=record
       urm,info:integer;
     end;
     vector=array[1..801] of integer;
var v:array[1..801] of nod;
    mat,t:vector;
    i,j,n: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;
{
function binary_search(val:integer):integer;
var step,i:integer;
begin
  step:=1; i:=0;
  while step<n do step:=step shl 1;
  while step>0 do
    begin
      if (i+step<n) and (mat[1+step]<=val) then inc(i,step);
      step:=step shr 1;
    end;
  if val=mat[i+1] then inc(i);
  binary_search:=i;
end;
}
function binary_search(val:integer):integer;
var li,ls,m:longint;
    ok:boolean;
begin
  li:=j+1; ls:=n; ok:=true;
  while (li<=ls) and ok do
    begin
      m:=(li+ls) div 2;
      if val=mat[m] then begin ok:=false; binary_search:=m; end;
      if val>mat[m] then li:=m+1
      else ls:=m-1;
    end;
  if ok then binary_search:=li-1;
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
          inc(kont,binary_search(mat[i]+mat[j])-j);
      write(f,kont);
      close(f);
    end
  else
    begin
      close(f);
      assign(f,'nrtri.out');
      rewrite(f);
      write(f,0);
      close(f);
    end;
end.