Cod sursa(job #118313)

Utilizator RobybrasovRobert Hangu Robybrasov Data 24 decembrie 2007 13:50:25
Problema Numarare triunghiuri Scor 0
Compilator fpc Status done
Runda Arhiva de probleme Marime 2.82 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;
{
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;
}
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;
      for i:=1 to n-2 do
        for j:=i+1 to n-1 do
          begin
            writeln(g,binary_search(i,j));
            inc(kont,binary_search(i,j)-j);
          end;

      writeln(g,kont);
    end;
{  else
    begin
      close(f);
      assign(f,'nrtri.out');
      rewrite(f);
      writeln(f,0);
      close(f);
    end;}
  close(f);
  close(g);
end.