Kurvenglättung

Kubische Splines

Wer nicht weiß, was das ist, der blättere weiter. Klingt gemeiner, als es gemeint ist. Denn es ist nicht einfach. Spline-Funktionen verbinden gegebene Punkte mit "glatten" Kurven. Die braucht man, um etwa eine gemessene Punktfolge in eine differenzierbare Funktion umzuwandeln. Die Besonderheit ist, daß die berechneten Kurventeile zwar glatt aussehen, aber nichts bedeuten (so etwas wie "Superstars").
Was das Verfahren tut, sei nur skizziert: Für je drei aufeinanderfolgende Punkte wird ein Polynom dritten Grades so bestimmt, daß in den Grenzpunkten die jeweiligen zweiten Ableitungen verschwinden. Diese Bedingung führt zu einem Gleichungssatz mit tridiagonaler Koeffizientenmatrix, die einfacher zu lösen ist, als ein normales lineares Gleichungssytem.

Gegeben seien n Stützstellen: x(1) <x(2) < ... <x(n),
wobei f"(x(1)) = f"(x(n)) = 0 sowie natürlich die zugehörigen y(1), y(2), ..., y(n)

Die Koeffizienten zur Berechnung der jeweils zwischen zwei Stützstellen gültigen Spline-Polynome werden in den
Arrays a(j), b(j), c(j), d(j) für j=1, 2 , ..., n abgelegt.

Das Ergebnis errechnet sich schließlich zu:
f(x) = a(j) + b(j) * (x - x(j)) + c(j) * (x - x(j))^2 + d(j) * (x - x(j))^3,
für x(j) <= x <x(j + 1)

Das Programmbeispiel:

Option Explicit Const step = 0.1

Private Sub CommandButton1_Click() Dim x(100) As Double, y(100) As Double Dim n% 'Testwerte

n = 6
x(1) = 1.5: y(1) = 1
x(2) = 2: y(2) = 3
x(3) = 2.5: y(3) = 0
x(4) = 3: y(4) = 3
x(5) = 3.5: y(5) = 1
x(6) = 4: y(6) = 0
splines n, x, y

End Sub

Sub splines(n As Integer, x() As Double, y() As Double) Dim a(100) As Double, b(100) As Double, c(100) As Double, d(100) As Double Dim T(100) As Double, Ta(100) As Double, Tl(100) As Double, Tu(100) As Double, Tz(100) As Double Dim i%, j%, m%, txt As String

For i = 1 To n

a(i) = y(i)

Next
m = n - 1
'Tridiagonale Matrix erstellen und lösen
For i = 1 To m

T(i) = x(i + 1) - x(i)

Next
For i = 2 To m

Ta(i) = 3 * (a(i + 1) * T(i - 1) - a(i) * (x(i + 1) - x(i - 1)) + a(i - 1) * T(i)) / (T(i) * T(i - 1))

Next
Tl(1) = 1: Tu(1) = 0: Tz(1) = 0
For i = 2 To m

Tl(i) = 2 * (x(i + 1) - x(i - 1)) - T(i - 1) * Tu(i - 1)
Tu(i) = T(i) / Tl(i)
Tz(i) = (Ta(i) - T(i - 1) * Tz(i - 1)) / Tl(i)

Next
Tl(n) = 1: Tz(n) = 0: c(n) = Tz(n)
For i = 1 To m

j = n - i
c(j) = Tz(j) - Tu(j) * c(j + 1)
b(j) = (a(j + 1) - a(j)) / T(j) - T(j) * (c(j + 1) + 2 * c(j)) / 3
d(j) = (c(j + 1) - c(j)) / (3 * T(j))

Next
txt = "Splines mit " & n & " Stützstellen"
zeig txt
ausgabe x, a, b, c, d, n

End Sub

Sub ausgabe(x() As Double, a() As Double, b() As Double, c() As Double, d() As Double, n%) Dim i%, dx As Double, txt As String

i = 1
dx = x(1)
Do

txt = txt & dx & " -> " & a(i) + b(i) * (dx - x(i)) + c(i) * (dx - x(i)) ^ 2 + d(i) * (dx - x(i)) ^ 3 & vbCrLf
dx = dx + step

Loop Until dx > x(i + 1)
i = i + 1

