从左向右依次安放 3 根细柱 A,B,C. 在 A 上套有 N (N≤20) 个直径相同的圆盘, 从下到上依次编为1,2,,,,,N, 将这些圆盘经过 B 单向地移入 C (即不允许从右向左移动). 圆盘可在 B 中暂存. 从键盘输入 N, 问将圆盘全部移入C后,在C柱上共有多少种排列方式?
┃ ┃ ┃
1 ━╋━ ┃ ┃
2 ━╋━ ┃ ┃
3 ━╋━ ┃ ┃
4 ━╋━ ┃ ┃
━━┻━━━┻━━━┻━
A B C
program lxw007;
type row=array[1..100] of shortint;
var b,c,d: row;
i,j,j1,j2,m,n,n2: integer;
s,sum,t,pa,pb,pc:integer;
procedure prt2(u:shortint);
begin
if u=1 then
begin
inc(pa); inc(pb); b[pb]:=pa;
write("A(",pa:2,")=>B(",pb:2,") ");
end
else
begin
inc(pc); c[pc]:=b[pb];
write("B(",pb:2,")=>C(",pc:2,") ");
dec(pb);
end
end;
procedure perm(n:integer; var p:row; var i:integer);
var j,j1,j2,t,m:integer;
begin
i:=n;
repeat dec(i) until (p[i]<p[i+1]) or (i<1);
if i>0 then
begin
j:=i+1;
for t:=i+1 to n do
if p[i]<p[t] then j:=t;
m:=p[i]; p[i]:=p[j]; p[j]:=m;
t:=(n-i) div 2;
for j:=1 to t do
begin
j1:=i+j; j2:=n-j+1;
m:=p[j1]; p[j1]:=p[j2]; p[j2]:=m;
end;
end;
end;
procedure process;
begin
m:=0; j:=0;
repeat inc(j); m:=m+d[j]; until (m<0) or (j=n2);
if m>=0 then
begin
inc(sum); s:=0;
pa:=0; pb:=0; pc:=0;
writeln("No.",sum:5);
for j:=1 to n2 do
begin
inc(s); prt2(d[j]);
if (s mod 5)=0 then writeln;
end; writeln;
for j:=1 to n do write(c[j]:2," ");
writeln;
end;
end;
begin {main}
writeln("输入圆盘数 N:(<=50)"); readln(n);
n2:=n*2; sum:=0;
for i:=1 to n do begin d[i]:=-1; d[n+i]:=1 end;
i:=1;
while i>0 do
begin
perm(n2,d,i);
if i>0 then process;
end;
writeln("排列总数:",sum:6," 圆盘数:",n:2);
end.