Cod sursa(job #118445)

Utilizator RobybrasovRobert Hangu Robybrasov Data 25 decembrie 2007 17:08:14
Problema Numarare triunghiuri Scor 85
Compilator fpc Status done
Runda Arhiva de probleme Marime 2.14 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,t,k:integer;
    kont:longint;
    f,g: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(a,b:integer):longint;
var step,i:integer;
    val:longint;
begin
  val:=mat[a]+mat[b];
  if val<mat[j+1] then binary_search:=j
  else if val=mat[j+1] then binary_search:=j+1
       else if val>=mat[n] then binary_search:=n
            else
              begin
                step:=1; i:=0;
                while step<n do step:=step shl 1;
                while step>0 do
                  begin
                    if (i+step<n) and (mat[i+step]<=val) then inc(i,step);
                    step:=step shr 1;
                  end;
                binary_search:=i;
              end;
end;

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