agstick版主的捡金币问题

morpheus126

才2048种。。。好像。。。直接暴力穷举。。。

yynrzwh

morpheus126 发表于 2024-4-29 09:20
才2048种。。。好像。。。直接暴力穷举。。。

不止吧？写个代码看看？

micch

要算法，穷举肯定不适合，走一个来回18步，每一步有2个方向可选。穷举不是2048

大灰狼1976

去的路线和回的路线可以交叉或重合一部分吗？当然数据只加一次。

yynrzwh

大灰狼1976 发表于 2024-4-29 12:46
去的路线和回的路线可以交叉或重合一部分吗？当然数据只加一次。

应该是可以的

大灰狼1976

加了回程确实比较难，去程最优解捡掉后加上回程最优解，不一定是整体最优解

yynrzwh

穷尽了一下起点-终点路径，好象是48620种。

lxdexcel

这是一个用动态规划比较好解决的问题，如果只是单程话则是一个标准的动态规划的过程，先做一下单程。动态规划大概是按这样的步骤解决问题，1 ，分出阶段，前后阶段存在递推关系。2 根据递推关系找出转移方程 3 按阶段进行状态转移并寻找最优解。

这道题，我们以以走过的格子数分阶段，以k标识 k=0 ---19，假设格子坐标从0开始，以x,y标记，k解段格子状态集合是所有x+y=k的格子 比如 k=0:  0,0 , k=1: 0,1 ;1,0  ,k=3: 0,3;1,2;2,1;3,0; .........
'状态转移函数 ：f(x,y)=max(f(x-1 ,y)+map(x,y),f(x,y-1+map(x,y))
以下是代码


Dim num&, max&
Dim map() As node


Public Type node
x As Long
y As Long
x1 As Long
y2 As Long
s As Long '捡的金币数
p As Long '路径方向 去程: 2 从上边来 1 从左边来,回程: 8 从上边来 4 从左边来,如果只求数量不显示路径可省略
End Type


Sub 开始()
Dim temp&(0 To 99), i&, n&, s&




ReDim map(0 To 9, 0 To 9)
Sheets("捡金币").Range("a1:j10").ClearContents
Sheets("捡金币").Range("a1:j10").Interior.Pattern = xlPatternNone
num = Sheets("捡金币").Range("m1")
max = Sheets("捡金币").Range("m2")


If num > 100 Then MsgBox "个数超出范围": Exit Sub


For i = 0 To 99
   
        temp(i) = i
   
Next


VBA.Randomize
For i = 0 To num - 1
    s = Int(max * Rnd + 1)
    n = Int(Rnd * (100 - i - 1))
    m = temp(n)
  Sheets("捡金币").Cells((m \ 10) + 1, (m Mod 10) + 1) = s
    map(m Mod 10, m \ 10).s = s
    temp(n) = temp(100 - i - 1)
Next




End Sub


Sub 单程() '仅计数
Dim s1&, s2&, k&, x&, y&


For k = 1 To 18
   For x = IIf(k < 10, 0, k - 9) To IIf(k < 10, k, 9) 'k阶段 if k<10,x取值范围0---k k>=10,x: k-9 ---9
     y = k - x
     s1 = map(x, y).s
     s2 = map(x, y).s
        
     If x > 0 Then s1 = map(x - 1, y).s + s1
           
     If y > 0 Then s2 = map(x, y - 1).s + s2
     
     
        map(x, y).s = IIf(s1 > s2, s1, s2)
        
   Next
  Next
  Sheets("捡金币").Range("p2") = map(9, 9).s


End Sub


Sub 单程1() '显示路径
Dim s1&, s2&, k&, x&, y&


For k = 1 To 18
   For x = IIf(k < 10, 0, k - 9) To IIf(k < 10, k, 9)
     y = k - x
     s1 = map(x, y).s
     s2 = map(x, y).s
        
     If x > 0 Then s1 = map(x - 1, y).s + s1
           
     If y > 0 Then s2 = map(x, y - 1).s + s2
     If s1 > s2 Then
     
        map(x, y).s = s1
        map(x, y).p = 1
     Else
        map(x, y).s = s2
        map(x, y).p = 10
        If s1 = s2 And y = 0 Then map(x, y).p = 1
     End If
   Next
  Next
  Sheets("捡金币").Range("t2") = map(9, 9).s
x = 9
y = 9




Do While 1
  Sheets("捡金币").Cells(y + 1, x + 1).Interior.ThemeColor = 6
   If map(x, y).p = 0 Then Exit Do
   
   If map(x, y).p = 1 Then
      x = x - 1
   Else
      y = y - 1
   End If


Loop
End Sub
如果有回程则问题复杂了些，但也是可以按动态规划的模式去解决

考虑以下几点：
1 对于回程可以转换为两个人从起点走到终点，这与一个人往返一次等效
2 阶段划分同单程一样
3 状态是两个点的组合
4 k阶段状态集合为 所有符合x+y=k的点(x,y)取两点所有不重复组合（形成组合的两点可以相同）
5 状态转移函数

f(x,y,x1,y1)=max(f(x-1 ,y,x1-1 ,y1)+map(x,y),
'                         f(x-1 ,y,x1 ,y1-1)+map(x,y)
'                         f(x ,y-1,x1-1 ,y1)+map(x,y)
'                         f(x ,y-1,x1 ,y1-1)+map(x,y) |x=x1 and y=y1,
'
'                         f(x-1 ,y,x1-1 ,y1)+map(x,y)+map(x1,y1),
'                         f(x-1 ,y,x1 ,y1-1)+map(x,y)+map(x1,y1)
'                         f(x ,y-1,x1-1 ,y1)+map(x,y)+map(x1,y1)
'                         f(x ,y-1,x1 ,y1-1)+map(x,y)+map(x1,y1) |x<>x1 or y<>y1）
'
'                 x+y =x1+y1

代码后续吧

yynrzwh

大神啊！
和版主的说法一样难懂。。。。

期待后续

micch

题目说动态规划是正解，那应该就是有DP办法解决。

因为是往返走，所以一个格子允许经过两次，那么状态转移的时候，一个格子就不是只看单程的方向最大就行