Interpolation einer Kurve

  • VB.NET

Es gibt 10 Antworten in diesem Thema. Der letzte Beitrag () ist von Memo.

    Interpolation einer Kurve

    Hallo,

    ich beschäftige mich seit einger Zeit mit 3-D Landschaften und möchte ein Perlin-Noise generieren ^^
    (Ich suche keinen Code dafür - ich will ihn selber schreiben. Aus Übungszwecken :D )

    Hier tritt das Problem der "Interpolation" auf. Soviel ich verstanden habe ist das das "glätten" einer Kurve.
    Ich orientiere mich derzeit an folgender Seite: freespace.virgin.net/hugo.elias/models/m_perlin.htm (Abschnitt: Cosine Interpolation)

    Hab das ganze kurzerhand in VB umgesetzt (hoffentlich richtig :S )

    VB.NET-Quellcode

    1. Function Interpolate(p1 As PointF, p2 As PointF, x As Integer) As Integer
    2. Dim ft = x * Math.PI
    3. Dim f = (1 - Math.Cos(ft)) / 2
    5. Return p1.Y * (1 - f) + p2.Y * f
    6. End Function


    Ganzer Code (halbings schön dokumentiert ;))
    Spoiler anzeigen

    VB.NET-Quellcode

    1. Public Class Form1
    2. Private values As New List(Of Integer) 'Y-Werte (gleichmäßig verteilt!)
    3. Private original As PointF()
    4. Private r As New Random(Now.Millisecond)
    6. Private Sub btn_seed_Click(sender As System.Object, e As System.EventArgs) Handles btn_seed.Click
    7. '5 zufällige Werte generieren
    8. values.Clear()
    9. For index = 1 To 8
    10. values.Add(r.Next(0, pb_ausgabe.Height))
    11. Next
    12. original = MakePoints() 'Zum Vergleich
    14. 'Punkte darstellen
    15. MakeBitmap()
    16. End Sub
    17. Private Sub btn_interpolate_Click(sender As System.Object, e As System.EventArgs) Handles btn_interpolate.Click
    18. 'Alle Punkte interpolieren
    19. Dim old_points = MakePoints()
    20. Dim new_values As New List(Of Integer)
    21. For index = 0 To values.Count - 2 'Weniger 2, da der letzte Punkt keinen Punkt rechts von ihm hat
    22. Dim currentX = (old_points(index).X + old_points(index + 1).X) / 2 'X-Koordinate für neuen Punkt berechnen
    23. new_values.Add(Interpolate(old_points(index), old_points(index + 1), currentX)) 'Interpolieren und in Liste einfügen
    24. Next
    26. 'Punkte mischen
    27. For index = 0 To values.ToArray.Count - 2
    28. values.Insert(index + 1, new_values(index))
    29. Next
    32. 'Punkte darstellen
    33. MakeBitmap()
    34. End Sub
    36. Private Sub MakeBitmap()
    37. Dim bmp As New Bitmap(pb_ausgabe.Width, pb_ausgabe.Height) 'Bitmap zum anzeigen
    39. 'Punkte generieren
    40. Dim points = MakePoints()
    43. 'Punkte zeichnen
    44. Using g = Graphics.FromImage(bmp)
    45. g.Clear(Color.White)
    46. g.DrawCurve(Pens.Red, original)
    47. g.DrawLines(Pens.Blue, points)
    48. End Using
    50. 'Anzeigen
    51. pb_ausgabe.Image = bmp
    52. End Sub
    54. Function MakePoints() As PointF()
    55. Dim points As New List(Of PointF)
    56. Dim f = pb_ausgabe.Width / values.Count 'Abstand zwischen einzelnen Punkten
    57. Dim x_val As Single = 0 'Aktuelle X-Position
    58. For Each y_val In values
    59. points.Add(New PointF(x_val, y_val))
    60. x_val += f
    61. Next
    63. Return points.ToArray()
    64. End Function
    66. Function Interpolate(p1 As PointF, p2 As PointF, x As Integer) As Integer
    67. Dim ft = x * Math.PI
    68. Dim f = (1 - Math.Cos(ft)) / 2
    70. Return p1.Y * (1 - f) + p2.Y * f
    71. End Function
    72. End Class


    Screenshots: (blau: meine Berechnung) (rot: DrawCurve)



    Liegt der Fehler jetzt in der Berechnung oder an mir? 8|

    Die geglättete rote Kurve ist ja wohl bei beiden gleich, da hast Du wohl einfach den Befehl Neu Berechnen vergessen aufzurufen.
    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!

    Memo schrieb:

    Die blaue Kurve soll sich der roten annähern
    Was soll eigentlich passieren?
    Du gibst eine blaue Kurve als Punktwolke vor und suchst eine rote glatte gefittete Kurve
    oder
    Du hast eine rote glatte Kurve und suchst sinnvolle (äquidistante) Stützstellen, um sie mit wenigen Punkten zu approximieren?
    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!

    So wie Du das geschrieben hast macht das keinen Sinn. :S
    - blaue Punktwolke vorgeben
    - Die blaue soll sich der roten annähern
    Dann wäre ja die rote Kurve eine zufällige oder eine göttliche Kurve (zunächst) ohne Bezug zur blauen Kurve. ?(
    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!

    OK.
    Was soll denn "Interpolate" genau machen?
    Kannst Du das mal bitte verbal beschreiben?
    Und gib Deinem Code Option Strict On.
    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!

    Ich weiß, was Interpolation ist. Du sollst Dein Problem selbst beschreiben, damit Du es auch verstehst.
    Ersetz mal Deinen Code-Snippet in der btn_interpolate_Click durch diesen hier:

    VB.NET-Quellcode

    1. 'Punkte mischen
    2. For index As Integer = 0 To values.ToArray.Length - 2
    3. values.Insert(2 * index + 1, new_values(index))
    4. Next
    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!

Facebook
Telefonspende