Cod sursa(job #5328)

Utilizator fogabFodor Gabor fogab Data 11 ianuarie 2007 22:06:16
Problema Numarare triunghiuri Scor 100
Compilator fpc Status done
Runda Arhiva de probleme Marime 1.06 kb
{13826725}
var f:text;
    sol,i,j,n,k,c,x1,x2:longint;
    a:array[1..801] of longint;

procedure quicksort(l,r:dword);
var i,j,x,y:dword;
begin
 i:=l;j:=r;x:=a[(l+r) div 2];
 repeat
   while a[i]<x do i:=i+1;
   while x<a[j] do j:=j-1;
   if i<=j then begin
                y:=a[i];
                a[i]:=a[j];
                a[j]:=y;
                i:=i+1;
                j:=j-1;
                end;
 until i>j;
 if l<j then quicksort(l,j);
 if i<r then quicksort(i,r);
end;

begin
assign(f,'nrtri.in');
reset(f);
readln(f,n);
for i:=1 to n do read(f,a[i]);
close(f);
j:=1;
quicksort(1,n);
a[n+1]:=61000;
for i:=1 to n-2 do
    for j:=i+1 to n-1 do
        begin
        c:=a[i]+a[j];
        x1:=j;
        x2:=n+1;
        while x2-x1>1 do begin
                          if c>=a[(x1+x2) div 2] then x1:=(x1+x2) div 2
                                                 else x2:=(x1+x2) div 2;
                          end;
        sol:=sol+x1-j;
        end;
assign(f,'nrtri.out');
rewrite(f);
writeln(f,sol);
close(f);
end.