[Delphi (Object Pascal)] Pascal经典算法详解 - 量水问题 →→→→→进入此内容的聊天室

来自 , 2020-02-02, 写在 Delphi (Object Pascal), 查看 100 次.
URL http://www.code666.cn/view/76f1cfd7
  1. program liangshui;
  2. const
  3.   max=600000;
  4. type
  5.     tlist=record                        {结点类型}
  6.      father:longint;
  7.      dep:byte;
  8.      a:integer;
  9.      b:integer;
  10.     end;
  11. var
  12.   list:array[0..max] of tlist;        {扩展出的中间结点序列}
  13.   head,foot,best,i:longint;
  14.   m,n,k:integer;
  15.   answer:longint;
  16.   found:boolean;
  17. procedure init;                      {初始化过程}
  18.   var
  19.     i:byte;
  20.   begin
  21.     assign(input,'ls.in');
  22.     reset(input);
  23.     assign(output,'ls.out');
  24.     rewrite(output);
  25.     fillchar(list,sizeof(list),0);
  26.     found:=false;
  27.     head:=0;                         {队列初始化,队首指针head,队尾指针foot}
  28.     foot:=1;
  29.     with list[1] do                  {初始结点作为队列第一个结点}
  30.       begin
  31.         a:=0;
  32.         b:=0;
  33.         dep:=0;
  34.         father:=0;
  35.       end;
  36.     readln(m,n,k)
  37.   end;
  38. function notappear(newv:tlist):boolean;  {判断扩展出的结点是否已在队列中的函数}
  39.   var
  40.     i:longint;
  41.   begin
  42.     notappear:=false;
  43.     for i:=1 to foot do
  44.       if (newv.a=list[i].a) and (newv.b=list[i].b)
  45.         then exit;
  46.     notappear:=true;
  47.   end;
  48. procedure add(newv:tlist);      {往队列中加入新结点过程}
  49.   begin
  50.     if notappear(newv)
  51.       then begin
  52.             inc(foot);
  53.             list[foot]:=newv;
  54.            end;
  55.    end;
  56. procedure expand(index:longint;var oldv:tlist);  {扩展结点过程}
  57.   var
  58.     i:integer;
  59.     newv:tlist;
  60.   begin
  61.     for i:=1 to 6 do                   {分别应用6条规则}
  62.      begin
  63.        if i=1 then
  64.           if oldv.a<>0                                    {把a量筒倒空}
  65.             then begin newv.a:=0;newv.b:=oldv.b;end;
  66.        if i=2 then
  67.           if oldv.a<>m                                    {把a量筒灌满}
  68.             then begin newv.a:=m;newv.b:=oldv.b;end;
  69.        if i=3 then
  70.           if oldv.b<>0                                    {把b量筒倒空}
  71.             then begin newv.b:=0;newv.a:=oldv.a;end;
  72.        if i=4 then
  73.           if oldv.a<>n                                    {把b量筒灌满}
  74.             then begin newv.a:=n;newv.a:=oldv.a;end;
  75.        if i=5 then
  76.           if (oldv.a<>0) and (oldv.b<>n)                     {把a量筒往b量筒倒水}
  77.             then if oldv.a+oldv.b>=n                         {判断a往b倒时b能否全部装下}
  78.                    then begin newv.b:=n;newv.a:=oldv.a-(n-oldv.b);end
  79.                    else begin newv.a:=0;newv.b:=oldv.a+oldv.b;end;
  80.        if i=6 then
  81.           if (oldv.a<>m) and (oldv.b<>0)                     {把b量筒往a量筒倒水}
  82.             then if oldv.a+oldv.b>=m                         {判断b往a倒时a能否全部装下}
  83.                    then begin newv.a:=m;newv.b:=oldv.b-(m-oldv.a);end
  84.                    else begin newv.b:=0;newv.a:=oldv.a+oldv.b;end;
  85.         newv.father:=index;
  86.         newv.dep:=oldv.dep+1;
  87.         add(newv);
  88.      end;
  89.   end;
  90. procedure print(index:longint);   {递归打印路径}
  91.   var
  92.     i,j:byte;
  93.   begin
  94.     if index=0  then exit;
  95.     print(list[index].father);
  96.     writeln(list[index].a,' ',list[index].b);
  97.   end;
  98. begin{main}
  99.   init;
  100.   repeat
  101.     inc(head);
  102.     if list[head].a=k   {比较是否跟目标相同,相同则找到,否则扩展新结点}
  103.        then begin
  104.              found:=true;
  105.              best:=list[head].dep;
  106.              answer:=head;
  107.              break;
  108.             end;
  109.     if list[foot].dep>100
  110.        then begin
  111.               writeln('OverTime!');
  112.               break;
  113.             end;
  114.     expand(head,list[head]);
  115.     {writeln(list[head].a,' ',list[head].b);}
  116.   until (head>=foot) or (foot>max) or found;
  117.    if found
  118.      then begin
  119.            writeln(best);
  120.            print(answer);
  121.           end
  122.      else writeln('No Answer');
  123.   close(input);
  124.   close(output);
  125. end.
  126. //delphi/7190

回复 "Pascal经典算法详解 - 量水问题"

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

captcha