Einfaches Plotten von Funktionen

    • VB.NET

    Es gibt 3 Antworten in diesem Thema. Der letzte Beitrag () ist von FreakJNS.

      Einfaches Plotten von Funktionen

      Hi
      da des Öfteren mal eine Frage zum Plotten von Funktionen gestellt wird, habe ich mal einen einfachen Algorithmus dafür geschrieben. Im Prinzip wird immer der Mittelwert zwischen zwei Werten genommen und in die Funktion eingesetzt. Anschließend wird jeweils überprüft, ob der Abstand zum 1. bzw. 2. Wert größer dem übergebenen delta ist und, falls zutreffend, die Prozedur erneut aufgerufen. Dadurch ist eine erheblich größere Genauigkeit gegeben, als durch einen immer gleichbleibenden Abstand zwischen den zu zeichnenden Punkten und DrawLine.
      Als Anmerkung vorweg: Der Algorithmus ist bei Weitem nicht perfekt. Bei vertikalen Asymptoten und häufig auch bei unstetigen Funktionen hängt er sich bspw. auf, bei kleinen Abständen (< delta) bricht er das Zeichnen bereits vorher ab. Dies liegt vor allem daran, dass durch die Verwendung des Delegatens quasi keine Analyse auf die Asymptoten, sowie somit das Verhalten an diesen möglich ist. Kleine Abstände werden hingegen einfach übersprungen, da eine Analyse auf lokale Extremwerte ebenfalls nicht möglich ist. Insgesamt ist der Quellcode auch eigentlich nicht auf diesen einfachen Fall zugeschnitten, daher bitte ich über etwaige Unsauberkeiten und Unschönheiten hinwegzusehen. Das Verfahren selbst ist extrem stapellastig, daher kann es zu Stapelüberläufen kommen.

      Spoiler anzeigen

      VB.NET-Quellcode

      1. <System.Runtime.InteropServices.DllImport("gdi32.dll")> _
      2. Private Shared Function SetPixel(hdc As IntPtr, x As Integer, y As Integer, argb As Integer) As Integer
      3. End Function
      4. <System.Runtime.InteropServices.DllImport("gdi32.dll")> _
      5. Private Shared Function GetPixel(hdc As IntPtr, x As Integer, y As Integer) As Integer
      6. End Function
      8. ''' <summary>
      9. ''' Kapselt eine Funktion mit einem Parameter vom Typ
      10. ''' <see cref="System.Double"/>
      11. ''' und einem Rückgabewert vom Typ
      12. ''' <see cref="System.Double"/>.
      13. ''' </summary>
      14. ''' <param name="value">Der Wert, der ausgewertet wird.</param>
      15. ''' <returns>Der von der gekapselten Funktion zurückgegebene Wert.</returns>
      16. Public Delegate Function Func(value As Double) As Double
      18. ''' <summary>
      19. ''' Stellt ein von zwei Werten begrenztes Intervall dar.
      20. ''' </summary>
      21. Public Structure Range
      22. Private _first As Double, _last As Double
      24. ''' <summary>
      25. ''' Gibt den ersten Wert zurück.
      26. ''' </summary>
      27. Public ReadOnly Property First() As Double
      28. Get
      29. Return _first
      30. End Get
      31. End Property
      33. ''' <summary>
      34. ''' Gibt den zweiten Endwert zurück.
      35. ''' </summary>
      36. Public ReadOnly Property Last() As Double
      37. Get
      38. Return _last
      39. End Get
      40. End Property
      42. ''' <param name="first">Der erste Wert des Intervalls.</param>
      43. ''' <param name="last">Der zweite Wert des Intervalls.</param>
      44. Public Sub New(first As Double, last As Double)
      45. _first = first
      46. _last = last
      47. End Sub
      48. End Structure
      50. ''' <summary>
      51. ''' Zeichnet die angegebene Funktion auf das Ziel.
      52. ''' </summary>
      53. ''' <param name="surface">Die Oberfläche, auf die gezeichnet werden soll.</param>
      54. ''' <param name="color">Die Darstellungsfarbe der dargestellten Funktion.</param>
      55. ''' <param name="xRange">Die zu zeichnende Definitionsmenge.</param>
      56. ''' <param name="yRange">Die zu zeichnende Wertemenge.</param>
      57. ''' <param name="bounds">Der Bereich, in dem die Funktion dargestellt werden soll.</param>
      58. ''' <param name="origin">Der Koordinatenursprung.</param>
      59. ''' <param name="evaluatedFunction">Die zu zeichnende Funktion.</param>
      60. ''' <remarks>
      61. ''' Funktionen mit asymptotischem Verhalten innerhalb eines zu zeichnenden Intervalls müssen
      62. ''' vor dem Zeichnen aufgespalten werden und nacheinander gezeichnet werden.
      63. ''' </remarks>
      64. Public Shared Sub Plot(surface As Graphics, color As Color, xRange As Range, yRange As Range, bounds As RectangleF, origin As PointF, _
      65. evaluatedFunction As Func)
      66. Plot(surface, color, xRange, yRange, bounds, origin, _
      67. 1.0, evaluatedFunction)
      68. End Sub
      70. ''' <summary>
      71. ''' Zeichnet die angegebene Funktion auf das Ziel.
      72. ''' </summary>
      73. ''' <param name="surface">Die Oberfläche, auf die gezeichnet werden soll.</param>
      74. ''' <param name="color">Die Darstellungsfarbe der dargestellten Funktion.</param>
      75. ''' <param name="xRange">Die zu zeichnende Definitionsmenge.</param>
      76. ''' <param name="yRange">Die zu zeichnende Wertemenge.</param>
      77. ''' <param name="bounds">Der Bereich, in dem die Funktion dargestellt werden soll.</param>
      78. ''' <param name="origin">Der Koordinatenursprung.</param>
      79. ''' <param name="delta">Der minimale Abstand zwischen zwei Werten, für die eine weitere Zeichenoperation durchgeführt werden soll.</param>
      80. ''' <param name="evaluatedFunction">Die zu zeichnende Funktion.</param>
      81. ''' <remarks>
      82. ''' Funktionen mit asymptotischem Verhalten innerhalb eines zu zeichnenden Intervalls müssen
      83. ''' vor dem Zeichnen aufgespalten werden und nacheinander gezeichnet werden.
      84. ''' </remarks>
      85. Public Shared Sub Plot(surface As Graphics, color As Color, xRange As Range, yRange As Range, bounds As RectangleF, origin As PointF, _
      86. delta As Double, evaluatedFunction As Func)
      87. Dim prev As Region = surface.Clip
      88. Dim cur As New Region(bounds)
      89. Dim lv As Double, rv As Double
      91. cur.Intersect(prev)
      92. 'Zu fuellenden Bereich beschraenken
      93. surface.Clip = cur
      95. 'linker y-Wert
      96. lv = evaluatedFunction(xRange.First)
      97. 'rechter y-Wert
      98. rv = evaluatedFunction(xRange.Last)
      100. 'Verschiebung in x- und y-Richtung berechnen
      101. Dim xoffs As Single = bounds.Left + origin.X - bounds.Width * CSng(xRange.First / (xRange.Last - xRange.First))
      102. Dim yoffs As Single = bounds.Bottom + origin.Y + bounds.Height * CSng(yRange.First / (yRange.Last - yRange.First))
      103. 'Streckfaktor in x- und y-Richtung berechnen
      104. Dim xfct As Double = bounds.Width / (xRange.Last - xRange.First)
      105. Dim yfct As Double = -bounds.Height / (yRange.Last - yRange.First)
      106. 'Positionen von linkem und rechten Wert berechnen
      107. Dim lpos As New PointF(CSng(xRange.First * xfct) + xoffs, CSng(lv * yfct) + yoffs)
      108. Dim rpos As New PointF(CSng(xRange.Last * xfct) + xoffs, CSng(rv * yfct) + yoffs)
      110. 'Intervall zwischen den beiden Werten berechnen
      111. PlotInterval(surface.GetHdc(), color.ToArgb(), xRange.First, xRange.Last, lv, rv, _
      112. lpos, rpos, xfct, xoffs, yfct, yoffs, _
      113. delta, evaluatedFunction)
      114. surface.ReleaseHdc()
      115. 'Linken und rechten Punkt zeichnen
      116. surface.FillRectangle(Brushes.Black, lpos.X, lpos.Y, 1F, 1F)
      117. surface.FillRectangle(Brushes.Black, rpos.X, rpos.Y, 1F, 1F)
      118. 'urspruenglichen zu fuellenden Bereich wieder uebernehmen
      119. surface.Clip = prev
      120. cur.Dispose()
      121. End Sub
      123. Private Shared Sub PlotInterval(hdc As IntPtr, color As Integer, l As Double, r As Double, lv As Double, rv As Double, _
      124. lpos As PointF, rpos As PointF, xfct As Double, xoffs As Single, yfct As Double, yoffs As Single, _
      125. delta As Double, func As Func)
      126. 'Mittle vom linken x-Wert (l) und rechten x-Wert (r) ermitteln
      127. Dim m As Double = (l + r) / 2.0
      128. 'y-Wert des x-Wertes berechnen
      129. Dim mv As Double = func(m)
      130. 'Abstand zwischen den beiden Punkten ermitteln
      131. Dim dx As Double = (m - l) * xfct, dy As Double = (mv - lv) * yfct
      132. 'zu zeichnende Position des mittleren Werts ermitteln
      133. Dim pos As New PointF(CSng(m * xfct) + xoffs, CSng(mv * yfct) + yoffs)
      135. 'Falls der Abstand groesser, als der maximale Abstand ist, wird der Wert zwischen den beiden Werten ebenfalls gezeichnet, sonst ausgelassen.
      136. If dx * dx + dy * dy >= delta Then
      137. PlotInterval(hdc, color, l, m, lv, mv, _
      138. lpos, pos, xfct, xoffs, yfct, yoffs, _
      139. delta, func)
      140. End If
      141. 'selbiges fuer den rechten Teil
      142. dx = (r - m) * xfct
      143. dy = (rv - mv) * yfct
      144. If dx * dx + dy * dy >= delta Then
      145. PlotInterval(hdc, color, r, m, rv, mv, _
      146. pos, rpos, xfct, xoffs, yfct, yoffs, _
      147. delta, func)
      148. End If
      149. 'Pixel darstellen
      150. DrawPixel(hdc, color, pos.X, pos.Y)
      151. End Sub
      153. Private Shared Sub DrawPixel(hdc As IntPtr, color As Integer, x As Single, y As Single)
      154. Dim xl As Integer = CInt(Math.Truncate(Math.Floor(x)))
      155. Dim yl As Integer = CInt(Math.Truncate(Math.Floor(y)))
      156. Dim fctx As Single = x - xl
      157. Dim fcty As Single = y - yl
      158. 'Einfache "billige" Antialisierung anwenden
      159. SetPixel(hdc, xl, yl, BlendPixelBgr(GetPixel(hdc, xl, yl), color, (1F - fctx) * (1F - fcty)))
      160. SetPixel(hdc, xl + 1, yl, BlendPixelBgr(GetPixel(hdc, xl + 1, yl), color, fctx * (1F - fcty)))
      161. SetPixel(hdc, xl, yl + 1, BlendPixelBgr(GetPixel(hdc, xl, yl + 1), color, (1F - fctx) * fcty))
      162. SetPixel(hdc, xl + 1, yl + 1, BlendPixelBgr(GetPixel(hdc, xl + 1, yl + 1), color, fctx * fcty))
      163. End Sub
      165. Private Shared Function BlendPixelBgr(backbgr As Integer, argb As Integer, alphafactor As Single) As Integer
      166. Dim a As Integer = CInt(Math.Truncate(((argb >> 24) And &Hff) * alphafactor))
      168. If a = 0 Then
      169. 'fore-color ist nicht sichtbar
      170. Return backbgr
      171. ElseIf a = 255 Then
      172. 'back-color ist unsichtbar ==> r und b vertauschen
      173. Return ((argb And &Hff) << 16) Or (argb And &Hff00) Or ((argb And &Hff0000) >> 16)
      174. Else
      175. 'sonst einfach Alpha-Blending anwenden
      176. Return ((a * (argb And &Hff) + (255 - a) * ((backbgr >> 16) And &Hff)) And &Hff00) << 8 Or ((a * ((argb >> 8) And &Hff) + (255 - a) * ((backbgr >> 8) And &Hff)) And &Hff00) Or ((a * ((argb >> 16) And &Hff) + (255 - a) * (backbgr And &Hff)) And &Hff00) >> 8
      177. End If
      178. End Function


      Beispiel für Aufruf:

      VB.NET-Quellcode

      1. Dim g As Graphics = 'Ziel
      2. Plot(g, _
      3. New Range(3, 100), _
      4. New Range(-1, 1), _
      5. ClientRectangle, _
      6. New PointF(0, 0), _
      7. 1.0, _
      8. Function(v As Double) Math.Sin(v * v / 10))


      Viel Spaß.

      Gruß
      ~blaze~

      Dieser Beitrag wurde bereits 4 mal editiert, zuletzt von „~blaze~“ ()

      @bla
      unter VB6 gab es mal eine SetPixel-Mehtode um direkt Punkte auf den Bildschirm zu zeichnen. Bei .NET geht das nur über diesen umweg oder indem man mit GDI+ ein Rectangle ausfüllt, dass genau 1x1Pixel groß ist. SetPixel kenn ich in .NET nur noch als Bitmap-Methode.

    Facebook
    Telefonspende