Lösung für Problem der Kreisausgleichung gesucht

  • VB.NET

Es gibt 31 Antworten in diesem Thema. Der letzte Beitrag () ist von Yanbel.

    ich glaub ich hab einen Lösungsansatz. Ich hab aber nix recherchiert, also entweder bin ich nun ein Erfinder, oder nur ein Neu-Erfinder des Rades.
    Also:
    Man nimmt irgendeinen Punkt M als zukünftigen Mittelpunkt, und berechnet von dem aus die Vektoren zu allen anderen Punkten.
    Optimierungs-Aufgabe ist die Minimierung der Gesamtlänge dieser Vektoren.
    Dazu muss man den Punkt bewegen.
    Für die Bewegungsrichtung habich mir ausgedacht: Man summiert die o.g. Vektoren auf, aber vektoriell!
    In Richtung des Ergebnis-Vektors muss M bewegt werden.
    Jo, und dann kann man in ein paar binären Iterationen dem optimalen Mittelpunkt sehr sehr sehr sehr nahe kommen.
    (Vielleicht muss man auch garnix iterieren, und o.g. ErgebnisVektor gibt den optimalen Mittelpunkt bereits genau an?)

    Man kann sich bildlich vorstellen, wie alle Punkte am Mittelpunkt "zerren", in verschiedene Richtungen.
    Zerr-kraft ist (analog einer physikalischen Spiralfeder) proportional zur Entfernung von M.
    Im Ergebnis wandert M genau dahin, wo die Summe aller Zerr-kräfte 0 wird, und das soll wohl der Mittelpunkt der optimalen Kreis-Ausgleichung sein.

    Dann noch den Radius bestimmen - aber das kann ja nicht mehr so wild sein (glaub Durchschnitt aller Vektor-Längen - aber sicher bin ich nicht).

    Dieser Beitrag wurde bereits 2 mal editiert, zuletzt von „ErfinderDesRades“ ()

    ErfinderDesRades schrieb:

    Optimierungs-Aufgabe ist die Minimierung der Gesamtlänge dieser Vektoren.
    Der Vorschlag gefällt mir.
    Ich würde jedoch als Kriterium wählen, dass die mittlere Längenabweichung minimal wird,
    also von allen Längen den Mittelwert bilden und die Abweichungsquadrate von Mittelwert und Einzellängen berechnet.
    Muss man halt mal ausprobieren.
    Falls Du diesen Code kopierst, achte auf die C&P-Bremse.
    Jede einzelne Zeile Deines Programms, die Du nicht explizit getestet hast, ist falsch :!:
    Ein guter .NET-Snippetkonverter (der ist verfügbar).
    Programmierfragen über PN / Konversation werden ignoriert!

    Hey Leute,

    hier der neue Algorithmus. Dieser funktioniert sehr viel sauberer und unabhängig von der Verteilung der Punkte. Viel Spaß damit ;)

    Komplexere Methode

    VB.NET-Quellcode

    1. Imports System.Drawing.Drawing2D
    2. Public Class ShowRoom
    4. Private gPathPoints As New GraphicsPath
    5. Private gPathCircle As New GraphicsPath
    6. Private gPathMidPoints As New GraphicsPath
    8. Private gPathTriangle As New GraphicsPath
    10. Private Sub ShowRoom_Load(sender As Object, e As EventArgs) Handles MyBase.Load
    11. Dim Points As New List(Of Point)
    12. Points.Add(New Point(7, 10))
    13. Points.Add(New Point(33, 3))
    14. Points.Add(New Point(75, 37))
    15. Points.Add(New Point(64, 61))
    16. Points.Add(New Point(44, 80))
    17. Points.Add(New Point(3, 75))
    18. Points.Add(New Point(-11, 36))
    20. CalcCircle(Points)
    21. End Sub
    23. Private Sub ShowRoom_Paint(sender As Object, e As PaintEventArgs) Handles Me.Paint
    24. With e.Graphics
    25. .SmoothingMode = SmoothingMode.HighQuality
    26. .DrawPath(New Pen(Color.Red, 1), gPathPoints)
    27. .DrawPath(New Pen(Color.SteelBlue, 1), gPathCircle)
    28. End With
    29. End Sub
    31. Private Sub CalcCircle(Coords As List(Of Point))
    33. Dim xMin As Single = Coords.Select(Function(n) n.X).Min
    34. Dim xMax As Single = Coords.Select(Function(n) n.X).Max
    35. Dim yMin As Single = Coords.Select(Function(n) n.Y).Min
    36. Dim yMax As Single = Coords.Select(Function(n) n.Y).Max
    38. Dim dx As Single = (xMax - xMin) / 10
    39. Dim dy As Single = (yMax - yMin) / 10
    41. Dim AxisLeft As Single = xMin - dx
    42. Dim AxisRight As Single = xMax + dx
    43. Dim AxisTop As Single = xMin - dx
    44. Dim AxisBottom As Single = xMax + dx
    46. AxisRight -= AxisLeft
    47. AxisBottom -= AxisTop
    49. Dim Points As New List(Of Point)
    50. Dim NewPoint As Point
    51. For Each elem In Coords
    52. NewPoint = New Point(elem.X - CInt(AxisLeft), elem.Y - CInt(AxisTop))
    53. Points.Add(NewPoint)
    54. gPathPoints.AddArc(New Rectangle(NewPoint.X - 1, NewPoint.Y - 1, 2, 2), 0, 360)
    55. Next
    57. AxisLeft = 0
    58. AxisTop = 0
    60. Dim MidPoint As Point = GetMid(Points)
    62. Dim Radius As Double = Points.Select(Function(n) Math.Sqrt(Math.Pow((n.X - MidPoint.X), 2) + Math.Pow((n.Y - MidPoint.Y), 2))).Average
    64. gPathCircle = New GraphicsPath
    65. gPathCircle.AddArc(New Rectangle(CInt(MidPoint.X - Radius), CInt(MidPoint.Y - Radius), CInt(Radius * 2), CInt(Radius * 2)), 0, 360)
    67. Invalidate()
    68. End Sub
    70. Private Function GetMid(Coords As List(Of Point)) As Point
    71. Dim MidPoints As New List(Of Point)
    73. Dim Used As New List(Of Point)
    75. For Each A In Coords
    76. For Each B In Coords.Except(New List(Of Point) From {A}).ToList
    77. For Each C In Coords.Except(New List(Of Point) From {A, B}).ToList
    78. If Not (Used.Contains(A) OrElse Used.Contains(B) OrElse Used.Contains(C)) Then
    79. MidPoints.Add(GetPerimeterCenter(A, B, C))
    80. End If
    81. Next
    82. Next
    83. Used.Add(A)
    84. Next
    86. Dim MidPoint As New Point(CInt(MidPoints.Select(Function(n) n.X).Average), CInt(MidPoints.Select(Function(n) n.Y).Average))
    88. Return MidPoint
    89. End Function
    91. Private Function GetPerimeterCenter(A As Point, B As Point, C As Point) As Point
    93. Dim HAX As Double = C.X + ((B.X - C.X) / 2)
    94. Dim HAY As Double = C.Y + ((B.Y - C.Y) / 2)
    95. Dim HBX As Double = C.X + ((A.X - C.X) / 2)
    96. Dim HBY As Double = C.Y + ((A.Y - C.Y) / 2)
    97. Dim HCX As Double = B.X + ((A.X - B.X) / 2)
    98. Dim HCY As Double = B.Y + ((A.Y - B.Y) / 2)
    100. Dim HA As New Point(CInt(HAX), CInt(HAY))
    101. Dim HB As New Point(CInt(HBX), CInt(HBY))
    102. Dim HC As New Point(CInt(HCX), CInt(HCY))
    104. Dim SlopeAB As Double = 0
    105. If Not A.Y - B.Y = 0 Then
    106. SlopeAB = (A.X - B.X) / (A.Y - B.Y)
    107. End If
    109. Dim SlopeBC As Double = 0
    110. If Not B.Y - C.Y = 0 Then
    111. SlopeBC = (B.X - C.X) / (B.Y - C.Y)
    112. End If
    114. Dim SlopeAC As Double = 0
    115. If Not C.Y - A.Y = 0 Then
    116. SlopeAC = (C.X - A.X) / (C.Y - A.Y)
    117. End If
    119. Dim mHA As Double = 1 / (-(Math.Pow(SlopeBC, (-1))))
    120. Dim mHB As Double = 1 / (-(Math.Pow(SlopeAC, (-1))))
    121. Dim mHC As Double = 1 / (-(Math.Pow(SlopeAB, (-1))))
    123. Dim ShiftAB As Double = HCY - (mHC * HCX)
    124. Dim ShiftBC As Double = HAY - (mHA * HAX)
    125. Dim ShiftAC As Double = HBY - (mHB * HBX)
    127. Dim Midx As Double = (ShiftAB - ShiftBC) / (mHA - mHC)
    128. Dim Midy As Double = mHC * Midx + ShiftAB
    130. gPathMidPoints.AddArc(New Rectangle(CInt(Midx) - 1, CInt(Midy) - 1, 2, 2), 0, 360)
    132. Return New Point(CInt(Midx), CInt(Midy))
    133. End Function
    135. End Class

    Bilder

    • KreisausgleichsproblemNew1.PNG

      2,99 kB, 234×151, 180 mal angesehen

    • KreisausgleichsproblemNew2.PNG

      2,96 kB, 247×151, 205 mal angesehen

    Ein Computer wird das tun, was du programmierst - nicht das, was du willst.

    das ergebnis sieht gut aus, aber wie arbeitet eiglich der algo?
    Kommt mir so vor, als würden Mittelpunkte aller möglichen dreiecke gebildet, und von deren Koordinaten dann der Durchschnittswert.
    ist das richtig, was ich mir zusammenreimte?
    Und wenn ja, ist das selbstausgedacht oder State of Art?

    Das ist korrekt, so arbeitet der Algorithmus. Ich denke nicht das das State of the Art ist. Habe ich so jedenfalls bisher nicht gefunden. Es erschien mir nur logisch, da der Umkreismittelpunkt eines Dreiecks das perfekte Ergebnis für 3 Punkte ist. Je mehr dieser Mittelpunkte ich errechne desto präzisier wird das Gesamtergebnis. In dem zweiten Bild beispielsweise arbeite ich mit 7 Punkten woraus insgesamt 70 Dreiecke gebildet werden, deren Umkreismittelpunkte einen kummilierten Mittelpunkt bilden.
    Bilder

    • Mittelpunkte.PNG

      3,13 kB, 243×143, 197 mal angesehen

    Ein Computer wird das tun, was du programmierst - nicht das, was du willst.

    Dieser Beitrag wurde bereits 1 mal editiert, zuletzt von „Yanbel“ ()

    jo, funzt auch mit annere punkte.
    Mein Ansatz ist glaub Quatsch - das mit den ziehenden Vektoren ergibt vielleicht sowas wie einen Schwerpunkt aber nicht den Mittelpunkt eines Ausgleichskreises.
    hmm - mit diesen punkten bauter wieder Mist:

    VB.NET-Quellcode

    1. Points.Add(New Point(43, 0))
    2. Points.Add(New Point(33, 3))
    3. Points.Add(New Point(7, 10))
    4. Points.Add(New Point(-11, 36))

    Ich finde deine Idee sehr gut. Es ist etwas aufwendig das zu schreiben, aber der Algo den du beschrieben hast liefert mit ziemlicher Sicherheit ein sehr präzises Ergebnis. Ich schau mal ob ich Zeit dafür finde den zu schreiben. Finde die Idee auf jeden Fall sehr spannend.

    EDIT: Hab den Fehler gerade überlesen. Schätze mal er kann damit nichts anfangen, weil drei der vier Punkte auf einer Geraden liegen. Wenn ich dem zweiten Punkt die Koordinaten (33, 2) gebe arbeitet er wieder korrekt.

    Ein Computer wird das tun, was du programmierst - nicht das, was du willst.

    Dieser Beitrag wurde bereits 1 mal editiert, zuletzt von „Yanbel“ ()

    Okay, ich habe es nochmal nachgeprüft. Die drei Punkte bilden nicht exakt eine Gerade sondern liegen so ungünstig, dass das Dreieck mit der Hypotenuse nach außen gebildet wird. Und da die drei Punkte fast auf einer Gerade liegen, liegt der Umkreismittelpunkt sehr weit außerhalb des anzunehmenden Mittelpunktes. Der vierte Punkt wird hier als "Ausreißer" gewertet und somit ist die Lösung zwar auf den ersten Blick komisch, aber witzigerweise sogar mathematisch korrekt. Die radiale Abweichung zu allen Punkten wäre bei beiden Kreisen beinahe die selbe gewesen.

    @jan99: Was meinst du dazu. Ist die Lösung für dich in Ordnung?

    Ein Computer wird das tun, was du programmierst - nicht das, was du willst.

    Dieser Beitrag wurde bereits 1 mal editiert, zuletzt von „Yanbel“ ()

    @Yanbel Nimm Deinen Code aus Post #23 und addiere auf alle X-Koordinaten der Punkte 100.
    @ErfinderDesRades Zurück zu Feld Nummer 1.
    @Yanbel Statt

    VB.NET-Quellcode

    1. Dim mHA As Double = 1 / (-(Math.Pow(SlopeBC, (-1))))
    2. Dim mHB As Double = 1 / (-(Math.Pow(SlopeAC, (-1))))
    3. Dim mHC As Double = 1 / (-(Math.Pow(SlopeAB, (-1))))
    kannst Du auch schreiben:

    VB.NET-Quellcode

    1. Dim mHA As Double = -SlopeBC
    2. Dim mHB As Double = -SlopeAC
    3. Dim mHC As Double = -SlopeAB

    Falls Du diesen Code kopierst, achte auf die C&P-Bremse.
    Jede einzelne Zeile Deines Programms, die Du nicht explizit getestet hast, ist falsch :!:
    Ein guter .NET-Snippetkonverter (der ist verfügbar).
    Programmierfragen über PN / Konversation werden ignoriert!

    Dieser Beitrag wurde bereits 1 mal editiert, zuletzt von „RodFromGermany“ ()

    Alle Punkte in ein anderes Zentrum zu setzen ist einfach

    VB.NET-Quellcode

    1. 'Vom Ursprung in ein gewähltes Zentrum (hier 100,100)
    2. Me.Point2D = Me.Point2D.Offset(New PointF(100, 100))
    4. 'Zurück in den Ursprung
    5. Me.Point2D = Me.Point2D.Offset(New PointF(-100, -100))


    VB.NET-Quellcode

    1. <Extension>
    2. Public Function Offset(p2df As PointF, _offset As PointF) As PointF
    3. Return New PointF With {.X = p2df.X + _offset.X, .Y = p2df.Y + _offset.Y}
    4. End Function
    5. <Extension>
    6. Public Function Offset(p2dfs() As PointF, _offset As PointF) As PointF()
    7. Return p2dfs.Select(Function(p2df) Offset(p2df, _offset)).ToArray
    8. End Function
    Dateien

    • KreisFitter.zip

      (3,71 kB, 48 mal heruntergeladen, zuletzt: )

    Dieser Beitrag wurde bereits 1 mal editiert, zuletzt von „exc-jdbi“ ()

    exc-jdbi schrieb:

    Alle Punkte in ein anderes Zentrum zu setzen ist einfach
    Du hast das Problem nicht verstanden, führe den obigen Code aus.
    ====
    Zuerst muss alles berechnet werden, danach wird der GraphicsPath zentriert ausgegeben.
    Falls Du diesen Code kopierst, achte auf die C&P-Bremse.
    Jede einzelne Zeile Deines Programms, die Du nicht explizit getestet hast, ist falsch :!:
    Ein guter .NET-Snippetkonverter (der ist verfügbar).
    Programmierfragen über PN / Konversation werden ignoriert!

    Dieser Beitrag wurde bereits 1 mal editiert, zuletzt von „RodFromGermany“ ()

    @RodFromGermany

    @Yanbel Nimm Deinen Code aus Post #23 und addiere auf alle X-Koordinaten der Punkte 100.

    Kann ich machen, aber ich weiß nicht in wie weit der TE hier weiter rechnen will, daher wird hier ein Path ermittelt der möglichst Offset bereinigt ist. Das kann dann jeder für seine eigenen Zwecke anpassen.


    kannst Du auch schreiben:

    VB.NET-Quellcode

    1. Dim mHA As Double = -SlopeBC
    2. Dim mHB As Double = -SlopeAC
    3. Dim mHC As Double = -SlopeAB



    Stimmt, da geb ich dir Recht.

    Ein Computer wird das tun, was du programmierst - nicht das, was du willst.

Facebook
Telefonspende