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

大灰狼1976

昨天写了一个，稍大数据（5000左右节点）验证中。

大灰狼1976

昨天用本贴1楼的随机数生成工具做了一下测试，7000多个节点的情况下，得到的最大两点距离为10，第一感觉比较离谱，后来一分析也可能是正确的。
目前的生成工具，是每个节点随机生成1~10个分支，按平均5个算，5、25、125、625、3125、15625（已超过测试所需节点数），根节点到最远端只有5个距离，那两个最远点就是在距离10左右。
另外，如果是随机树的话，实际上每个循环剪除的叶子数是非常多的，树复杂度会呈指数级下降（如上数据的话，第1次可剪除15625个叶子），个人认为效率较高。

大灰狼1976

时间的音符 发表于 2023-9-1 09:10
..............................

楼上SQL高手的答案先不说，因为我目前还看不懂，你的附件测试了一下，使用同一个树数据，得出的3个结果都是相同的，应该没有错误。又想了一下，还有简化的空间，原来想的每个分枝处保留两个最长节点数据，实际上仔细想了一下，这个是不需要的，如果这两个点就是树的最大距离点，反正临时变量里会记录，如果它不是，在向上层父节点传递数据时，会舍去距离较小的点，保留两个没有必要。

大灰狼1976

全部揉进了一个function，3个函数中我最慢。

1. Public Function LongestPath(ByVal strTree As String) As String 'Long
   
2. Dim arrTmp, aTmp, arrMain, Dis&, i&, d As Object, c, disTmp&, sTmp$
   
3. Dim longestPnt$, parentPnt$, thisDis&, longestTmp(2), lTmp&
   
4. Set d = CreateObject("scripting.dictionary")
   
5. Dis = 1   '可扩展功能,strTree内可追加每个节点间的非固定距离如："2;1;3,3;1;2,4;1;5"
   
6. arrTmp = Split(strTree, ";")
   
7. ReDim arrMain(1 To arrTmp(0), 2)
   
8. For i = 1 To UBound(arrTmp)
   
9.   aTmp = Split(arrTmp(i), ",")
   
10.   arrMain(aTmp(0), 0) = arrMain(aTmp(0), 0) & "," & aTmp(1) & ";" & Dis
    
11.   d(aTmp(0)) = d(aTmp(0)) + 1
    
12.   arrMain(aTmp(1), 0) = arrMain(aTmp(1), 0) & "," & aTmp(0) & ";" & Dis
    
13.   d(aTmp(1)) = d(aTmp(1)) + 1
    
14. Next i
    
15. Retry:
    
16. For Each c In d.keys
    
17.   If d(c) = 1 Then
    
18.     sTmp = arrMain(c, 0)
    
19.     parentPnt = Val(Mid(sTmp, 2))
    
20.     thisDis = Split(sTmp, ";")(1)
    
21.     If arrMain(c, 1) <> "" Then
    
22.       longestPnt = arrMain(c, 1)
    
23.       disTmp = arrMain(c, 2) + thisDis
    
24.     Else
    
25.       longestPnt = c
    
26.       disTmp = thisDis
    
27.     End If
    
28.     If arrMain(parentPnt, 1) = "" Then
    
29.       arrMain(parentPnt, 1) = longestPnt
    
30.       arrMain(parentPnt, 2) = disTmp
    
31.     Else
    
32.       If disTmp + arrMain(parentPnt, 2) > longestTmp(2) Then
    
33.         longestTmp(0) = arrMain(parentPnt, 1)
    
34.         longestTmp(1) = longestPnt
    
35.         longestTmp(2) = disTmp + arrMain(parentPnt, 2)
    
36.       End If
    
37.       If disTmp > arrMain(parentPnt, 2) Then arrMain(parentPnt, 2) = disTmp: arrMain(parentPnt, 1) = longestPnt
    
38.     End If
    
39.     d(parentPnt) = d(parentPnt) - 1
    
40.     d.Remove c
    
41.     arrMain(parentPnt, 0) = Replace(arrMain(parentPnt, 0), "," & c & ";" & thisDis, "")
    
42.   End If
    
43. Next c
    
44. If d.Count > 1 Then GoTo Retry
    
45. LongestPath = Join(longestTmp, ",")
    
46. End Function

复制代码