来个难度高点的：用最快的方法找出一个树内距离最远的两个节点间的距离

yiyiyicz · 发表于 2014-11-20 11:03

本帖最后由 yiyiyicz 于 2014-11-20 11:07 编辑

kangatang 发表于 2014-11-20 09:11
支持你，只因为你讲的有道理。看问题有深度，可以让思路更加开阔

其实我也是在开一个排产的帖子时，遇到了一个就是图论范畴的算法。推敲教科书给的方法，发现在特例的情况下不行，后在EH中也查到了这个算法（教科书没有代码），依然是特例不行。而这种特例在数学中算作特例，可是在实际中却是时常会出现。于是发现，EH中有些算法经不起推敲
当然，那个帖子就先放在了那里。解决同样的问题，还有其他的算法。只是需要时间把原理写成VB/VBA的代码
这些，对于非软件、数学专业，而且是在业余琢磨的我们来说，只能等有时间再折腾它了。
我只是提醒各位，在EH中看到的代码、算法，作为参考没有问题，但要派用场解决问题时，务必小心。我们要的是解决实际问题，华而不实会招来麻烦的
从EH的VBA版块看，有几人的写代码还是挺棒的，没有发现有严重漏洞。关键是发帖的介绍要到位，自己心里一定要清清楚楚

kangatang · 发表于 2014-11-20 12:56

本帖最后由 kangatang 于 2014-11-20 13:13 编辑

玩游戏学到的技能都用上了

都闲得蛋疼。不再理会，下午还有一车砖去搬一下。

Moneky · 发表于 2014-11-20 14:17

太丧心病狂了。大冷天的的，怎么还有火苗了，有火带给大家温暖烤烤就行，可千万不要把人点燃了。预留个位置关注一下。

wcymiss · 发表于 2014-11-20 14:26

lee1892 发表于 2014-11-14 14:37
下述代码可以按题目格式生成一个随机树的字符串

这样好像更随机些：（随机选择父节点）

Function RandomTree2$()
Dim nCnt%, i%, nInd%, nLast%, nChildNumMax%
Randomize
nCnt = Int(Rnd * 100) + 1 '总节点个数
nChildNumMax = 10 '每个节点最多拥有子节点个数
RandomTree2 = CStr(nCnt)
For i = 2 To nCnt
nInd = Int(Rnd * (i - 1)) + 1 '从比自己小的节点中选择一个作为父节点
nLast = i
RandomTree2 = RandomTree2 & ";" & CStr(nInd) & "," & CStr(nLast)
Next
End Function

复制代码

wcymiss · 发表于 2014-11-20 14:27

本帖最后由 wcymiss 于 2014-11-21 09:34 编辑

再上个更随机的：

Function RandomTree3$() '随机根节点，随机顺序，随机父子关系
Dim nCnt%, i%, nInd%, nLast%
Dim arr%(), r%, j%
Randomize
nCnt = Int(Rnd * 10) + 1 '总节点个数
RandomTree3 = CStr(nCnt)
ReDim arr(1 To nCnt) '洗牌
For i = 1 To nCnt
arr(i) = i
Next
For i = nCnt To 1 Step -1
r = Int(Rnd * i) + 1
j = arr(r)
arr(r) = arr(i)
arr(i) = j
Next
For i = 2 To nCnt '随机选择“父”节点
nInd = arr(Int(Rnd * (i - 1)) + 1)
nLast = arr(i)
If Rnd < 0.5 Then
RandomTree3 = RandomTree3 & ";" & CStr(nInd) & "," & CStr(nLast)
Else
RandomTree3 = RandomTree3 & ";" & CStr(nLast) & "," & CStr(nInd)
End If
Next
End Function

复制代码

除了断号，其他的应该都有了。断号也不难，只是后续处理多了些代码。

Moneky · 发表于 2014-11-20 16:30

本帖最后由 Moneky 于 2014-11-20 23:39 编辑

先扔一块砖。
无脑穷举法，基本上3分钟内可以求出（用附件中的代码生成的数据），没有仔细看过数据，但怎么最长的才几十这个数量级，难道一个节点有N多个儿子？

Public Function LongestPath(ByVal strTree As String) As Long
' Dim s As String
Dim arr, brr
Dim i As Long, j As Long, t As Long, lCount As Long, N() As Long
Dim maxI As Long, maxJ As Long, maxC As Long
Dim d As New Dictionary
LongestPath = 1
' s = "8;1,2;1,3;2,4;2,6;3,5;5,7;5,8"
' arr = Split(s, ";")
arr = Split(strTree, ";")
lCount = CLng(arr(0))
ReDim N(1 To lCount)
For i = 1 To UBound(arr)
brr = Split(arr(i), ",")
N(CLng(brr(1))) = CLng(brr(0))
Next
For i = 2 To lCount - 1
For j = i + 1 To lCount
t = N(j): c = 0
If t = i Then c = 1: GoTo V_END
Do
c = c + 1
d(t) = c
t = N(t)
If t = i Then c = c + 1: GoTo V_END1
Loop Until t = 0
t = N(i): c = 1
If t = j Then c = 1: GoTo V_END1
Do
If d(t) > 0 Then
c = c + d(t)
GoTo V_END1
Else
c = c + 1
d(t) = c
t = N(t)
If t = j Then c = c + 1: GoTo V_END1
End If
Loop Until t = 0
V_END1:
d.RemoveAll
V_END:
Debug.Print i, j, c
If c > LongestPath Then LongestPath = c ': maxI = i: maxJ = j
Next
Next
End Function

