Regressione Sinusoidale: un breve riepilogo e implementazione in Visual Basic. NET – (PARTE 5: Affinamento del valore di w₀).

Siamo finalmente giunti alla fine del percorso sulla regressione sinusoidale. In questa quinta ed ultima parte implementiamo l’affinamento del valore di w₀. 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 w₀ 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 w₀; 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.