Cod sursa(job #809041)

Utilizator t.g.g.tt.g.g.t t.g.g.t Data 7 noiembrie 2012 20:12:04
Problema Numarare triunghiuri Scor 100
Compilator fpc Status done
Runda Arhiva de probleme Marime 0.92 kb
var a:array[1..800]of integer; n,i,j,k,x,m:integer; s,s1:longint;
procedure sort (l,r:integer);
var i,j,k,t:integer;
begin
  k:=a[(l+r) div 2]; i:=l; j:=r;
  repeat
    while (a[i]<k)  do inc(i);
    while (a[j]>k)  do dec(j);
    if i<=j then begin t:=a[i]; a[i]:=a[j]; a[j]:=t; inc(i); dec(j); end;
  until i>=j;
if l<j then sort(l,j);
if i<r then sort(i,r);
end;
begin
assign(input,'nrtri.in'); reset(input);
readln(n);
for i:=1 to n do read(a[i]);
sort(1,n);
for i:=1 to n-2 do
  begin
    for j:=i+1 to n do
      begin
        s1:=a[i]+a[j]; k:=j; x:=n; m:=1;
        while m<=n do
          begin
            m:=(k+x+1) div 2;
            if a[m]<=s1 then k:=m;
            if a[m]>s1 then if a[m-1]<=s1 then begin s:=s+m-j-1; m:=n+1; end else x:=m;
            if m=n then if s1>=a[m] then begin s:=s+m-j; m:=n+1; end;
          end;
      end;
  end;
assign(output,'nrtri.out'); rewrite(output);
writeln(s);
close(output);
end.