Cod sursa(job #874944)

Utilizator atatomirTatomir Alex atatomir Data 9 februarie 2013 14:50:23
Problema Numarare triunghiuri Scor 0
Compilator fpc Status done
Runda Arhiva de probleme Marime 1.38 kb
var bufin:array[1..65000]of byte;
    n,i,j,t:longint;
    a:array[1..801]of longint;
    iesi:boolean;
    cont:int64;

function cautare_binara(x:longint):longint;
var v,m,u:longint;
    ok:boolean;
begin
  u := j ; v := n+1 ; ok := false;
  while u<=v do
  begin
    m := (u+v) div 2;
    if a[m] = x then
    begin
      cautare_binara := m;
      ok := true;
      u := v + 30;
    end
    else
    begin
      if x > a[m] then
      begin
        u := m+1;
      end
      else
      begin
        v := m-1;
      end;
    end;

  end;


  if ok = false then cautare_binara := v;

  {u := j ; v := n+1;
  while v-u > 1 do
  begin
    m := (u+v)div 2;
    if x >= a[m] then
      u := m
    else
      v := m ;
  end;

  cautare_binara := u;   }
end;

begin
  assign(input,'nrtri.in'); reset(input);
  assign(output,'nrtri.out'); rewrite(output);
  settextbuf(input,bufin);

  readln(n);  cont := 0;
  for i := 1 to n do read(a[i]);

  repeat
    iesi := true;
    for i := 1 to n-1 do
      if a[i] > a[i+1] then
      begin
        t := a[i];
        a[i] := a[i+1];
        a[i+1] := t;
        iesi := false;
      end;

    until iesi = true;

  for i := 1 to n - 2 do
    for j := i+1 to n-1 do
    begin
      cont := cont + cautare_binara(a[i]+a[j]) - j ;

    end;

  write(cont);
  close(input);
  close(output);
end.