Regressione Sinusoidale e Visual Basic – Parte 3



Categoria dell'articolo:
Codice VB.NET

Listati in codice Visual Basic.NET, elaborati o rielaborati e adattati da IngAC con la versione 2019 (ma retrocompatibile sicuramente). Funzioni e subroutine varie utili alla creazione di programmi.



Articolo pubblicato da:

Views: 222 dall'1 Luglio 2018 o dalla pubblicazione, se successiva.

Navigator

Precedente - Menu - Successivo



Se trovi interessante l'articolo che ti stai accingendo a leggere, metti un mi piace e condividi! Be Social!



Regressione Sinusoidale: un breve riepilogo e implementazione in Visual Basic. NET – (PARTE 3: Ricerca della convergenza del parametro w0 in VB.NET).


Una volta trovati a0, b0, c0 con il valore inziale di w0 si passa a cercare la sua convergenza (o meglio: si cercherà il valore di w0 tale per cui lo scarto quadratico medio è minimo). Prima di poter fare questo però occorre passare in visual basic la derivata:

∂F/∂w = 0 (vedi parte 1)

che esplicitata diventa:

∂F/∂w = 2 {(a2-b2)∑xk sin(wxk)cos(wxk) +
+ 2ab∑xk cos2(wxk) – ab∑xk +
+ a[c∑cos(wxk) – ∑xkykcos(wxk)] +
– b[c∑sin(wxk) -∑xkyksin(wxk)]} = 0

(ogni sommatoria è su k =1,2…n)

Regressione sinusoidale – Prima approssimazione – Funz 1

In questa derivata vengono sostituite le soluzioni del precedente sistema, ottenendo quindi un valore numerico. Ci prepariamo le sommatorie attraverso la funzione Calcola_Sommatorie_dFdw():

Function Calcola_Sommatorie_dFdw(w0 As Single) As Single()
 
        Dim SS(9) As Single
 
        For i = 0 To Numero_Punti - 1
            ' ∑xk sin(wxk)cos(wxk)
            SS(0) += Math.Sin(w0 * Vettore_Ax(i)) * Math.Cos(w0 * Vettore_Ax(i))
            ' ∑xk cos2(wxk)
            SS(1) += (Math.Cos(w0 * Vettore_Ax(i))) ^ 2
            ' ∑xk
            SS(2) += Vettore_Ax(i)
            ' ∑cos(wxk)
            SS(3) += Math.Cos(w0 * Vettore_Ax(i))
            ' ∑xkykcos(wxk)
            SS(4) += Vettore_Ax(i) * Vettore_Ay(i) * Math.Cos(w0 * Vettore_Ax(i))
            ' ∑sin(wxk)
            SS(5) += Math.Sin(w0 * Vettore_Ax(i))
            ' ∑xkyksin(wxk)
            SS(6) += Vettore_Ax(i) * Vettore_Ay(i) * Math.Sin(w0 * Vettore_Ax(i))
        Next
        Return SS
 
    End Function

con la quale calcoliamo i valore numerico della derivata ∂F/∂w. (In realtà anche questo calcolo serve a ben poco: inizialmente si era pensato di trovare il valore di w0 che rendeva più vicina a zero proprio questa derivata).

Function dFdw(a0 As Single, b0 As Single, c0 As Single, w0 As Single) As Single
 
        '∂F/∂w = 2 {(a2-b2)∑xk sin(wxk)cos(wxk) +
        '+ 2ab∑xk cos2(wxk) - ab∑xk +
        '+ a[c∑cos(wxk) - ∑xkykcos(wxk)] +
        '- b[c∑sin(wxk) -∑xkyksin(wxk)]} 
 
        Dim SS() As Single = Calcola_Sommatorie_dFdw(w0)
 
        dFdw = 2 * (
        (a0 ^ 2 - b0 ^ 2) * SS(0) +
        2 * a0 * b0 * SS(1) - a0 * b0 * SS(2) +
        a0 * (c0 * SS(3) - SS(4)) -
        b0 * (c0 * SS(5) - SS(6))
        )
 
    End Function

