Regressione Sinusoidale e Visual Basic – Parte 5



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: 253 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 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.



Random Post

PREVISIONE LOTTO n°81 di SABATO 6 LUGLIO 2019

Previsione Lotto 6 Luglio 2019

PREVISIONE LOTTO n°81 di SABATO 6 LUGLIO 2019 Esito della previsione precedente: 2)MILANO: Niente; (AMBO CA; TERNO GE). (1) In parentesi tonda, eventuali risultati rilevanti (ambo, terno, ecc) su alt...

Vai al post...

Zeppole di patate – Ricette semplici

Zeppole di patate - Ricette semplici

Zeppole di patate: un classico della regione campania, diffuso in tutta Italia. Le zeppole di patate sono un dolce morbido, fritto a forma di ciambella generalmente preparato per San Giuseppe e la ...

Vai al post...

Inseguiti, essere – Interpretazione dei sogni

essere inseguiti

Sognare di essere inseguiti e di scappare, avere la sensazione di essere seguiti da qualcuno:  significato, interpretazione e numeri associati al sogno. Il sogno di essere inseguiti è uno dei nume...

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