回溯法第7题—圆盘移动问题

浏览数：20 / 时间：2015年06月11日

[问题描述]
从左向右依次安放4根细柱A,B,C,D。在A柱上套有n(n<=20)个直径相同的圆盘，从上到下一次用连续的小写字母a,b,c,...编号，将这些圆盘经过B,C单向的移动到D柱上（即不允许从右向左移动。圆盘可在B,C中暂存）。要求找到从A柱初始状态到D柱目标状态的移动过程。
输入：第一行是D柱上的圆盘总数，第二行是D柱上由下到上的圆盘的序列。
输出：是一个文件。该文件的每一行为一个形如"k m l"的字母序列，其中k为圆盘编号，m为k盘原先的柱号，l为目标柱号。如果不能生成排列，则输出“no solution!”
[样例输入]

3
a b c

[样例输出]

c A B 
b A C 
a A D 
b C D 
c B D

[问题分析]
懒得写题(dai)解(ma)了…………直接上代码
下面是标准程序：

program p1_7(input,output);
var
 ga,gb,gc,gd,fd:array [0..15] of char;
 topa,topb,topc,topf:byte;
 resl:array [1..2000] of record
                          code:char;
                          source:char;
                          target:char
                        end;
 order:array [‘0‘..‘z‘] of byte;
 i,n,kz,ks:byte;
 j:char;
procedure print;
var i:byte;
begin
 i:=1;
 repeat
   writeln(resl[i].code:5,resl[i].source:5,resl[i].target:5);
   inc(i)
 until resl[i].code=‘0‘;
end;
procedure move1(var topa,topb,topc,ks:byte);
var t:byte;
begin
  repeat
   if  (topa=0)and(topb=0)and(topc=0) then
     begin  print;halt(1);kz:=1 end;
   t:=0;
   if  ga[topa]=fd[topf] then
    begin{a-d}
       t:=t+1;
       ks:=ks+1;
       resl[ks].code:=ga[topa];
       resl[ks].source:=‘A‘;
       resl[ks].target:=‘D‘;
       topf:=topf+1;topa:=topa-1;
    end;
  if  gb[topb]=fd[topf] then
    begin{b-d}
      t:=t+1;
      ks:=ks+1;
      resl[ks].code:=gb[topb];
      resl[ks].source:=‘B‘;
      resl[ks].target:=‘D‘;
      topf:=topf+1;topb:=topb-1;
    end;
  if  gc[topc]=fd[topf] then
    begin {c-d}
      t:=t+1;
      ks:=ks+1;
      resl[ks].code:=gc[topc];
      resl[ks].source:=‘C‘;
      resl[ks].target:=‘D‘;
      topf:=topf+1;topc:=topc-1;
    end;
  until t=0;
end;
procedure move2(var topa,topb,topc,ks: byte);
var   tp,ks1:byte;
begin
  move1(topa,topb,topc,ks);
  ks1:=ks+1;
  for  tp:=1  to  3  do
      case tp  of
      1: {a--b}
       if  topa>0 then
        begin
         resl[ks1].code:=ga[topa];
         resl[ks1].source:=‘A‘;
         resl[ks1].target:=‘B‘;
         topb:=topb+1;gb[topb]:=ga[topa];topa:=topa-1;
         move2(topa,topb,topc,ks1);
         topa:=topa+1;dec(topb);
        end;
       2: {a--c}
       if (order[ga[topa]]<order[gc[topc]])and(topa>0) then
        begin
         resl[ks1].code:=ga[topa];
         resl[ks1].source:=‘A‘;
         resl[ks1].target:=‘C‘;
         topc:=topc+1;gc[topc]:=ga[topa];topa:=topa-1;
         move2(topa,topb,topc,ks1);
         topa:=topa+1;dec(topc);
        end;
       3: {b--c}
        if (order[gb[topb]]<order[gc[topc]])and(topb>0)then
         begin
           resl[ks1].code:=gb[topb];
           resl[ks1].source:=‘B‘;
           resl[ks1].target:=‘C‘;
           topc:=topc+1;gc[topc]:=gb[topb];dec(topb);
           move2(topa,topb,topc,ks1);
           topb:=topb+1;dec(topc)
           end;
     end{case and  for};
end;
begin{main}
  assign(input,‘word.in‘);
  reset(input);
  assign(output,‘word.out‘);
  rewrite(output);
  readln(n);
  for  i:=1  to  n  do    read(fd[i]);
  i:=1;
repeat
 for  j:=‘a‘ to chr(ord(‘a‘)+n-1) do if j=fd[i] then order[j]:=i;i:=i+1
until i>n;
order[‘0‘]:=0;
order[‘1‘]:=100;
for i:=1 to 200 do resl[i].code:=‘0‘;
for i:=1 to n do ga[i]:=chr(ord(‘a‘)+i-1);
topa:=n;topb:=0;topc:=0;topf:=1;kz:=0;
ks:=0;ga[0]:=‘0‘;gb[0]:=‘0‘;gc[0]:=‘1‘;
move2(topa,topb,topc,ks);
if kz=0 then writeln(‘no solution!‘);
end.