Loop Until i > n
zeig txt

End Sub

Sub zeig(txt As String)

UserForm2.TextBox1.Text = UserForm2.TextBox1.Text & txt & vbCrLf

End Sub

Zum Abschied eine durch Splines geglättete Kurve.

Die Kurve ist zwar wunderschön schwungvoll, die Bereiche zwischen den Punkten würden aber, bei nur wenig veränderten Punktlagen, völlig anders verlaufen.

Bezier-Kurven

Kurvenglättung durch Bezierkurven, bekannt von allen besseren Mal- bzw. Zeichenprogrammen soll hier kurz beschrieben werden.
Es werden zwischen jeweils zwei Stützpunkten x(1,i), y(1,i) und x(1,i+1), y(1,i+1) kubische Bezierkurven berechnet und zwar sowohl für X von i und t

t = x(1,i) + (x(1,i+1) - x(1,i)) * t = a(0,i) + a(1,i) * t + a(2,i) * t ^ 2 + a(3,i) * t ^ 3

als auch für Y von i und t

t = y(1,i) + (y(1,i+1) - y(1,i)) * t = b(0,i) + b(1,i) * t + b(2,i) * t ^ 2 + b(3,i) * t ^ 3

für 0 <= t <= 1.

Der Verlauf der Bezierkurven wird von jeweils zwei Führungspunkten bestimmt, die den beiden Endpunkten des Intervalls zugeordnet sind, links x(0,i), y(0,i) und rechts x(2,i+1), y(2,i+1). Solche Führungspunkte gibt es für i = 0, 1, ... , n-1. Für eine längere Kurve sind also bereitzustellen:

	`x(1,0), y(1,0),`	`x(2,0), y(2,0)`
`x(0,1), y(0,1),`	`x(1,1), y(1,1),`	`x(2,1), y(2,1)`
`x(0,2), y(0,2),`	`x(1,2), y(1,2),`	`x(2,2), y(2,2)`
	`...`
`x(0,n), y(0,n),`	`x(1,n), y(1,n)`

Const steps = 10 Dim n% Dim x#(2, 100), y#(2, 100) Dim a#(3, 100), b#(3, 100)

Sub glaettung()

eingabe n, x, y bezier n, x, y, a, b anzeige n, steps, a, b

End Sub

Sub bezier(n%, x#(), y#(), a#(), b#()) Dim i%

For i = 0 To n - 1

a(0, i) = x(1, i) b(0, i) = y(1, i) a(1, i) = 3 * (x(0, i) - x(1, i)) b(1, i) = 3 * (y(0, i) - y(1, i)) a(2, i) = 3 * (x(1, i) + x(2, i + 1) - 2 * x(0, i)) b(2, i) = 3 * (y(1, i) + y(2, i + 1) - 2 * y(0, i)) a(3, i) = x(1, i + 1) - x(1, i) + 3 * x(0, i) - 3 * x(2, i + 1) b(3, i) = y(1, i + 1) - y(1, i) + 3 * y(0, i) - 3 * y(2, i + 1)

Next

End Sub

Sub kurventeil(m%, steps%, a#(), b#(), xt#(), yt#()) Dim s#, t#

For i = 0 To steps

t = i / steps xt(i) = a(0, m) + a(1, m) * t + a(2, m) * t ^ 2 + a(3, m) * t ^ 3 yt(i) = b(0, m) + b(1, m) * t + b(2, m) * t ^ 2 + b(3, m) * t ^ 3

Next

End Sub

Sub anzeige(n%, steps%, a#(), b#()) Dim xt#(steps), yt#(steps)

For i = 1 To n - 1

kurventeil i, steps, a, b male steps, xt, yt

Next

End Sub

Die Prozedur „male“, die eine grafische Darstellung beinhalten könnte, überlasse ich dem Geschick des Nutzers. Üblicherweise werden durch Klick auf einen Stützpunkt Tangenten an die Kurve gezeigt, die in den Führungspunkten enden. Lage und Entfernung der Führungspunkte beeinflussen den Kurvenverlauf zwischen zwei benachbarten Stützpunkten. Über die Mausereignisse muß man die vom Nutzer vorgenommenen Veränderungen registrieren, dann für das betroffene Intervall jeweils neu rechnen und malen. Nichts für Anfänger!