Regressione Sinusoidale e Visual Basic – Parte 5
Regressione Sinusoidale: un breve riepilogo e implementazione in Visual Basic. NET – (PARTE 5: Affinamento del valore di w0).
Siamo finalmente giunti alla fine del percorso sulla regressione sinusoidale. In questa quinta ed ultima parte implementiamo l’affinamento del valore di w0. La domanda è: “quando possiamo/dobbiamo fermarci”? Possiamo percorrere un paio di opzioni: si parte con una analisi a passo fisso (con un numero finito step) in un intorno pari a due volte (scelta arbitraria) lo step 1 del w0 ottenuto in prima approssimazione e poi ciclare con le vecchie istruzioni GOTO
la ricerca fino al raggiungimento di una piccola differenza prefissata tra due calcoli successivi diminuendo di volta in volta lo step 2 di 10 volte fino a una soglia prefissata (in base alle esigenze di precisione). Ma forse il codice sarà più esaustivo.
Implementazioni finali
Anzitutto si sono dichiarate le seguenti variabili e costanti pubbliche:
Const Errore_Massimo = 10 ^ -3
Const Div_Max = 10 ^ -4
Public OutPut_1APP(9) As Single
Public OutPut_2APP(9) As Single
Esse rappresentano un ordine: la differenza minima ammessa per continuare l’affinamento del w0; lo step di affinamento minimo (oltre il quale le iterazione diventerebbero probabilmente troppe); i due vettori conterranno i risultati della prima approssimazione e quelli della approssimazione approfondita.
Si è pertanto modificata anche la dFdw_Err_Min()
:
Function dFdw_Err_Min(Stepper As Single) As Single()
Dim TabMinimi(6) As Single
TabMinimi(0) = 10 ^ 20
TabMinimi(1) = 10 ^ 20
TabMinimi(2) = 10 ^ 20
TabMinimi(3) = 10 ^ 20
TabMinimi(4) = 10 ^ 20
TabMinimi(5) = 10 ^ 20
TabMinimi(6) = 10 ^ 20
Dim min_X As Single = 1
' allargo l'intervallo solo se
' ci sono ascisse in valore assoluto
' minori di 1 e comunque non troppo vicine
' allo zero
For Each item In Vettore_Ax
If Math.Abs(item) < min_X And Math.Abs(item) >= Stepper Then
min_X = Math.Abs(item)
End If
Next
For w0 = -Math.PI / min_X To Math.PI / min_X Step Stepper
Dim sol() = Risolvi_Sistema_Lineare(w0)
If sol IsNot Nothing Then
Dim df = dFdw(sol(0), sol(1), sol(2), w0)
Dim SqM = Calcola_SQM(sol(0), sol(1), sol(2), w0)
'trova l'errore standard minimo
If SqM < TabMinimi(5) Then
TabMinimi(0) = df
TabMinimi(1) = w0
TabMinimi(2) = sol(0)
TabMinimi(3) = sol(1)
TabMinimi(4) = sol(2)
TabMinimi(5) = SqM
TabMinimi(6) = min_X
End If
End If
Next
For i = 0 To 6
OutPut_1APP(i) = TabMinimi(i)
Next
Return TabMinimi
End Function
e si è implementato l’affinamento con la funzione Affina_Err_Min()
:
Function Affina_Err_Min(Stepper As Single) As Single()
Dim min_X As Single = 1
Dim Minimo(8) As Single
Minimo(0) = 10 ^ 20
Minimo(1) = 10 ^ 20
Minimo(2) = 10 ^ 20
Minimo(3) = 10 ^ 20
Minimo(4) = 10 ^ 20
Minimo(5) = 10 ^ 20
For w0 = -Math.PI / min_X To Math.PI / min_X Step Stepper
Dim sol() = Risolvi_Sistema_Lineare(w0)
If sol IsNot Nothing Then
Dim df = dFdw(sol(0), sol(1), sol(2), w0)
Dim SqM = Calcola_SQM(sol(0), sol(1), sol(2), w0)
If SqM < Minimo(5) Then
Minimo(0) = df
Minimo(1) = w0
Minimo(2) = sol(0)
Minimo(3) = sol(1)
Minimo(4) = sol(2)
Minimo(5) = SqM
Minimo(6) = min_X
End If
End If
Next
For i = 0 To 6
OutPut_1APP(i) = Minimo(i)
Next
Dim tmpSQM As Single = Minimo(5)
Dim tmpw As Single = Minimo(1)
Dim divider As Single = 10
Dim tmp_min_SQM As Single = 0
'un intorno pari 2 volte lo stepper1
Retest:
Application.DoEvents()
For w0 = -(Minimo(1) + Stepper) / min_X To (Minimo(1) + Stepper) / min_X Step Stepper / divider
Dim sol() = Risolvi_Sistema_Lineare(w0)
If sol IsNot Nothing Then
Dim df = dFdw(sol(0), sol(1), sol(2), w0)
Dim SqM = Calcola_SQM(sol(0), sol(1), sol(2), w0)
If SqM < Minimo(5) Then
Minimo(0) = df
Minimo(1) = w0
Minimo(2) = sol(0)
Minimo(3) = sol(1)
Minimo(4) = sol(2)
Minimo(5) = SqM
Minimo(6) = min_X
End If
End If
Next
Dim diff_Step As Single = Math.Abs(Minimo(5) - tmp_min_SQM)
' controlla se lo scarto quadratico medio è
' inferiore al valore prefissato Errore_Massimo
If diff_Step > Errore_Massimo Then
tmp_min_SQM = Minimo(5)
divider += 10
If Stepper / divider < Div_Max Then GoTo Continua
GoTo Retest
End If
Continua:
Minimo(7) = Stepper / divider
Minimo(8) = diff_Step
For i = 0 To 8
OutPut_2APP(i) = Minimo(i)
Next
Return Minimo
End Function
Potrebbe essere utile anche lasciarvi la sub Disegna_Grafico_2APPR()
per il disegno sul componente “chart” già presente da tempo in VB.NET utile per avere tutto nella giusta scala (dati e sinusoidi). Inoltre ho previsto la stampa dei dati ottenuti con la prima e la seconda approssimazione il delle listbox.
Sub Disegna_Grafico_2APPR()
'cerca minimo e massimo xx
ListBox2.Items.Clear()
ListBox2.Items.Add("==OUT:")
ListBox2.Items.Add(" a: " & OutPut_1APP(2))
ListBox2.Items.Add(" b: " & OutPut_1APP(3))
ListBox2.Items.Add(" c: " & OutPut_1APP(4))
ListBox2.Items.Add("df/dw: " & OutPut_1APP(0)) 'dfdw
ListBox2.Items.Add(" w0: " & OutPut_1APP(1)) 'w0
ListBox2.Items.Add(" SQM: " & OutPut_1APP(5))
ListBox2.Items.Add("min_X: " & OutPut_1APP(6))
ListBox3.Items.Clear()
ListBox3.Items.Add("==OUT:")
ListBox3.Items.Add(" a: " & OutPut_2APP(2))
ListBox3.Items.Add(" b: " & OutPut_2APP(3))
ListBox3.Items.Add(" c: " & OutPut_2APP(4))
ListBox3.Items.Add("df/dw: " & OutPut_2APP(0)) 'dfdw
ListBox3.Items.Add(" w0: " & OutPut_2APP(1)) 'w0
ListBox3.Items.Add(" SQM: " & OutPut_2APP(5))
ListBox3.Items.Add("min_X: " & OutPut_2APP(6))
Dim MINIMAX As Single = 10 ^ 10
Dim MASSIMAX As Single = -10 ^ 10
For Each item In Vettore_Ax
If item < MINIMAX Then MINIMAX = item
If item > MASSIMAX Then MASSIMAX = item
Next
'grafico
For xx = MINIMAX To MASSIMAX Step 1 / Numero_Punti
'y=a sen(wx) + b cos(wx) + c
Dim yy = OutPut_2APP(2) * Math.Sin(OutPut_2APP(1) * xx) + OutPut_2APP(3) * Math.Cos(OutPut_2APP(1) * xx) + OutPut_2APP(4)
Chart1.Series(2).Points.AddXY(xx, yy)
Next
End Sub
E questo è quanto. Di seguito un po di risultati grafici. Infine puoi ridare un’occhiata alla parte 1 o alla parte 2 o alla parte 3 o alla parte 4. Se vuoi implementare il grafico in Excel o altro foglio di calcolo puoi dare un’occhiata anche qui. Ovviamente il tutto è migliorabile, per cui sono ben accetti consigli.
Ho aggiunto anche l’eseguibile e alcune serie di punti, il tutto scaricabile cliccando su seguente link: Regressione Sinusoidale.Zip. A presto.