Cod sursa(job #591604)

Utilizator ion_calimanUAIC Ion Caliman ion_caliman Data 24 mai 2011 21:03:57
Problema Numarare triunghiuri Scor 100
Compilator fpc Status done
Runda Arhiva de probleme Marime 1.16 kb
var     a:array[1..800] of integer;
        n,i,j,k,p,t:longint;
        buf:array[1..100000] of integer;
        nr:int64;
        f1,f2:text;

procedure sw(var a,b:integer);
var t:integer;
begin
  t:=a;
  a:=b;
  b:=t;
end;

procedure qs(left,right:integer);
var     i,j,r:integer;
begin
  i:=left;
  j:=right;
  r:=a[(i+j) div 2];
  while i<j do
    begin
      while a[i]<r do inc(i);
      while a[j]>r do dec(j);
      if i<=j then begin sw(a[i],a[j]); inc(i); dec(j); end;
    end;
  if i<right then qs(i,right);
  if j>left then qs(left,j);
end;

begin
  assign(f1,'nrtri.in');
  assign(f2,'nrtri.out');
  reset(f1);
  rewrite(f2);
  settextbuf(f1,buf);
  readln(f1,n);

  for i:=1 to n do
    read(f1,a[i]);

  qs(1,n);

  nr:=0;
  for i:=1 to n-2 do
  for j:=i+1  to n-1 do
  //for k:=j+1 to n do
    begin
      k:=j;
      t:=n;
      while k<>t do
        begin
          p:=(k+t) div 2;
          if a[i]+a[j]>=a[p]
            then k:=p+1 else t:=p;
        end;
      while (a[i]+a[j]>=a[k])and(k<n) do inc(k);
      while a[i]+a[j]<a[k] do dec(k);
      nr:=nr+k-j;
    end;

  write(f2,nr);
  close(f2);
end.