Grafik-Spielerei + Approximation mittels Bisektion

    • VB.NET

      Grafik-Spielerei + Approximation mittels Bisektion

      Bezug: Diese Knobelei (ist dann doch noch eine "richtige" Knobelei geworden)

      Problem
      Gegeben ist ein bestimmtes Quadrat, und 3 Winkel, die ein 3-eck definieren.
      Gesucht ist nun die Position des 3-ecks innerhalb des Quadrats, bei dem es maximale Größe einnehmen kann.

      Lösung durch Annäherung
      Die Winkel werden sortiert. Der kleinste Winkel kommt in die Quadrat-Ecke obenLinks, der 2. Winkel kommt zunächstmal in die Q-Ecke obenRechts. Dadurch liegt die lange Seite des 3-Ecks auf der oberen Quadrat-Kante, und die 3.Ecke ist mit Sicherheit im Quadrat.
      Wenn nun die rechte Ecke senkrecht runter wandert bis zur UntenRechts-Ecke des Quadrats, so verlängert sich die lange Seite, und das 3-eck vergrößert sich. Dabei kann (muss nicht) die 3.Ecke auch ausserhalb des Quadrates geraten. Also muss einfach der rechte 3-Eckpunkt gefunden werden, bei dem die sich daraus ergebende 3. Ecke grade noch innerhalb des Quadrats liegt.
      meine Lösung

      VB.NET-Quellcode

      1. Public Class frmTriangleInSquare
      3. Private _Square As New RectangleF(150, 80, 480, 480)
      4. Private _SquarePen As New Pen(Brushes.Blue, 2)
      5. Private _Angles As New List(Of Double) From {45, 60, 75}
      7. Public Sub New()
      8. InitializeComponent()
      9. ListBox1.DataSource = _Angles
      10. End Sub
      12. Private Sub PrepareAngles()
      13. Dim s = Microsoft.VisualBasic.InputBox("Komma-getrennt 2 Winkel eingeben, in Deg (nur Ganzzahlen)", DefaultResponse:=String.Join(" , ", _Angles.Take(2)))
      14. If s.Length = 0 Then Return
      15. Try
      16. _Angles = s.Split(","c).Select(AddressOf Double.Parse).ToList
      17. If _Angles.Count <> 2 Then Throw New Exception("ungültige Anzahl Winkel!")
      18. Dim third = 180 - _Angles.Sum
      19. If third < 0 Then Throw New Exception("Winkelsumme muss kleiner 180 sein!")
      20. _Angles.Add(third)
      21. _Angles.Sort()
      22. Catch ex As Exception
      23. MessageBox.Show(ex.Message, "Fail")
      24. Return
      25. End Try
      26. End Sub
      28. Private Sub AnyMenuItem_Click(ByVal sender As Object, ByVal e As EventArgs) Handles TestToolStripMenuItem.Click
      29. PrepareAngles()
      30. ListBox1.DataSource = _Angles
      31. Me.Invalidate()
      32. End Sub
      34. Private Sub frmTriangleInSquare_Paint(sender As Object, e As System.Windows.Forms.PaintEventArgs) Handles Me.Paint
      35. e.Graphics.DrawRectangles(_SquarePen, {_Square}) 'paint Square
      36. Dim corners = {_Square.Location, New PointF(_Square.Right, _Square.Y), PointF.Empty} 'leftCorner, rightCorner, unknownCorner
      37. Const stepSize = 60
      38. For y = 0 To _Square.Height Step stepSize 'paint increasing Triangles
      39. corners(2) = Get3rdCorner(corners(0), corners(1), _Angles(0), _Angles(1))
      40. e.Graphics.DrawPolygon(Pens.Red, corners)
      41. corners(1).Y += stepSize 'increment rightCorner.Y
      42. Next
      43. corners(1) = GetOptimumRigthCorner()
      44. corners(2) = Get3rdCorner(corners(0), corners(1), _Angles(0), _Angles(1))
      45. e.Graphics.DrawPolygon(Pens.White, corners) 'paint optimum Triangle
      46. End Sub
      48. Private Function GetOptimumRigthCorner() As PointF
      49. 'Bisektion mit 16 schritten ergibt einen max Fehlerwert von 2^-16 Kantenlängen, also < 1/100 Pixel
      50. With _Square
      51. Dim poss = {0.0F, .Height / 2, .Height}
      52. For i = 0 To 15
      53. Dim pt2 = Get3rdCorner(.Location, New PointF(.Right, poss(1)), _Angles(0), _Angles(1))
      54. poss(If(.Contains(pt2), 0, 2)) = poss(1)
      55. poss(1) = (poss(0) + poss(2)) / 2
      56. Next
      57. Return New PointF(.Right, poss(1))
      58. End With
      59. End Function
      61. Private Function Get3rdCorner(pt0 As PointF, pt1 As PointF, angle0 As Double, angle1 As Double) As PointF
      62. Dim m01 = (pt0.Y - pt1.Y) / (pt0.X - pt1.X) 'Steigung pt0->pt1
      63. Dim angleAdd = Math.Atan(m01)
      64. Dim tmp = Math.PI / 180
      65. angle0 *= tmp
      66. angle1 *= tmp
      67. Dim m02 = Math.Tan(angle0 + angleAdd) 'Steigung pt0->pt2
      68. Dim m12 = Math.Tan(-angle1 + angleAdd) 'Steigung pt1->pt2
      69. 'ab hier verstehe ich die Formeln nicht - aber sie stimmen!
      70. Dim b1 = pt0.Y - m02 * pt0.X
      71. Dim b2 = pt1.Y - m12 * pt1.X
      72. Dim det = m12 - m02
      73. Dim x = (b1 - b2) / det
      74. Dim y = (m12 * b1 - m02 * b2) / det
      75. Return New PointF(CSng(x), CSng(y))
      76. End Function
      78. End Class

      sieht hübsch aus, finde ich:


      Gezeichnet wird das Quadrat, eine Folge von immer größeren 3-ecken, und das optimale 3-eck, also das größtmögliche, was noch ins Quadrat hineingeht:

      VB.NET-Quellcode

      1. Private Sub frmTriangleInSquare_Paint(sender As Object, e As System.Windows.Forms.PaintEventArgs) Handles Me.Paint
      2. e.Graphics.DrawRectangles(_SquarePen, {_Square}) 'paint Square
      3. Dim corners = {_Square.Location, New PointF(_Square.Right, _Square.Y), PointF.Empty} 'leftCorner, rightCorner, unknownCorner
      4. Const stepSize = 60
      5. For y = 0 To _Square.Height Step stepSize 'paint increasing Triangles
      6. corners(2) = Get3rdCorner(corners(0), corners(1), _Angles(0), _Angles(1))
      7. e.Graphics.DrawPolygon(Pens.Red, corners)
      8. corners(1).Y += stepSize 'increment rightCorner.Y
      9. Next
      10. corners(1) = GetOptimumRigthCorner()
      11. corners(2) = Get3rdCorner(corners(0), corners(1), _Angles(0), _Angles(1))
      12. e.Graphics.DrawPolygon(Pens.White, corners) 'paint optimum Triangle
      13. End Sub


      Bisektion
      informatisch interessant ist v.a. das Annäherungs-Verfahren "Bisektion":

      VB.NET-Quellcode

      1. Private Function GetOptimumRigthCorner() As PointF
      2. 'Bisektion mit 16 schritten ergibt einen max Fehlerwert von 2^-16 Kantenlängen, also < 1/100 Pixel
      3. With _Square
      4. Dim poss = {0.0F, .Height / 2, .Height}
      5. For i = 0 To 15
      6. Dim pt2 = Get3rdCorner(.Location, New PointF(.Right, poss(1)), _Angles(0), _Angles(1))
      7. poss(If(.Contains(pt2), 0, 2)) = poss(1)
      8. poss(1) = (poss(0) + poss(2)) / 2
      9. Next
      10. Return New PointF(.Right, poss(1))
      11. End With
      12. End Function
      es wird ein Tripel gebildet, poss, was Minimum, TestWert und Maximum enthält (zeile#4).
      In einer Schleife wird der Testwert getestet, und je nach Ergebnis wird entweder das Minimum rauf- oder das Maximum runter-gesetzt, auf den Testwert (#7).
      Anschließend wird der Testwert neu festgelegt, einfach als Mittel aus Min und Max.
      Die gezeigte Bisektion-Schleife ist also stark verallgemeinerbar - man bräuchte nur das Testverfahren auszutauschen, um iwelche anneren Sachen zu approximieren.

      (Edit: Ich glaub jedenfalls, dasses "Bisektion" heißt. Ist prinzipiell dasselbe wie eine binäre Suche, nur sucht nicht in einer sortierten Menge diskreter Elemente, sondern sucht in einem Kontinuum.)

      Edit: hglhyr fand schließlich noch einen viel einfacheren Zusammenhang, der diese Approximation üflüssig gemacht hätte: alle 3. Ecken liegen auf einer Geraden. (Hab diese Grade nun gelb eingezeichnet.)
      Dateien

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