|
[广告] Excel易用宝 - 提升Excel的操作效率 · Excel / WPS表格插件 ★ 免费下载 ★ ★ 使用帮助★
上次测试了求树任意结点路径,发现按父结点往根双向收敛比简单按结点所连边穷举搜索效果高多了,这几天琢磨怎样按树的结构来求有回路的图路径,似乎有点眉目。我的思路是,任一选一点为根,先构建一棵树(由N个结点和N-1条边),剩余边做为连枝。将每一连枝与两点在树中路径构成回路做互赋父结点处理。依然换父结点往根双向收敛求任两点路径,只是这次父结点不是唯一的了。在本次汽车寻路中基本实现实找出全部路径,只是如果根点不为要搜索的两点时,因为求路径过程有减枝操作,所遍历的路径有重复的,用字典筛一下就行了。(根如设为要搜索的两点中的任一个都不会有重复,因为这时没有减枝)。刚学不久,代码没有优化。
- <p>Option Explicit
- Dim DicEdge, DicNode, ArrPath(), r&</p><p>Sub MyMain()
- Dim i&, j&, x$, y$, Arr, NumNode%, b(), s, k, t, d
- Set DicEdge = CreateObject("Scripting.Dictionary")
- Set DicNode = CreateObject("Scripting.Dictionary")
- Set d = CreateObject("Scripting.Dictionary")
- [c2:d1000].ClearContents
- Arr = Sheets("ÌâÄ¿").[a1].CurrentRegion
- For i = 2 To UBound(Arr)
- x = Arr(i, 1) & Arr(i, 2): y = Arr(i, 2) & Arr(i, 1)
- If DicEdge.exists(x) = False Then DicEdge(x) = Arr(i, 3)
- If DicEdge.exists(y) = False Then DicEdge(y) = Arr(i, 3)
- If DicNode.exists(Arr(i, 1)) = False Then DicNode(Arr(i, 1)) = ""
- If DicNode.exists(Arr(i, 2)) = False Then DicNode(Arr(i, 2)) = ""
- Next
- NumNode = DicNode.Count: DicNode.RemoveAll: r = 0: ReDim b(1 To UBound(Arr) - NumNode): ReDim ArrPath(1 To 1)
- Call CreatSimpleTree(Arr, [b2].Value, NumNode)
- For i = NumNode + 1 To UBound(Arr)
- r = 0
- Call LSearch(Arr(i, 1), Arr(i, 2), "")
- b(i - NumNode) = ArrPath(1)
- Next
- Call CreateComplexTree(b)
- r = 0
- Call LSearch([a2].Value, [b2].Value, "")
- For i = 1 To UBound(ArrPath)
- If d.exists(ArrPath(i)) = False Then d(ArrPath(i)) = Array(0, ArrPath(i))
- Next
- t = d.items
- For i = 0 To UBound(t)
- s = Split(t(i)(1), "-")
- For j = 0 To UBound(s) - 1
- t(i)(0) = t(i)(0) + DicEdge(s(j) & s(j + 1))
- Next
- Next
- [c2].Resize(d.Count, 2) = Application.Transpose(Application.Transpose(t))
- [c2].Resize(d.Count, 2).Sort ([c2])
- Columns("C:D").AutoFit
- End Sub</p><p>Sub CreatSimpleTree(ByRef a, ByVal RootNode$, ByVal n%)
- Dim i%, j%, k%, m%, temp, b()
- a(1, 1) = RootNode: a(1, 2) = RootNode: a(1, 3) = 0: DicNode(RootNode) = Array(RootNode)
- k = 1: m = 1
- Do
- For i = m + 1 To UBound(a)
- If (a(i, 1) = a(k, 1) And Not DicNode.exists(a(i, 2))) Or (a(i, 2) = a(k, 1) And Not DicNode.exists(a(i, 1))) Then
- m = m + 1
- If a(i, 1) = a(k, 1) Then
- temp = a(i, 1): a(i, 1) = a(i, 2): a(i, 2) = temp:
- End If
- If i > m Then
- For j = 1 To 3
- temp = a(m, j): a(m, j) = a(i, j): a(i, j) = temp
- Next
- End If
- DicNode(a(m, 1)) = Array(a(m, 2))
- End If
- Next
- k = k + 1
- Loop Until m >= n
- End Sub</p><p>Sub LSearch(ByVal node1$, ByVal node2$, ByVal StrL$)
- Dim i%, j%, m%, Nstr$, Nnode$, s
- If node1 = node2 Then
- Nstr = StrL & node2
- r = r + 1: ReDim Preserve ArrPath(1 To r): ArrPath(r) = Nstr
- Else
- If DicNode(node1)(0) = node1 Then
- Nstr = StrL & node1 & "-"
- Call RSearch(node1, node2, Nstr, "")
- Else
- For i = 0 To UBound(DicNode(node1))
- Nnode = DicNode(node1)(i)
- If InStr(StrL, Nnode) = 0 Then
- Nstr = StrL & node1 & "-"
- Call LSearch(Nnode, node2, Nstr)
- End If
- Next
- End If
- End If
- End Sub</p><p>Sub RSearch(ByVal node1$, ByVal node2$, ByVal StrL$, ByVal StrR$)
- Dim i%, Nstr$, Nnode$
- If node2 = node1 Then
- Nstr = StrL & node2 & StrR
- r = r + 1: ReDim Preserve ArrPath(1 To r): ArrPath(r) = Nstr
- Else
- For i = 0 To UBound(DicNode(node2))
- Nnode = DicNode(node2)(i)
- If InStr(StrL, Nnode) = 0 Then
- If InStr(StrR, Nnode) = 0 Then
- Nstr = "-" & node2 & StrR
- Call RSearch(node1, Nnode, StrL, Nstr)
- End If
- Else
- Nstr = Split(Replace(StrL, Nnode, "|"), "|")(0)
- Nstr = Nstr & Nnode & "-" & node2 & StrR
- r = r + 1: ReDim Preserve ArrPath(1 To r): ArrPath(r) = Nstr
- End If
- Next
- End If
- End Sub</p><p>Sub CreateComplexTree(ByRef a())
- Dim i%, j%, s, b(), m%, n%
- For i = 1 To UBound(a)
- s = Split(a(i), "-")
- For j = 0 To UBound(s)
- b = DicNode(s(j))
- m = (j + UBound(s)) Mod (UBound(s) + 1)
- If Application.IsError(Application.Match(s(m), b, 0)) Then
- n = UBound(b) + 1
- ReDim Preserve b(n)
- b(n) = s(m)
- DicNode(s(j)) = b
- End If
- m = (j + 1) Mod (UBound(s) + 1)
- If Application.IsError(Application.Match(s(m), b, 0)) Then
- n = UBound(b) + 1
- ReDim Preserve b(n)
- b(n) = s(m)
- DicNode(s(j)) = b
- End If
- Next
- Next
- End Sub
- </p><p> </p>
复制代码
|
本帖子中包含更多资源
您需要 登录 才可以下载或查看,没有账号?免费注册
x
|