Cod sursa(job #113206)

Utilizator RobybrasovRobert Hangu Robybrasov Data 9 decembrie 2007 10:42:40
Problema Numarare triunghiuri Scor 5
Compilator fpc Status done
Runda Arhiva de probleme Marime 1.82 kb
var v:array[1..801] of integer;
    i,j,n,kont:integer;
    f:text;

procedure sorteaza;
var i,t:integer;
    ok:boolean;
begin
  repeat
    ok:=true;
    i:=1;
    while (i<=n-1) and ok do
      begin
        if v[i]>v[i+1] then
          begin
            t:=v[i];
            v[i]:=v[i+1];
            v[i+1]:=t;
            ok:=false;
          end;
        inc(i);
      end;
  until ok;
end;

procedure cauta;
var val,c,rez:byte;
begin
  val:=v[i]+v[j];
  c:=j+1;
  while (val>=v[c]) and (c<=n) do inc(c);
  rez:=c-1-j;
  inc(kont,rez);
end;

{
procedure binary_search;
var li,ls,m,rez,val:byte;
    ok:boolean;
begin
  li:=j; ls:=n; ok:=true;
  val:=v[i]+v[j];
  while (li<ls) and ok do
    begin
      m:=(li+ls) div 2;
      if val=v[m] then begin ok:=false; rez:=m; end;
      if val<v[m] then ls:=m-1
      else li:=m+1;
    end;
    if ok then
      if val<v[li] then rez:=li-1
      else rez:=li;
    inc(kont,rez-j);
end;


procedure binary_search;
var li,ls,m,val:integer;
begin
  li:=j; ls:=n;
  val:=v[i]+v[j];
  while li<=ls do
    begin
      if val<v[ls] then m:=0;
      m:=(li+ls) div 2;
      if val=v[m] then break;
      if val<v[m] then ls:=m-1
      else li:=m+1;
    end;
    if val<v[li] then m:=li-1;
    if m<>0 then inc(kont,m-j);
end;
}
begin
  assign(f,'nrtri.in');
  reset(f);
  readln(f,n);
  if n>2 then
    begin
      for i:=1 to n do
        read(f,v[i]);
      close(f);
      sorteaza;
      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;}
          cauta;
      write(f,kont);
      close(f);
    end
  else
    begin
      close(f);
      assign(f,'nrtri.out');
      rewrite(f);
      write(f,0);
      close(f);
    end;
end.