Cod sursa(job #5304)

Utilizator fogabFodor Gabor fogab Data 11 ianuarie 2007 18:30:04
Problema Numarare triunghiuri Scor 0
Compilator fpc Status done
Runda Arhiva de probleme Marime 0.86 kb
var f:text;
    i,j,n,k,c:integer;
    sol:int64;
    a:array[1..801] of integer;
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]:=31000;
for i:=1 to n-2 do
    for j:=i+1 to n-1 do
        begin
        k:=n;
        c:=a[i]+a[j]-1;
        while a[k]>c do dec(k);
        sol:=sol+k-j;
        end;
assign(f,'nrtri.out');
rewrite(f);
writeln(f,sol);
close(f);
end.