[Delphi (Object Pascal)] Pascal经典算法详解 - 聪明的打字员 →→→→→进入此内容的聊天室

来自 , 2021-01-01, 写在 Delphi (Object Pascal), 查看 129 次.
URL http://www.code666.cn/view/9a84a044
  1. program clevertyper;
  2. const
  3.   max=600000;
  4. type
  5.   passtext=array[1..6] of byte;      {用数组存储每一个密码数字}
  6.   tlist=record                        {结点类型}
  7.      father:longint;
  8.      dep:byte;
  9.      point:1..6;
  10.      state:passtext;
  11.   end;
  12. var
  13.   source,target:passtext;                 {初始结点和目标结点}
  14.   list:array[0..max] of tlist;        {扩展出的中间结点序列}
  15.   head,foot,best,i:longint;
  16.   answer:longint;
  17.   found:boolean;
  18.   str1:string[8];
  19.   point0:1..6;
  20. procedure init;                      {初始化过程}
  21.   var
  22.     i:byte;
  23.   begin
  24.     assign(input,'clever.in');
  25.     reset(input);
  26.     assign(output,'clever.out');
  27.     rewrite(output);
  28.     readln(str1);
  29.     for i:=1 to 6 do
  30.        val(copy(str1,i,1),source[i]);
  31.     val(copy(str1,8,1),point0);
  32.     readln(str1);
  33.     for i:=1 to 6 do
  34.        val(copy(str1,i,1),target[i]);
  35.     fillchar(list,sizeof(list),0);
  36.     found:=false;
  37.     head:=0;                         {队列初始化,队首指针head,队尾指针foot}
  38.     foot:=1;
  39.     with list[1] do                  {初始结点作为队列第一个结点}
  40.       begin
  41.         state:=source;
  42.         dep:=0;
  43.         father:=0;
  44.         point:=point0;
  45.       end;
  46.   end;
  47. function same(a,b:passtext):boolean;
  48.   var
  49.     i:byte;
  50.   begin
  51.     same:=false;
  52.     for i:=1 to 6 do
  53.       if a[i]<>b[i] then exit;
  54.     same:=true;
  55.   end;
  56. function notappear(newv:tlist):boolean;  {判断扩展出的结点是否已在队列中的函数}
  57.   var
  58.     i:longint;
  59.   begin
  60.     notappear:=false;
  61.     for i:=1 to foot do
  62.       if same(newv.state,list[i].state) and (newv.point=list[i].point)
  63.         then exit;
  64.     notappear:=true;
  65.   end;
  66. procedure add(newv:tlist);      {往队列中加入新结点过程}
  67.   begin
  68.     if notappear(newv)
  69.       then begin
  70.             inc(foot);
  71.             list[foot]:=newv;
  72.            end;
  73.    end;
  74. procedure expand(index:longint;var n:tlist);  {扩展结点过程}
  75.   var
  76.     i,x,y:integer;
  77.     newv:tlist;
  78.   begin
  79.     for i:=1 to 6 do                   {分别应用6条规则}
  80.      begin
  81.        if i=1 then
  82.           if n.point>1
  83.             then begin
  84.                    newv.state:=n.state;
  85.                    newv.point:=n.point;
  86.                    newv.state[1]:=n.state[n.point];
  87.                    newv.state[n.point]:=n.state[1];
  88.                  end;
  89.        if i=2 then
  90.           if n.point<6
  91.             then begin
  92.                    newv.state:=n.state;
  93.                    newv.point:=n.point;
  94.                    newv.state[6]:=n.state[n.point];
  95.                    newv.state[n.point]:=n.state[6];
  96.                  end;
  97.        if i=3 then
  98.           if n.state[n.point]<9
  99.             then begin
  100.                    newv.state:=n.state;
  101.                    newv.point:=n.point;
  102.                    newv.state[n.point]:=newv.state[n.point]+1;
  103.                  end;
  104.        if i=4 then
  105.           if n.state[n.point]>0
  106.             then begin
  107.                    newv.state:=n.state;
  108.                    newv.point:=n.point;
  109.                    newv.state[n.point]:=newv.state[n.point]-1;
  110.                  end;
  111.        if i=5 then
  112.           if n.point>1
  113.             then begin
  114.                    newv.state:=n.state;
  115.                    newv.point:=n.point-1;
  116.                  end;
  117.        if i=6 then
  118.           if n.point<6
  119.             then begin
  120.                    newv.state:=n.state;
  121.                    newv.point:=n.point+1;
  122.                  end;
  123.         newv.father:=index;
  124.         newv.dep:=n.dep+1;
  125.         add(newv);
  126.      end;
  127.   end;
  128. procedure print(index:longint);   {递归打印路径}
  129.   var
  130.     i,j:byte;
  131.   begin
  132.     if index=0  then exit;
  133.     print(list[index].father);
  134.     for i:=1 to 6 do
  135.       write(list[index].state[i]);
  136.     writeln(' ',list[index].point);
  137.   end;
  138. begin{main}
  139.   init;
  140.   repeat
  141.     inc(head);
  142.     if same(list[head].state,target)   {比较是否跟目标相同,相同则找到,否则扩展新结点}
  143.        then begin
  144.              found:=true;
  145.              best:=list[head].dep;
  146.              answer:=head;
  147.              break;
  148.             end;
  149.     if list[foot].dep>6               {搜索树的深度超过6时,速度很慢,显示超时}
  150.        then begin
  151.               writeln('OverTime!');
  152.               break;
  153.             end;
  154.     expand(head,list[head]);
  155.   until (head>=foot) or (foot>max) or found;
  156.    if found
  157.      then begin
  158.            writeln(best);
  159.            print(answer);
  160.           end
  161.      else writeln('No Answer');
  162.   close(input);
  163.   close(output);
  164. end.
  165.  
  166.  
  167. //delphi/7189

回复 "Pascal经典算法详解 - 聪明的打字员"

这儿你可以回复上面这条便签

captcha