关于第十届普及组火星人的问题 [复制链接]

做了下这道题,感觉自己基本的算法是准确的,10个官方测试中的数据1~9也能顺利通过,但最后一个测试数据会超时。。。应该是我的算法太繁琐了吧~请各位指教！！
程序:
Program huoxingren;
Var a:array[1..99999]of integer;
    var n,m,t,s:integer;
  Procedure Init;
  Var i:integer;
    Begin
    Assign(input,'martian.in');
    Reset(input);
    Readln(n,m);
    For i:=1 to n do
      Read(a);
    End;
  Function Check(i,t:integer):boolean;
  Var j:integer;
    Begin
    For j:=1 to i-1 do
      If a[j]=t then
      Begin
        check:=false;
        Exit;
      End;
    check:=true;
    End;
  Procedure Main(k:integer);
  Var i,t:integer;
    Begin
    If k=n then
      Begin
      t:=1;
      While not (check(k,t))do
        inc(t);
      a[k]:=t;
      Main(k+1);
      End
      Else If k<n then
      Begin
      If a[k]=n then Begin
        a[k]:=0;
        Main(k-1);
        End
        else
        Begin
        t:=a[k]+1;
        While (t<=n)and(not(check(k,t))) do
          inc(t);
        If t<=n then
          Begin
          a[k]:=t;
          Main(k+1);
          End
          Else
          Begin
          a[k]:=0;
          Main(k-1);
          End;
        End;
      End
    Else
      Begin
      inc(s);
      If s=m then
        Begin
        For i:=1 to n do
          Begin
          Write(a);
          If i<n then write(' ');
          End;
        Exit;
        End;
      a[n]:=0;
      Main(k-2);
      End;
    End;
  Begin
  Init;
  Main(n-1);
  End.

var
    n,m,i,t,j,p,q:longint;
    s:array[1..25000] of integer;
begin
    readln(n,m);
    for i:=1 to n do
          read(s);
    for i:=1 to m do
    begin
          p:=n-1;
          while s[p]>s[p+1] do
              dec(p);
          q:=p+1;
          while (q<n)and(s[q+1]>s[p]) do
              inc(q);
          t:=s[p];
          s[p]:=s[q];
          s[q]:=t;
          for j:=p+1 to p+(n-p)div 2 do
          begin
              t:=s[j];
              s[j]:=s[n+p+1-j];
              s[n+p+1-j]:=t;
          end;
    end;
    for i:=1 to n do
          write(s,' ');
end.

这是我的程序！
是对的！

你的好复杂啊.........
program martian;
var
a:array[1..20000]of integer;
x,y,i,m,n,j,k,t:integer;
begin
assign(input,'martian.in'); reset(input);
assign(output,'martian.out'); rewrite(output);
readln(n,m);
for i:=1 to n do read(a);
for k:=1 to m do
begin
x:=n-1;
while a[x]>a[x+1] do dec(x);
y:=x+1;
while (y<n) and (a[y+1]>a[x]) do inc(y);
t:=a[x]; a[x]:=a[y]; a[y]:=t;
for j:=x+1 to x+(n-x)div 2 do
  begin
  t:=a[j]; a[j]:=a[n+x+1-j]; a[n+x+1-j]:=t;
  end;
end;
for i:=1 to n do write(a,' ');
close(input);
close(output);
end.

program p1092;
var
n,i,now:longint;
m:int64;
d:array[0..21]of qword;
a:array[0..21]of integer;
begin
read(n,m);
d[0]:=1;
for i:=1 to n do d:=d[i-1]*i;
for i:=1 to n do a:=i;
dec(m);
while n<>0 do
begin
dec(n);
now:=m div d[n]+1;
write(a[now],' ');
m:=m mod d[n];
for i:=now to n do a:=a[i+1];
end;
end.