求A点到B点之间最短的一条路线(看谁速度最快)

彭希仁 · 发表于 2008-11-9 09:26

以下是有点像灌水原理解题代码
Sub xi()
Dim i As Long
Dim j As Long
Dim jj As Long
Dim x As Long
Dim y As Long
t = Timer
arr = Range("A1:AE" & [b65536].End(xlUp).Row)
ReDim arr1(1 To 1000, 1 To 4) As Long

y = 1: yy = 3: x = 1
arr1(1, 1) = 2
arr1(1, 2) = 2
For z = 1 To 999999999       '灌水
      xx = x
      x = 0
      For i = 1 To xx
         For j = -1 To 1
            For jj = -1 To 1
                  If j * jj = 0 Then
                     If arr(arr1(i, y) - j, arr1(i, y + 1) - jj) = -1 Then
                        arr(arr1(i, y) - j, arr1(i, y + 1) - jj) = z
                        x = x + 1
                        arr1(x, yy) = arr1(i, y) - j '记录位置
                        arr1(x, yy + 1) = arr1(i, y + 1) - jj
                     End If
                  End If
            Next
         Next
      Next i
      If y = 1 Then  '交换位置
         y = 3: yy = 1
      Else
         y = 1: yy = 3
      End If
      If x = 0 Then Exit For
Next z
x = UBound(arr) - 1
y = 2
For i = arr(x, y) To 1 Step -1       '找到回家的路
      For j = -1 To 1                '
         For jj = -1 To 1
            If j * jj = 0 Then
                  If arr(x - j, y - jj) = i Then
                     arr(x, y) = 1
                     x = x - j
                     y = y - jj
                     GoTo ren:
                  End If
            End If
         Next
      Next
ren:
Next i
Range("A1:AD" & [b65536].End(xlUp).Row) = arr
MsgBox ("耗时" & Timer - t & "秒")
End Sub

[ 本帖最后由彭希仁于 2008-11-9 20:47 编辑 ]

彭希仁 · 发表于 2008-11-9 09:48

原帖由 winland 于 2008-11-8 16:02 发表
原来彭兄弟的灌水法和我的方法是一样的。把递归去掉，改了一下代码。找最短路径挺快，就是画上最短路径比较慢了。
425816

这个方法的速度对这种两三个分支路线的寻找来说还没什么，假如设置障碍比较少的话，效率 ...

的确方法一样．不过速度上要想再提高还真有难度，因为画上最短路径没法提速．

zlf2008 · 发表于 2008-11-9 11:03

好像楼主出的题目是走迷宫或推箱子吧

彭希仁 · 发表于 2008-11-10 14:44

原帖由 zlf2008 于 2008-11-9 11:03 发表
好像楼主出的题目是走迷宫或推箱子吧

没有,就是走迷宫,不过是超大的迷宫.

HHAAMM · 发表于 2009-6-23 18:18

If y = 1 Then  '交换位置
         y = 3: yy = 1
      Else
         y = 1: yy = 3
      End If
呵呵，两边换着用，再用For i = 1 To xx加以限定范围，有意思！！
不知这样跟用两个数组的差别大不大

HHAAMM · 发表于 2009-6-23 18:21

............
if a then
arr1(x, 1) = arr2(i, 1) - j '记录位置
arr1(x, 2) = arr2(i, 2) - jj
else
arr2(x, 1) = arr1(i, 1) - j
arr2(x, 2) = arr1(i, 2) - jj
end if
............
if a then a=false

[ 本帖最后由 HHAAMM 于 2009-6-23 18:23 编辑 ]

HHAAMM · 发表于 2009-6-23 18:40

加个判断，如果已经有水灌到B的门口了，就终止循环
这样，在道路复杂的情况下，可以少很多循环，但每次都要if，是不是又得不偿失！！

彭希仁 · 发表于 2009-6-25 19:16

原帖由 HHAAMM 于 2009-6-23 18:18 发表
If y = 1 Then  '交换位置
         y = 3: yy = 1
      Else
         y = 1: yy = 3
      End If
呵呵，两边换着用，再用For i = 1 To xx加以限定范围，有意思！！
不知这样跟用两个数组的差别大 ...

其实就是两个数组。没有别的意思，换成数组也可以，但数组不好切换

HHAAMM · 发表于 2009-6-25 19:33

彭版，俺的意思是，水可以不灌到这些圈起来的地方（57的意思）

彭希仁 · 发表于 2009-6-25 20:26

是的,可以加一个if

		自动登录	找回密码
密码			免费注册

[讨论] 求A点到B点之间最短的一条路线(看谁速度最快)