|
楼主 |
发表于 2013-10-10 13:06
|
显示全部楼层
现在我们得到了用于计算的一个简单的图的数据结构,顶点是aPads数组中的元素,边则通过顶点的Links集合来表达。显然这是一个无向的简单图。
可以采用深度优先遍历来找到“答案路径”,其伪代码如下:
[code=vb]Sub 寻找路径(ByVal 当前顶点)
For Each 下一个顶点 In 当前顶点.连通的顶点集合
If 未经过(下一个顶点) Then
If 下一个顶点 = 起始点 And 已通过顶点数量 = 总数量 - 1 Then
找到答案路径,记录该路径
ElseIf 下一个顶点 <> 起始点 And 已通过顶点数量 < 总数量 - 1 Then
添加下一个顶点至已通过顶点集合
Call 寻找路径(下一个顶点)
自已通过顶点集合中移除下一个顶点
End If
End If
Next
End Sub[/code]
为此,我们需要设置几个全局变量,实际的实现代码如下:
[code=vb]Private dicPathed As Object ' 查找路径时,已经通过的顶点编号作为字典的Key
Private nPadStart As Integer ' 起始顶点元素编号
Private nSolveCnt As Long ' 找到的答案路径的计数
Private aSolve() As String ' 答案路径结果数组
Private Sub FindHamiltonianCycle(ByVal nPadNow%)
Dim nNext, aPathed, i%
'// nNext 当前顶点所连通的下一个顶点
'// aPathed 临时数组,记录答案路径用
For Each nNext In aPads(nPadNow).Links
If Not dicPathed.exists(nNext) Then
' 如果下一个顶点未通过则继续判断,否则跳过
If nNext = nPadStart And dicPathed.Count = 13 Then
' 如果下一个顶点是起始顶点,并且已经通过了13个顶点
' (共14个顶点,起始顶点不在已经通过的顶点字典中)
' 记录该路径至结果数组
aPathed = dicPathed.keys
nSolveCnt = nSolveCnt + 1
aSolve(nSolveCnt, 0) = aPads(nPadStart).Name
For i = 0 To dicPathed.Count - 1
aSolve(nSolveCnt, i + 1) = aPads(aPathed(i)).Name
Next
ElseIf nNext <> nPadStart And dicPathed.Count <= 13 Then
' 如果下一个顶点不是起始顶点,并且已经通过的顶点数量不大于13
dicPathed(nNext) = True ' 添加下一个顶点至字典
FindHamiltonianCycle nNext ' 递归寻找下一个顶点为当前点
dicPathed.Remove nNext ' 该下一个顶点查找完成,由字典中删除
End If
End If
Next
End Sub[/code]
有了上述代码后,对每个顶点循环调用即可获得全部答案路径,比如:
[code=vb]For nPadStart = 0 To 13
FindHamiltonianCycle nPadStart
Next[/code]
我们注意到,这个图是左右对称的,可想而知仅需要对左侧的7个点作为起始点查找,而后镜像,就可获得右侧的结果。于是有了如下代码作为查找全部路径的主过程:
[code=vb]Public Sub FindPath()
Dim t#, tt#, s$, dicMirror As Object, nMirror%, i&, j&
Sheet1.Columns("A:N").ClearContents
t = Timer: tt = t
GenerateGraph
s = vbCrLf & vbCrLf & "Generate graph used: " & Format(Timer - t, "0.000s")
t = Timer
Set dicPathed = CreateObject("Scripting.Dictionary")
ReDim aSolve(200, 13)
nSolveCnt = -1
s = s & vbCrLf & "Claim memory used: " & Format(Timer - t, "0.000s")
t = Timer
Set dicMirror = CreateObject("Scripting.Dictionary")
For nPadStart = 0 To 6
FindHamiltonianCycle nPadStart
nMirror = IIf(nPadStart < 3, nPadStart + 11, nPadStart + 4)
dicMirror(aPads(nPadStart).Name) = aPads(nMirror).Name
dicMirror(aPads(nMirror).Name) = aPads(nPadStart).Name
Next
For i = 0 To nSolveCnt
For j = 0 To 13
aSolve(i + nSolveCnt + 1, j) = dicMirror(aSolve(i, j))
Next
Next
nSolveCnt = nSolveCnt * 2 + 1
s = s & vbCrLf & "Searching path used: " & Format(Timer - t, "0.000s")
t = Timer
Set dicPathed = Nothing: Set dicMirror = Nothing
Sheet1.Cells(1, 1).Resize(nSolveCnt + 1, 13 + 1) = aSolve
s = s & vbCrLf & "Output to Excel used: " & Format(Timer - t, "0.000s")
s = s & vbCrLf & vbCrLf & "Totally used: " & Format(Timer - tt, "0.000s")
MsgBox s
End Sub[/code]
完整代码见附件:
[开_72]一道益智题 Lee1892.rar
(27.14 KB, 下载次数: 165)
该附件中还能显示如下动画效果:
|
|