从点数组中返回所有三角形的最快方法



我在数组arr()中有很多点。在VBA中,返回所有可能从这些点绘制的三角形的数组combi()的最快、最有效的方法是什么?

我整理了一个简单的剧本,它在少数方面很有魅力。但随着我加更多的点,它会以指数级的速度减慢。下面是我所拥有的一个简化版本。

请注意:您将在我的代码中看到,我正在进行一些基本检查,以确保三角形中的所有顶点都不同。我还将每个点分开,并按"大小"排序。我这样做的原因是我需要删除重复的三角形。当然,如果你提出的实现找到了没有重复的三角形,那么这将是最佳的

我的代码:

Sub find_triangles()
Dim arr(6) As Variant
Dim combi() As Variant

arr(0) = 1
arr(1) = 2
arr(2) = 3
arr(3) = 4
arr(4) = 5
arr(5) = 6
'arr(x)= x ... etc.
ReDim combi(0)
For i = 1 To UBound(arr)
For j = 1 To UBound(arr)
For k = 1 To UBound(arr)
If Not i = j And Not j = k And Not i = k Then
m = Array(i, j, k)
ReDim temp(2)
temp(0) = Application.Small(m, 1)
temp(1) = Application.Small(m, 2)
temp(2) = Application.Small(m, 3)
combi(UBound(combi)) = temp(0) & "-" & temp(1) & "-" & temp(2)
ReDim Preserve combi(UBound(combi) + 1)
End If
Next
Next
Next
End Sub

@Noobster,

我可以在您的代码中看到几个性能瓶颈。

正如@Nathan_Sav所建议的,反复调整combi的大小是一个问题。更好的做法是,最初宣布上限为100,然后根据需要提高上限;

作为循环的一部分,您将反复检查arr的大小,以查看必须为i、j和k循环多少次。最好将arr的大小存储在一个变量中,并在循环中使用它。

您还可能发现嵌套if语句而不是同时执行它们会有所帮助。因此,如果是i<>j,则代码不需要检查是j<>k还是i<>k

最后,我想我可以看到一种方法来改进逻辑,只得到唯一的三角形,假设"1-2-3"one_answers"1-3-2"是相同的。不是循环j从1到极限,而是循环j从i+1到极限,循环k从j+1到极限。这既大大减少了代码的迭代次数,又消除了检查相等性的需要。也许是这样的:

intUpper = UBound(arr)
ReDim combi(0 To 100)
For intLoop1 = 1 To intUpper
For intLoop2 = intLoop1 + 1 To intUpper
For intLoop3 = intLoop2 + 1 To intUpper
combi(intCount) = intLoop1 & "-" & intLoop2 & "-" & intLoop3
intCount = intCount + 1
If intCount Mod 100 = 0 Then ReDim Preserve combi(0 To intCount + 100)
Next intLoop3
Next intLoop2
Next intLoop1
If intCount > 0 Then ReDim Preserve combi(0 To intCount)

问候,

最新更新