o（n^2*10）都tle？？？？？？？？
怎么改？？？？？？
var i,j,k,n:longint；
f:array[0..1000,0..1000,0..101]of longint；
z:array[0..101]of longint；
begin
read(n)；
for i:=0 to n do begin f[0,i,1]:=1；end；
for i:=1 to n do
for j:=1 to i+1 do
begin
if i>=j then
begin
z:=f[i,j-1]；
f[i,j]:=f[i-j,j-1]；
for k:=1 to 10 do f[i,j,k]:=f[i,j,k]*j；
for k:=1 to 10 do if f[i,j,k]>=1000000 then begin f[i,j,k+1]:=f[i,j,k+1]+f[i,j,k] div 1000000；f[i,j,k]:=f[i,j,k] mod 1000000；end；
for k:=10 downto 1 do
begin
if z[k]>f[i,j,k] then begin f[i,j]:=z；continue；end；
if z[k]<f[i,j,k] then continue；
end；
end
else f[i,j]:=f[i,i]；
end；
k:=10；
while f[n,n,k]=0 do dec(k)；
write(f[n,n,k])；
for i:=k-1 downto 1 do
begin
if f[n,n,i]<100000 then write(0)；
if f[n,n,i]<10000 then write(0)；
if f[n,n,i]<1000 then write(0)；
if f[n,n,i]<100 then write(0)；
if f[n,n,i]<10 then write(0)；
write(f[n,n,i])；
end；
end.
。。。。。。。。。。。。。。。。。。
无语。。。。。。。。。。
你开那么大，你自己的机子承受得起？
var a:array[1..200] of longint；
b:array[1..200] of longint；
len1,len2:longint；
n:longint；
procedure inti；
begin
readln(n)；
end；
procedure divi；
var i:longint；
begin
len1:=1；
while n>len1 do
begin
a[len1]:=len1+1；
inc(len1)；
n:=n-len1；
end；
dec(len1)；
if n>0 then
begin
i:=len1；
while n>0 do
begin
inc(a[i])；
dec(n)；
dec(i)；
if i=0 then i:=len1；
end；
end；
end；
procedure mul；
var i,j:longint；
begin
fillchar(b,sizeof(b),0)；
len2:=1；b[1]:=1；
for i:=1 to len1 do
begin
for j:=1 to len2 do b[j]:=b[j]*a[i]；
for j:=1 to len2+3 do
begin
b[j+1]:=b[j+1]+b[j] div 10；
b[j]:=b[j] mod 10；
end；
len2:=len2+4；
while b[len2]=0 do dec(len2)；
end；
end；
procedure print；
var i:longint；
begin
for i:=len2 downto 1 do write(b[i])；
end；
begin
inti；
if n<5 then begin write(n-1)；end
else
begin
divi；mul；print；
end；
end.