PRO_4_3.pas 4.1 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153
  1. Program Pro_4_3; {例4改进后的搜索算法}
  2. Const
  3. Map:Array['A'..'G','A'..'G'] Of Byte= {每两个农场的距离}
  4. ((0,56,43,71,35,41,36),
  5. (56,0,54,58,36,79,31),
  6. (43,54,0,30,20,31,58),
  7. (71,58,30,0,38,59,75),
  8. (35,36,20,38,0,44,67),
  9. (41,79,31,59,44,0,72),
  10. (36,31,58,75,67,72,0));
  11. Inputfile ='Input.Txt'; {输入文件名}
  12. Outputfile ='Output.Txt'; {输出文件名}
  13. Type
  14. Kus =Array[0..4095] Of Word; {记录数组类型}
  15. Ses =Set Of 1..12; {集合类型}
  16. Var
  17. F :Text; {文件变量}
  18. N :Integer; {任务的数目}
  19. Min :Word; {最短路径的长度}
  20. Big,I :Word; {应用变量}
  21. Wu :Array[0..12,1..2] Of Char; {记录任务的数组}
  22. Dis :Array[0..12,0..12] Of Integer; {记录每两个任务的连接权值}
  23. Ku :Array[1..12] Of ^kus; {记录最优权值的数组}
  24. Qiu :Array[1..13] Of Byte; {搜索中记录路径的数组}
  25. Se :Ses;
  26. Procedure Init; {初始化过程}
  27. Var
  28. I :Integer;
  29. Ch :Char;
  30. Begin
  31. Assign(F,Inputfile);
  32. Reset(F);
  33. Readln(F,N);
  34. For I:=1 To N Do {读入数据}
  35. Readln(F,Wu[I,1],Ch,Wu[I,2]);
  36. Close(F);
  37. End;
  38. Procedure Prepare; {准备过程}
  39. Var
  40. I,J :Integer;
  41. Begin
  42. Wu[0,1]:='A';Wu[0,2]:='A'; {求出每两个任务的连接权值}
  43. For I:=0 To N Do
  44. For J:=0 To N Do
  45. Dis[I,J]:=Map[Wu[I,2],Wu[J,1]];
  46. For I:=1 To N Do {初始化记录数组}
  47. Begin
  48. New(Ku[I]);
  49. Fillchar(Ku[I]^,Sizeof(Ku[I]^),$ff);
  50. End;
  51. Big:=Ku[1]^[1];
  52. End;
  53. Function Num(S:Ses):Word; {将集合转化为整数的函数}
  54. Var
  55. X :Word Absolute S;
  56. Begin
  57. Num:=X Div 2;
  58. End;
  59. Procedure Search(Dep:Byte;Al:Word); {搜索过程}
  60. Var
  61. I :Byte;
  62. D :Word;
  63. Begin
  64. If Al>=Min Then Exit;
  65. If Ku[Qiu[Dep-1]]^[Num(Se)]<Big Then
  66. Begin {如果已经做过此工作,则直接读值}
  67. If Al+Ku[Qiu[Dep-1]]^[Num(Se)]<Min Then
  68. Min:=Al+Ku[Qiu[Dep-1]]^[Num(Se)];
  69. End
  70. Else
  71. If Dep>N Then
  72. Begin {边界时直接计算}
  73. Ku[Qiu[Dep-1]]^[Num(Se)]:=Dis[Qiu[Dep-1],0];
  74. If Al+Ku[Qiu[Dep-1]]^[Num(Se)]<Min Then
  75. Min:=Al+Ku[Qiu[Dep-1]]^[Num(Se)];
  76. End
  77. Else
  78. Begin
  79. D:=Big; {搜索每个位访问点}
  80. For I:=1 To N Do
  81. If I In Se Then
  82. Begin
  83. Exclude(Se,I);
  84. Qiu[Dep]:=I;
  85. Search(Dep+1,Al+Dis[Qiu[Dep-1],Qiu[Dep]]);
  86. If Ku[I]^[Num(Se)]+Dis[Qiu[Dep-1],Qiu[Dep]]<D Then
  87. D:=Ku[I]^[Num(Se)]+Dis[Qiu[Dep-1],Qiu[Dep]]; {记录工作结果}
  88. Include(Se,I);
  89. End;
  90. Ku[Qiu[Dep-1]]^[Num(Se)]:=D;
  91. End;
  92. End;
  93. Procedure Print; {输出结果}
  94. Var
  95. I,J,Last :Integer;
  96. D :Word;
  97. Begin
  98. Se:=[1..N];
  99. J:=1;
  100. While Dis[0,J]+Ku[J]^[Num(Se-[J])]<>Min Do
  101. Inc(J);
  102. D:=Min;
  103. For I:=1 To N Do
  104. Inc(D,Map[Wu[I,1],Wu[I,2]]);
  105. Assign(F,Outputfile);
  106. Rewrite(F);
  107. Writeln(F,D);
  108. Write(F,'A ');
  109. Dec(Min,Dis[0,J]);
  110. Last:=0;
  111. For I:=1 To N Do
  112. Begin
  113. If Wu[J,1]<>Wu[Last,2] Then
  114. Write(F,Wu[J,1],' ');
  115. Write(F,Wu[J,2],' ');
  116. If I<>N Then
  117. Begin
  118. Last:=J;
  119. Exclude(Se,J);
  120. J:=1;
  121. While (Not (J In Se)) Or (Ku[J]^[Num(Se-[J])]+Dis[Last,J]<>Min) Do
  122. Inc(J);
  123. Dec(Min,Dis[Last,J]);
  124. End;
  125. End;
  126. If Wu[J,2]<>'A' Then Write(F,'A');
  127. Close(F);
  128. End;
  129. Begin
  130. Init; {输入}
  131. Prepare; {准备}
  132. Se:=[1..N]; {初始化搜索中应用的各项值}
  133. Min:=Big;
  134. For I:=1 To N Do
  135. Begin
  136. Se:=[1..N]-[I];
  137. Qiu[1]:=I;
  138. Search(2,Dis[0,I]); {搜索}
  139. End;
  140. Print; {输出}
  141. End.