agstick版主的捡金币问题

yynrzwh

先看题目



首先声明，本人对算法一窍不通。
本来想下载大佬的解法看看，但帖子里的附件一个也下载不了，不知怎么回事。
帖子里版主说要用动态规划法求解，于是搜了一下，
然后照着写了一个：

1. Sub 捡金币_main()
   
2. Range("a1:j10").Interior.ColorIndex = 0
   
3. Range("a1:j10").Font.ColorIndex = 0
   
4. 
   
5. arr = Range("a1:j10")
   
6. Range("o7:o10") = ""
   
7. 
   
8. Call 去程(arr)
   
9. 
   
10. Call 回程(arr)
    
11. 
    
12. End Sub
    
13. Sub 去程(ByVal ar)
    
14. 
    
15. 
    
16. ReDim br(1 To 10, 1 To 10) '存放累加值
    
17. ReDim cr(1 To 10, 1 To 10) '存放路径
    
18. ar(1, 1) = 0: ar(10, 10) = 0: cr(1, 1) = "A1" '初始值
    
19. 
    
20. '第一列逐个累加
    
21. For i = 2 To 10
    
22.     br(i, 1) = br(i - 1, 1) + ar(i, 1)
    
23.     cr(i, 1) = cr(i - 1, 1) & "->" & Cells(i, 1).Address(0, 0)
    
24. Next
    
25.    
    
26. '第一行逐个累加
    
27. For j = 2 To 10
    
28.     br(1, j) = br(1, j - 1) + ar(1, j)
    
29.     cr(1, j) = cr(1, j - 1) & "->" & Cells(1, j).Address(0, 0)
    
30. Next
    
31. 
    
32. 'br从第二行第二列开始循环，比较当前格的上一格和左一格的大小，（上，左都是累加值）
    
33. '取较大的值+ar的当前值=br当前值
    
34. For i = 2 To 10
    
35.     For j = 2 To 10
    
36.         If br(i - 1, j) > br(i, j - 1) Then
    
37.             br(i, j) = br(i - 1, j) + ar(i, j)
    
38.             cr(i, j) = cr(i - 1, j) & "->" & Cells(i, j).Address(0, 0)
    
39.         Else
    
40.             br(i, j) = br(i, j - 1) + ar(i, j)
    
41.             cr(i, j) = cr(i, j - 1) & "->" & Cells(i, j).Address(0, 0)
    
42.         End If
    
43.     Next
    
44. Next
    
45. 
    
46. 'br(10,10)即为最大值
    
47. [o7] = "去程捡到" & br(10, 10) & "金币"
    
48. [o8] = "去程路径:" & cr(10, 10)
    
49. 
    
50. '着色
    
51. t = Split(cr(10, 10), "->")
    
52. For Each cel In t
    
53.     Range(cel).Font.ColorIndex = 3
    
54. Next
    
55. 
    
56. End Sub
    
57. Sub 回程(ByVal ar)
    
58. 
    
59. ReDim br(1 To 10, 1 To 10) '存放累加值
    
60. ReDim cr(1 To 10, 1 To 10) '存放路径
    
61. ar(1, 1) = 0: ar(10, 10) = 0
    
62. cr(10, 10) = "J10"
    
63.    
    
64. For i = 9 To 1 Step -1
    
65.     br(i, 10) = br(i + 1, 10) + ar(i, 10)
    
66.     cr(i, 10) = cr(i + 1, 10) & "->" & Cells(i, 10).Address(0, 0)
    
67. Next
    
68.    
    
69. For j = 9 To 1 Step -1
    
70.     br(10, j) = br(10, j + 1) + ar(10, j)
    
71.     cr(10, j) = cr(10, j + 1) & "->" & Cells(10, j).Address(0, 0)
    
72. Next
    
73. 
    
74.     For i = 9 To 1 Step -1
    
75.         For j = 9 To 1 Step -1
    
76.             If br(i + 1, j) > br(i, j + 1) Then
    
77.                 br(i, j) = br(i + 1, j) + ar(i, j)
    
78.                 cr(i, j) = cr(i + 1, j) & "->" & Cells(i, j).Address(0, 0)
    
79.             Else
    
80.                 br(i, j) = br(i, j + 1) + ar(i, j)
    
81.                 cr(i, j) = cr(i, j + 1) & "->" & Cells(i, j).Address(0, 0)
    
82.             End If
    
83.         Next
    
84.     Next
    
85. 
    
86. [o9] = "回程捡到" & br(1, 1) & "金币"
    
87. [o10] = "回程路径:" & cr(1, 1)
    
88. t = Split(cr(1, 1), "->")
    
89.     For Each cel In t
    
90.         Range(cel).Interior.ColorIndex = 34
    
91.     Next
    
92. End Sub
    
93. 
    
94. 
    

复制代码

回程其实就是把数组倒过来循环，也不知版主说的”双线动态规划“是怎么样。
另外，没发现来回捡到金币数不一样的情况，有时路径不一样，但捡到金币数是一样的。
本人的算法对不对？
金币数不一样是什么情况？请各位大佬赐教。
捡金币2.zip (69.94 KB, 下载次数: 11)

2024-4-28 11:14 上传

点击文件名下载附件

micch

支持一下，看过好几次，双动态规划确实非常难懂。

DevilW

金币是有限的，去的时候捡到多少，原路返回的时候已没有金币捡了，只能走另一条路返回才能捡到，求的是一来一回捡到最多金币的最优解

DevilW

这样就合理了

yynrzwh

DevilW 发表于 2024-4-28 12:17
这样就合理了

