Polynom-Regression

Methode der kleinsten Quadrate ist natürlich Quatsch: "Methode der minimierten mittleren quadratischen Abweichung" wäre genauer.

Option Explicit Dim a(50, 51) As Double, B(50, 51) As Double Dim x(50) As Double, y(50) As Double Dim Xv(25) As Double, Yv(25) As Double

Private Sub CommandButton1_Click() Dim grad% ' einige Punkte zum Probieren

Xv(1) = 1: Yv(1) = -0.3
Xv(2) = 1.9: Yv(2) = 0.3
Xv(3) = 2.9: Yv(3) = 1.3
Xv(4) = 4: Yv(4) = 3.3
Xv(5) = 5.1: Yv(5) = 4.3
Text1.Text = "Anpassung eines Polynoms" & vbCrLf & vbCrLf
paar = 5 grad = CInt(ComboBox1.Text)
ausgleich paar, grad, Xv, Yv

End Sub

Sub ausgleich(paar%, Pgrad%, Xv() As Double, Yv() As Double) Dim i As Integer, j As Integer, k As Integer, Ggrad As Integer Dim Mat(25, 25) As Double, Fak As Double, a(25) As Double, sig As Double Dim txt as String

If paar < Pgrad + 1 Then 'Vorbereitende Eingaben

MsgBox "Zahl der Wertepaare nicht ausreichend!"
Exit Sub

End If
Ggrad = Pgrad + 1
For i = 1 To Ggrad

For j = 1 To Ggrad + 1

Mat(i, j) = 0

Next
Mat(1, 1) = paar 'Werteeingabe + Aufbau der Matrix
For i = 1 To paar

Mat(1, Ggrad + 1) = Mat(1, Ggrad + 1) + Yv(i)
Fak = 1
For j = 2 To Ggrad

Fak = Fak * Xv(i)
Mat(1, j) = Mat(1, j) + Fak
Mat(j, Ggrad + 1) = Mat(j, Ggrad + 1) + Fak * Yv(i)

Next
For j = 2 To Ggrad

Fak = Fak * Xv(i)
Mat(j, Ggrad) = Mat(j, Ggrad) + Fak

Next
For i = 2 To Ggrad

For j = 1 To Ggrad - 1

Mat(i, j) = Mat(i - 1, j + 1)

Next
gauss Ggrad, Mat, a 'Aufruf der Routine zur Lösung des lin. GS
txt=""
For i = 1 To Ggrad 'Ergebnisanzeigen

txt = txt & "a" & i - 1 & " = " & a(i) & vbCrLf

Next
txt = txt & vbCrLf
sig = 0
For i = 1 To paar 'Berechnung und Anzeige zur Qualität der Anpassung

Fak = a(Ggrad)
For j = Ggrad - 1 To 1 Step -1

Fak = a(j) + Xv(i) * Fak

Next
sig = sig + (Yv(i) - Fak) ^ 2
txt = txt & "y(" & i & ")=" & Yv(i) & " -> " & Fak & vbCrLf

Next
txt = txt & vbCrLf & "dsig=" & Sqr(sig / (paar - 2)) & vbCrLf
Text1.Txt = Text1.Text & txt

End Sub

Private Sub UserForm_Activate() Dim i%

For i = 1 To 25

ComboBox1.AddItem i

Next
ComboBox1.ListIndex = 6

End Sub

Das Ergebnis der Berechnung mit den paar = 5 oben angegebenen Punkten und dem Polynomgrad grad = 4 ist hier zu sehen:

Wer etwas probieren will, kann sofort loslegen. Es folgt ein Java-Applet, das diesen Algorithmus nutzt. Es ist für Polynome bis zum 14. Grade ausgelegt. Warum so wenig?

Wenn es bei der Anpassung mit Grad + 1 Punkten zu einem Restfehler kommt, liegt das an numerischen Ungenauigkeiten. Eigentlich sollte da ja immer Null herauskommen.

Polynom-Regression, Methode der kleinsten Quadrate