复制代码

晕，原来没有考虑到下面点评中的情况，直接剔除了1号节点了。当然代码改改还是比较容易的，只需改成：

Public Function LongestPath(ByVal strTree As String) As Long
' Dim s As String
Dim arr, brr
Dim i As Long, j As Long, t As Long, lCount As Long, n() As Long
' Dim maxI As Long, maxJ As Long, maxC As Long
Dim d As New Dictionary
LongestPath = 1
' s = "8;1,2;1,3;2,4;2,6;3,5;5,7;5,8"
' arr = Split(s, ";")
arr = Split(strTree, ";")
lCount = CLng(arr(0))
ReDim n(1 To lCount)
For i = 1 To UBound(arr)
brr = Split(arr(i), ",")
n(CLng(brr(1))) = CLng(brr(0))
Next
For i = 1 To lCount - 1 '其实就只是把这一句的2改成了1
For j = i + 1 To lCount
t = n(j): c = 0
If t = i Then c = 1: GoTo V_END
Do
c = c + 1
d(t) = c
t = n(t)
If t = i Then c = c + 1: GoTo V_END1
Loop Until t = 0
t = n(i): c = 1
If t = j Then c = 1: GoTo V_END1
Do
If d(t) > 0 Then
c = c + d(t)
GoTo V_END1
Else
c = c + 1
d(t) = c
t = n(t)
If t = j Then c = c + 1: GoTo V_END1
End If
Loop Until t = 0
V_END1:
d.RemoveAll
V_END:
' Debug.Print i, j, c
If c > LongestPath Then LongestPath = c ': maxI = i: maxJ = j
Next
Next
End Function

复制代码

hehex · 发表于 2014-11-20 16:42

lee1892 发表于 2014-11-19 23:24
您这一大堆话，我除了看出来是在搅合以外，愣没看明白在说啥。
要不这样，您要觉得这题easy，您把代码发 ...

这位大神牛的很，您别和人家较劲。
用VBA 实现面向对象，和实践应用23种设计模式的大神，思路和您一样嘛？
还是赶紧上答案吧，俺不会做，等着看呢。

ak47ok · 发表于 2014-11-20 18:03

看来是曲高和寡，我是来打酱油的
向老师学习！我终于自己搞定正交表了。

wcymiss · 发表于 2014-11-21 09:14

21号了，发代码了：

Private arrTree()
Private arrNodeLength() As Integer
Private arrNodeCount() As Integer
Private MaxLength As Integer
Private MaxNodeIndex As Integer
Private Sub GetNodeLenght(NodeIndex As Integer, NodeLength As Integer)
Dim i As Integer
Dim N As Integer
arrNodeLength(NodeIndex) = NodeLength
If MaxLength < NodeLength Then MaxLength = NodeLength: MaxNodeIndex = NodeIndex
For i = 1 To arrNodeCount(NodeIndex)
N = arrTree(NodeIndex)(i)
If arrNodeLength(N) = 0 Then Call GetNodeLenght(N, NodeLength + 1)
Next
End Sub
Public Function LongestPath(ByVal strTree As String) As Long
Dim i As Integer
Dim arr, Temp
Dim arrNode() As Integer
Dim Node1 As Integer
Dim Node2 As Integer
Dim NodeCount As Integer
Dim MaxL As Integer
arr = Split(strTree, ";")
ReDim arrTree(1 To arr(0))
ReDim arrNode(1 To arr(0))
ReDim arrNodeCount(1 To arr(0))
ReDim arrNodeLength(1 To arr(0))
For i = 1 To arr(0)
arrTree(i) = arrNode
Next
For i = 1 To UBound(arr)
Temp = Split(arr(i), ",")
Node1 = Temp(0)
Node2 = Temp(1)
NodeCount = arrNodeCount(Node1) + 1
arrTree(Node1)(NodeCount) = Node2
arrNodeCount(Node1) = NodeCount
NodeCount = arrNodeCount(Node2) + 1
arrTree(Node2)(NodeCount) = Node1
arrNodeCount(Node2) = NodeCount
Next
MaxLength = 0
Call GetNodeLenght(1, 1)
ReDim arrNodeLength(1 To arr(0))
Call GetNodeLenght(MaxNodeIndex, 1)
LongestPath = MaxLength - 1
End Function

复制代码

Moneky · 发表于 2014-11-21 09:53

wcymiss 发表于 2014-11-20 14:27
再上个更随机的：除了断号，其他的应该都有了。断号也不难，只是后续处理多了些代码。

4;2,1;3,1;2,4
这是什么意思？
3 2
\ / \
1 4
1有两个爸爸

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

[讨论] 来个难度高点的：用最快的方法找出一个树内距离最远的两个节点间的距离

点评

点评

点评

点评

点评

评分

点评

评分

浏览过的版块