A questo punto ci occorre conoscere a quale valore di w0 dobbiamo prendere per far si che l’uguaglianza a zero della derivata sia verificata o comunque molto piccola. Ci sviluppiamo il calcolo dello Scarto Quadratico Medio con la funzione Calcola_SQM():

Function Calcola_SQM(a0 As Single, b0 As Single, c0 As Single, w0 As Single) As Single
        'F(a,b,c,w) = ∑[( a sen(wx) + b cos(wx) + c) - yk]2
 
        Dim s As Single = 0
        For i = 0 To Numero_Punti - 1
            s += (((a0 * Math.Sin(w0 * Vettore_Ax(i)) + b0 * Math.Cos(w0 * Vettore_Ax(i)) + c0 - Vettore_Ay(i))) ^ 2)
        Next
 
        s = (s / Numero_Punti) ^ 0.5
 
        Return s
 
    End Function

Più piccolo è lo SQM maggiore sarà la corrispondenza della sinusoide ai punti. Ora è possibile procedere su un intervallo di valori [-π,+π] fino a trovare il valore che si avvicina di più zero. Trovato questo valore si procederà alla ulteriore scansione nell’intorno di tale valore. La funzione è la dFdw_Min_VAss() che restituisce un vettore con i minimi legati allo SQM: dF/dw0, w0, a, b, c, sqm.

Function dFdw_Err_Min() As Single()
 
 
        Dim TabMinimi(5) 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
 
        For w0 = -Math.PI To Math.PI Step 0.01
 
            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
                End If
 
            End If
        Next
        Return TabMinimi
    End Function
Regressione sinusoidale - Prima approssimazione - Funz 2

Regressione sinusoidale – Prima approssimazione – Funz 2

Nella terza parte implementeremo in VB.NET l’affinamento della soluzione trovata. Nel frattempo se vuoi approfondire la questione, eccoti alcuni link utili:

Alcuni post della stessa categoria...


Random Post

Raccoglimento a fattor comune parziale – Matematica

Raccoglimento a fattore comune parziale - Matematica

Raccoglimento a fattor comune parziale: scomposizione o fattorizzazione dei polinomi. Esempi ed esercizi svolti. La scomposizione dei polinomi consiste nel trasformare la somma algebrica di monomi d...

Vai al post...

PREVISIONE LOTTO n° 43 di 150 per GIOVEDÌ 16 MARZO 2017

Previsione Lotto 16 Marzo 2017

PREVISIONE LOTTO n° 43 di 150 per GIOVEDÌ 16 MARZO 2017 Esito della previsione precedente:2)GENOVA: 1 euro 10eLotto; 5)CAGLIARI: Estratto + 1 ambetto. In merito alla previsione “beta V3”...

Vai al post...

PREVISIONE LOTTO n° 52 di 150 per GIOVEDÌ 6 APRILE 2017

Previsione Lotto 6 Aprile 2017

PREVISIONE LOTTO n° 52 di 150 per GIOVEDÌ 6 APRILE 2017 Esito della previsione precedente: 4)TORINO: Estratto + 1ambetto; G|GENOVA: 2 euro 10elotto (risultato corretto, bug software). Previsione...

Vai al post...

PUBBLICITÀ


Disclaimer:


Questo blog NON è un prodotto editoriale ai sensi della legge n° 62 del 7 marzo 2001. Le immagini tratte da internet che possano violare i diritti di autore, previa comunicazione, attraverso la sezione -contatti-, verranno prontamente rimosse o sostituite.
Copyright:


I contenuti presenti su ROMOLETTO BLOG dei quali è autore il proprietario del blog non possono essere copiati, riprodotti, redistribuiti perché appartenenti all autore stesso. Si vieta la copia e la riproduzione dei contenuti in qualsiasi modo o forma. Si vieta altresì la pubblicazione e la redistribuzione dei contenuti non autorizzata espressamente dell autore.
Copyright © 2011 / 2020 - ROMOLETTO BLOG - All Right Reserved
IngAC

Informazioni su Romoletto Blog

Ingegnere Civile, Blogger, Programmatore VB.NET, Lezioni private per scuole medie inferiori e superiori. Per contattarmi scorri la home fino in fondo e vai al form -Contatti-

Navigazione per Articoli della stessa Categoria