在 Visual Basic 中针对列表中的每个其他项目测试列表中的每个项目

Question

我试图在 Visual Basic 中的表单上绘制多个圆圈，条件是它们不重叠并且不出现在彼此内部。我对此进行了功能测试，但它并不是 100% 有效。详细地说，它永远不会使圆圈以重叠的方式出现，但是，有时圆圈可以以完全相同的中心出现。这个问题让我很头疼，不知道如何解决。如果有很多圆或者有一些非常大的圆（半径超过 1000），情况会变得尤其糟糕。有趣的是，如果这些圆的半径很大，形状就会增大，以便为这些圆的出现提供空间，但有时它仍然会为多个圆选择相同的中心！

例如，如果我给它 10 个半径为 1000 的圆，其中 5 个将具有相同的中心，并且形状会增大，以便为这些圆提供显示空间而不会彼此接触。

Public Function iteration() As Boolean
    Dim random_ As New Random
    Dim v1 As Single
    Dim v2 As Single
    Dim v3 As Single



    For Each circ1 As Circ In Circles
        For Each circ2 As Circ In Circles
            If Circles.IndexOf(circ1) <> Circles.IndexOf(circ2) Then
                Dim val As Single = ((circ2.y - circ1.y) ^ 2 + (circ2.x - circ1.x) ^ 2) ^ 0.5
                If circ1.R + circ2.R > val Then
                    While True
                        v1 = (random_.Next(minValue:=300, maxValue:=860))
                        v2 = (random_.Next(minValue:=300, maxValue:=860))
                        For Each circ3 As Circ In Circles
                            If circ2.R + circ3.R > ((v2 - circ2.y) ^ 2 + (v1 - circ2.x) ^ 2) ^0.5 Then
                                Exit For
                            End If
                            Dim cpos As Integer = Circles.IndexOf(circ2)
                            Circles(cpos) = New Circ(circ2.R, v1, v2)
                            Return False
                        Next
                    End While
                End If
            End If
        Next
    Next
    Return True
End Function

下课

Answer 1

我不明白你的逻辑。为什么要将圆圈与它们本身进行比较？如果您仅添加不与现有圆圈重叠的新圆圈，则没有必要将所有圆圈与其自身进行比较，因为永远不会重叠。

您只需将新候选人与现有候选人进行比较即可。像这样的东西：

Private Circles As List(Of Circ) = New List(Of Circ)
Private random_ As New Random

Public Function AddCircle() As Boolean
    Const NumberOfAttempts As Integer = 20

    Dim x, y, r As Single

    For i As Integer = 1 To NumberOfAttempts
        x = random_.Next(minValue:=300, maxValue:=860)
        y = random_.Next(minValue:=300, maxValue:=860)
        r = random_.Next(minValue:=10, maxValue:=1000) 'Radius of new circle

        Dim overlapping As Boolean = False
        For Each c As Circ In Circles
            Dim distance As Single = ((c.x - x) ^ 2 + (c.y - y) ^ 2) ^ 0.5
            If distance <= c.R + r Then
                overlapping = True
                Exit For
            End If
        Next
        If Not overlapping Then
            Circles.Add(New Circ(r, x, y))
            Return True
        End If
    Next
    Return False
End Function