原来是这个意思？

yynrzwh

1. Sub 双程捡金币()
   
2. 
   
3. Range("a1:j10").Interior.ColorIndex = 0
   
4. Range("a1:j10").Font.ColorIndex = 0
   
5. Range("o7:o10") = ""
   
6. 
   
7. ar = Range("a1:j10")
   
8. ReDim br(1 To 10, 1 To 10) '存放累加值
   
9. ReDim cr(1 To 10, 1 To 10) '存放路径
   
10. ar(1, 1) = 0: ar(10, 10) = 0: cr(1, 1) = "A1" '初始值
    
11. 
    
12. '第一列逐个累加
    
13. For i = 2 To 10
    
14.     br(i, 1) = br(i - 1, 1) + ar(i, 1)
    
15.     cr(i, 1) = cr(i - 1, 1) & "->" & Cells(i, 1).Address(0, 0)
    
16. Next
    
17.    
    
18. '第一行逐个累加
    
19. For j = 2 To 10
    
20.     br(1, j) = br(1, j - 1) + ar(1, j)
    
21.     cr(1, j) = cr(1, j - 1) & "->" & Cells(1, j).Address(0, 0)
    
22. Next
    
23. 
    
24. 'br从第二行第二列开始循环，比较当前格的上一格和左一格的大小，（上，左都是累加值）
    
25. '取较大的值+ar的当前值=br当前值
    
26. For i = 2 To 10
    
27.     For j = 2 To 10
    
28.         If br(i - 1, j) > br(i, j - 1) Then
    
29.             br(i, j) = br(i - 1, j) + ar(i, j)
    
30.             cr(i, j) = cr(i - 1, j) & "->" & Cells(i, j).Address(0, 0)
    
31.         Else
    
32.             br(i, j) = br(i, j - 1) + ar(i, j)
    
33.             cr(i, j) = cr(i, j - 1) & "->" & Cells(i, j).Address(0, 0)
    
34.         End If
    
35.     Next
    
36. Next
    
37. 
    
38. 'br(10,10)即为最大值
    
39. [o7] = "去程捡到" & br(10, 10) & "金币"
    
40. [o8] = "去程路径:" & cr(10, 10)
    
41. 
    
42. '着色
    
43. t = Split(cr(10, 10), "->")
    
44. For Each cel In t
    
45.     Range(cel).Interior.ColorIndex = 33
    
46.     r = Range(cel).Row
    
47.     c = Range(cel).Column
    
48.     ar(r, c) = 0
    
49. Next
    
50. 
    
51. 
    
52. '=====================================================================
    
53. '回程
    
54. 
    
55. ReDim br(1 To 10, 1 To 10) '存放累加值
    
56. ReDim cr(1 To 10, 1 To 10) '存放路径
    
57. 'ar(1, 1) = 0: ar(10, 10) = 0
    
58. cr(10, 10) = "J10"
    
59.    
    
60. For i = 9 To 1 Step -1
    
61.     br(i, 10) = br(i + 1, 10) + ar(i, 10)
    
62.     cr(i, 10) = cr(i + 1, 10) & "->" & Cells(i, 10).Address(0, 0)
    
63. Next
    
64.    
    
65. For j = 9 To 1 Step -1
    
66.     br(10, j) = br(10, j + 1) + ar(10, j)
    
67.     cr(10, j) = cr(10, j + 1) & "->" & Cells(10, j).Address(0, 0)
    
68. Next
    
69. 
    
70.     For i = 9 To 1 Step -1
    
71.         For j = 9 To 1 Step -1
    
72.             If br(i + 1, j) > br(i, j + 1) Then
    
73.                 br(i, j) = br(i + 1, j) + ar(i, j)
    
74.                 cr(i, j) = cr(i + 1, j) & "->" & Cells(i, j).Address(0, 0)
    
75.             Else
    
76.                 br(i, j) = br(i, j + 1) + ar(i, j)
    
77.                 cr(i, j) = cr(i, j + 1) & "->" & Cells(i, j).Address(0, 0)
    
78.             End If
    
79.         Next
    
80.     Next
    
81. 
    
82. [o9] = "回程捡到" & br(1, 1) & "金币"
    
83. [o10] = "回程路径:" & cr(1, 1)
    
84. t = Split(cr(1, 1), "->")
    
85.     For Each cel In t
    
86.         Range(cel).Interior.ColorIndex = 34
    
87.     Next
    
88. End Sub
    

复制代码

lxdexcel

有个事实，取得去程最大值，清除所检金币，再取得回程最大值，两者相加并不是最优解。看下面例子

*  1  8  2  *
*  3  9  4  *
*  *  *  *  *
*  *  *  *  *
*  *  *  *  *
去程 1+8+9+4=22 回程   3  最大 25

最优解 去程 1+8+2+4  =15（非去程最大） 回程 9+3=12  最大27

yynrzwh

lxdexcel 发表于 2024-4-28 19:09
有个事实，取得去程最大值，清除所检金币，再取得回程最大值，两者相加并不是最优解。看下面例子

*  1   ...

对哦，有什么解决思路吗？
我这方法只能找到单程的最大值。
双程最大值是不是只能用版主说的“双线动态规划“了？

micch

目的是求最优路径，所以证明算法错了。

所以从逻辑上，不能用最优路径走左上到右下，因为有的金币可以留给回程捡。

yynrzwh

micch 发表于 2024-4-28 20:45
目的是求最优路径，所以证明算法错了。

所以从逻辑上，不能用最优路径走左上到右下，因为有的金币可以留 ...

是的，没什么思路了。