使用“模拟重力”减少一组随机生成的圆圈之间的距离

Question

我在表格上有一页由 N 个随机生成的圆圈组成。这些圆可以但不必具有不同的半径。我有一个页面，上面有一组随机放置的圆圈。值得注意的是，该集合来自用户输入。我现在需要将圆圈收集在一起，以创建尽可能最紧凑的形状。我正在考虑模拟重力来实现这一目标。

为了在给出函数之前提供一些背景知识，在数据结构中以及为每个圆提供 x、y 和 r 数据时，我还包含了一个“a”属性（加速度），在我的代码中定义为 1/r 。 a 属性将导致小圆圈对系统影响较小，而大圆圈对系统影响较大。这个“a”属性有望给我带来“重力”效果。

这是我到目前为止的工作，它在所有中心之间画了一条线，然后旨在减少中心之间的距离。然而，这就是我的问题开始出现的地方，因为我似乎无法呈现新的圆圈（要么是其他地方的错误，要么是位置实际上没有改变）。另外，我不太确定如何定义哪个圆作为 circ1 和 circ2，我的意思是由于这些标志，我的代码可能会做到这一点，以便实际上圆尝试分离！

Public Sub gravitate()
    Dim pen As New Pen(Color.LimeGreen)
    Const NumberOfAttempts As Integer = 200
    GravitationalCircles.AddRange(SortedCircles)

    Dim overlapping As Boolean = False


    For Each circ1 As Circ In SortedCircles
        For Each circ2 As Circ In SortedCircles
            If circ1.x <> circ2.x And circ1.y <> circ2.y Then
                formGraphics.DrawLine(pen, circ1.x, circ1.y, circ2.x, circ2.y)
            End If
        Next
    Next

    For Each circ1 As Circ In SortedCircles
        For Each circ2 As Circ In SortedCircles
            Dim distance As Single
            Dim newcentrex_1 As Single
            Dim newcentrey_1 As Single
            Dim newcentrex_2 As Single
            Dim newcentrey_2 As Single
            If circ1.x <> circ2.x And circ1.y <> circ2.y Then
                distance = ((circ1.x - circ2.x) ^ 2 + (circ1.y - circ2.y) ^ 2) ^ 0.5
                newcentrex_1 = circ1.x + (circ1.a * distance)
                newcentrey_1 = circ1.y + (circ1.a * distance)
                newcentrex_2 = circ2.x - (circ2.a * distance)
                newcentrey_2 = circ2.y - (circ2.a * distance)


                For i As Integer = 1 To NumberOfAttempts
                    overlapping = False
                    For Each c As Circ In SortedCircles
                        distance = ((c.x - newcentrex_1) ^ 2 + (c.y - newcentrey_1) ^ 2) ^ 0.5
                        If distance <= c.R + circ1.R Then
                            overlapping = True
                            Exit For
                        End If
                    Next
                    If Not overlapping Then
                        GravitationalCircles(SortedCircles.IndexOf(circ1)) = New Circ(circ1.R, newcentrex_1, newcentrey_1)
                    End If
                Next

                For i As Integer = 1 To NumberOfAttempts
                    overlapping = False
                    For Each c As Circ In SortedCircles
                        distance = ((c.x - newcentrex_2) ^ 2 + (c.y - newcentrey_2) ^ 2) ^ 0.5
                        If distance <= c.R + circ2.R Then
                            overlapping = True
                            Exit For
                        End If
                    Next
                    If Not overlapping Then
                        GravitationalCircles(SortedCircles.IndexOf(circ2)) = New Circ(circ2.R, newcentrex_2, newcentrey_2)
                    End If
                Next

            End If
        Next
    Next

End Sub

Answer 1

与我的之前的答案相比，我已经改变了一些事情。例如，我使用

System.Numeric.Vector2

表示圆心以及速度和加速度。这简化了计算，因为这种类型具有用于距离和其他计算的预定义函数，并且我们需要更少的变量。

我还向圆圈添加了

Velocity

和

Mass

属性：

Imports System.Numerics

Public Class Circle
    Public ReadOnly Property Radius As Single = Radius
    Public ReadOnly Property Mass As Single = Radius * Radius ' Area of the circle

    Public Property Center As Vector2 = Center
    Public Property Velocity As Vector2

    Public Sub New(radius As Single, center As Vector2)
        Me.Radius = radius
        Me.Center = center
    End Sub

    Public Overrides Function ToString() As String
        Return $"M={Mass:n1}, C=({Center.X:n2}, {Center.Y:n2}, v=({Velocity.X:n3}, {Velocity.Y:n3})"
    End Function
End Class

我还创建了一个模块

Space

来创建圆圈和计算。它有一个公共财产

Circles

和两个公共子

AddRandomCircles

（我其他答案的抛光版本）和

UpdatePositionsAndSpeeds

。

首先，您将调用

AddRandomCircles

一次，然后重复调用

UpdatePositionsAndSpeeds

并绘制新位置并刷新屏幕。

Module Space
    Public ReadOnly Property Circles As List(Of Circle)

    Public Sub AddRandomCircles(rectangle As RectangleF, minRadius As Single, maxRadius As Single, approxCount As Integer)
        For index = 1 To approxCount
            TryAddCircle(rectangle, minRadius, maxRadius)
        Next
    End Sub

    Private Function TryAddCircle(rectangle As RectangleF, minRadius As Single, maxRadius As Single) As Boolean
        Const NumberOfAttempts As Integer = 100

        For i As Integer = 1 To NumberOfAttempts
            Dim x = Random.Shared.NextSingle() * rectangle.Width + rectangle.Left
            Dim y = Random.Shared.NextSingle() * rectangle.Height + rectangle.Top
            Dim newCenter = New Vector2(x, y)
            Dim newRadius = Random.Shared.NextSingle() * (maxRadius - minRadius) + minRadius

            Dim overlapping = False
            For Each c As Circle In Circles
                If Vector2.DistanceSquared(c.Center, newCenter) <= (c.Radius + newRadius) ^ 2 Then
                    overlapping = True
                    Exit For
                End If
            Next
            If Not overlapping Then
                Circles.Add(New Circle(newRadius, newCenter))
                Return True
            End If
        Next
        Return False
    End Function

    Private Function GetAcceleration(circle As Circle) As Vector2
        Dim acceleration As Vector2
        For Each otherCircle In Circles
            If otherCircle IsNot circle Then
                Dim distance = Vector2.Distance(circle.Center, otherCircle.Center)
                Dim a = Vector2.Normalize(otherCircle.Center - circle.Center) * otherCircle.Mass / distance
                acceleration += a
            End If
        Next
        Return acceleration
    End Function

    Public Sub UpdatePositionsAndSpeeds()
        Const DeltaTime As Single = 0.001

        For Each circle As Circle In Circles
            circle.Velocity += DeltaTime * GetAcceleration(circle)
            circle.Center += DeltaTime * circle.Velocity
        Next
    End Sub
End Module

注意常数

DeltaTime As Single = 0.001

。您可以调整它来增加或减少重力的影响。

这个小模拟仍然缺少的是圆之间碰撞的检测。我们仍然必须以某种方式处理这些，然后让圆圈相应地改变它们的速度。