Novità

Mente da programmatore

ottimo , i numeri pero faglieli prendere dalal formazione , fai una funzione ArrayNumeriToString ora devi fare una funzine inversa , data la stringa ruote mi deve tornare l'array boolean delle ruote.
 
per fare questa funzione che converte le ruote in un array di boolean devi mettere nel modulo variabili globali questa dichiarazione

Codice:
  Public collRuote As Dictionary(Of String, clsItemCombo)

in questo modo stiamo creando una collection di tipo dictionary che conterra oggett idi tipo clsItemCombo e ogni oggett osarà associato ad una chiave di tipo stringa.

poi nella procedura che alimenta l'array delle ruote e della sorte aggiungi questo codice che serve per alimentare la collection

Codice:
        Dim cItm As clsItemCombo
        collRuote = New Dictionary(Of String, clsItemCombo)
        For k As Integer = 1 To 12
            cItm = New clsItemCombo
            cItm.Text = NomiRuote(k).Nome
            cItm.Tag = NomiRuote(k).NomeAbbreviato
            cItm.ItemData = k

            collRuote.Add(NomiRuote(k).NomeAbbreviato, cItm)

        Next

come vedi aggingiamo un oggetto che contiene i dati della ruota , nome , nome breve , indice

con questa istruzione possiamo puntare l'oggetto con la data chiave

Codice:
   If collRuote.ContainsKey("Ba") Then
            cItm = collRuote("Ba")

        End If

e a questo punto il nostro itm nella proprietà item data avra il valore 1.



quindi tu fai una funzione

Codice:
function StringaRuoteToBool (sRuote as string , optional sChrSep as string = ";") as boolean ()
' qui fai lo split dei valori della stringa poi in un ciclo li cerchi dentro la collection delle ruote
' se ottieni l'oggetto cItm vai a valorizzare l'array boolean a true in quella posizione
alla fine la funzioen deve tornare l'array di boolean da 1 a 12
end function


attenzione le ruote sono 12 compreso tutte quindi in RuoteToString devi mettere 12 non 11
 
aggiungi questo modulo

Codice:
Module ModProbabilita

    ''' <summary>
    ''' 
    ''' </summary>
    ''' <param name="e">E = evento per il quale si cerca la probabilitá</param>
    ''' <param name="g">G = Quantitá numeri giocati per la sorte E</param>
    ''' <param name="MxE">MxE = Massimo evento possibile (lotto =5 )</param>
    ''' <param name="MxG">MxG = Massima quantita giocabile (lotto =90   )</param>
    ''' <param name="rt">RT = Numero  di ruote</param>
    ''' <returns></returns>

    Function probabilita(e As Integer, g As Integer, MxE As Integer, MxG As Integer, rt As Integer) As Decimal



        Dim nEventiPossibili As Integer
        Dim nEventiFavorevoli As Integer
        Dim nCombParzA As Double
        Dim nCombParzB As Double
        Dim k As Integer
        Dim CasiContrari As Double

        Dim ProbFav As Decimal, ProbContr As Decimal


        ' calcolo il numero degli eventi possibili
        ' gli eventi possibili sono costituiti dal numero delle combinazioni totali

        nEventiPossibili = Combinazioni(MxG, MxE)

        ' calcolo il numero degli eventi favorevoli
        ' gli eventi favorevoli sono costituiti dal numero di combinazioni
        ' che soddisfano l'esito

        If g >= e Then
            For k = e To MxE
                If k <= g Then
                    If (MxE - k) > 0 Then
                        nCombParzB = Combinazioni(MxG - g, MxE - k)
                    Else
                        nCombParzB = 1
                    End If
                    nCombParzA = Combinazioni(g, k)
                    nEventiFavorevoli += nCombParzA * nCombParzB
                End If
            Next

            CasiContrari = nEventiPossibili - (nEventiFavorevoli)
            ProbFav = (nEventiFavorevoli) / (nEventiPossibili)
            ProbContr = 1 - ProbFav

            Return 1 - (ProbContr ^ rt)
        End If

        Return 0

    End Function
    Function RitardoNaturale(qNumeri As Integer, nSorte As Integer, Optional qPosizioni As Integer = 5, Optional qRuote As Integer = 1) As Decimal
        Dim p As Decimal = probabilita(nSorte, qNumeri, qPosizioni, 90, qRuote)
        If p > 0 Then
            Return 1 / p
        End If

        Return 0

    End Function

    Function ProbabilitaContraria(qNumeri As Integer, nSorte As Integer, Optional qPosizioni As Integer = 5, Optional qRuote As Integer = 1) As Decimal
        Dim p As Decimal = probabilita(nSorte, qNumeri, qPosizioni, 90, qRuote)
        If p >= 0 Then
            Return 1 - p
        End If
        Return 1

    End Function

    Function CostanteDiDecadimento(qNumeri As Integer, nSorte As Integer, Optional qPosizioni As Integer = 5, Optional qRuote As Integer = 1) As Decimal
        Dim p As Decimal = probabilita(nSorte, qNumeri, qPosizioni, 90, qRuote)
        Dim q As Decimal

        If p >= 0 Then
            q = 1 - p
            Return 1 / Math.Log(1 / q)
        End If
        Return 0

    End Function
End Module
 
ottimo , i numeri pero faglieli prendere dalal formazione , fai una funzione ArrayNumeriToString ora devi fare una funzine inversa , data la stringa ruote mi deve tornare l'array boolean delle ruote.
Codice:
  Sub LanciaStatistica()
        Dim frz As New struct_formazione
        Dim aNumeri() As Integer
        Dim aRuote() As Boolean
        Dim nSorte As Integer
        Dim Inizio As Integer
        Dim fine As Integer
        GetArrayNumeriFromString(TextBox1.Text, aNumeri)
        frmMain.CltSelRuote1.GetCheckSelezionate(aRuote)
        nSorte = Me.cmbsorte.SelectedItem
        Inizio = frmMain.CtlRangeEstrazioni1.Inizio
        fine = frmMain.CtlRangeEstrazioni1.Fine
        frz.Inizializza(aNumeri, aRuote, nSorte, Inizio, fine)
        If cArchivio.StatFormazione(frz) Then
            Dim itm As ListViewItem = CtlLvOrdinabile1.Items.Add(ArrayNumeriToString(aNumeri))
            itm.SubItems.Add(RuoteBToString(aRuote))
            itm.SubItems.Add(frz.Sorte)
            itm.SubItems.Add(frz.Ritardo)
            itm.SubItems.Add(frz.RitardoMax)
            itm.SubItems.Add(frz.IncrRitMax)
            itm.SubItems.Add(frz.Frequenza)
            itm.SubItems.Add(frz.Presenze)

        End If
    End Sub

Codice:
    Function ArrayNumeriToString(aNumeri() As Integer) As String
        Dim K As Long
        Dim SB As New StringBuilder
        For K = 1 To UBound(aNumeri)
            SB.Append(aNumeri(K))
            SB.Append(".")
        Next
        SB.Remove(SB.Length - 1, 1)
        Return SB.ToString
    End Function

Codice:
    Sub AlimentaRuoteSorte()

        ReDim NomiRuote(12)

        NomiRuote(1).Nome = "Bari"
        NomiRuote(1).NomeAbbreviato = "Ba"
        NomiRuote(2).Nome = "Cagliari"
        NomiRuote(2).NomeAbbreviato = "Ca"
        NomiRuote(3).Nome = "Firenze"
        NomiRuote(3).NomeAbbreviato = "Fi"
        NomiRuote(4).Nome = "Genova"
        NomiRuote(4).NomeAbbreviato = "Ge"
        NomiRuote(5).Nome = "Milano"
        NomiRuote(5).NomeAbbreviato = "Mi"
        NomiRuote(6).Nome = "Napoli"
        NomiRuote(6).NomeAbbreviato = "Na"
        NomiRuote(7).Nome = "Palermo"
        NomiRuote(7).NomeAbbreviato = "Pa"
        NomiRuote(8).Nome = "Roma"
        NomiRuote(8).NomeAbbreviato = "Rm"
        NomiRuote(9).Nome = "Torino"
        NomiRuote(9).NomeAbbreviato = "To"
        NomiRuote(10).Nome = "Venezia"
        NomiRuote(10).NomeAbbreviato = "Ve"
        NomiRuote(11).Nome = "Nazionale"
        NomiRuote(11).NomeAbbreviato = "Nz"
        NomiRuote(12).Nome = "Tutte"
        NomiRuote(12).NomeAbbreviato = "TT"

        ReDim NomiSorte(5)

        NomiSorte(1).Nome = "Estratto"
        NomiSorte(1).NomeAbbreviato = "E"
        NomiSorte(2).Nome = "Ambo"
        NomiSorte(2).NomeAbbreviato = "A"
        NomiSorte(3).Nome = "Terno"
        NomiSorte(3).NomeAbbreviato = "T"
        NomiSorte(4).Nome = "Quaterna"
        NomiSorte(4).NomeAbbreviato = "Q"
        NomiSorte(5).Nome = "Cinquina"
        NomiSorte(5).NomeAbbreviato = "C"

        Dim cItm As clsItemCombo
        collRuote = New Dictionary(Of String, clsItemCombo)
        For k As Integer = 1 To 12
            cItm = New clsItemCombo
            cItm.Text = NomiRuote(k).Nome
            cItm.Tag = NomiRuote(k).NomeAbbreviato
            cItm.ItemData = k

            collRuote.Add(NomiRuote(k).NomeAbbreviato, cItm)

        Next

    End Sub

Codice:
    Function StringaRuoteToBool(sRuote As String, Optional sChrSep As String = ";") As Boolean()
        Dim aRuote(sRuote.Length) As String
        Dim bRuote(12) As Boolean
        aRuote = Split(sRuote, sChrSep)
        For k As Integer = 1 To UBound(aRuote)
            If collRuote.ContainsKey(aRuote(k)) Then
                bRuote(k) = True
            End If
        Next
        Return bRuote
    End Function
 
buongiorno questa ultima parte non va bene , va fatta cosi

Codice:
 Function StringaRuoteToBool(sRuote As String, Optional sChrSep As String = ";") As Boolean()
        Dim aRuote() As String = Split(sRuote, sChrSep)
  Dim cItm As clsItemCombo
        Dim bRuote(12) As Boolean
        For k As Integer = 1 To UBound(aRuote)
            If collRuote.ContainsKey(aRuote(k)) Then
                  citm= collRuote.item(aRuote(k))
                 bRuote ( cItm.itemdata) = true
            End If
        Next
        Return bRuote
    End Function
 
Va bene. Ho fatto delle modifiche. Nella textbox del form statistica ho inserito il "controllo caratteri inseriti". Poichè può essere utilizzatto per pre-caricare i numeri nel frmsellunghette, se si inserivano caratteri non validi e si lanciava il form andava in crash.

Codice:
    Private Sub TextBox1_KeyDown(sender As Object, e As KeyEventArgs) Handles TextBox1.KeyDown
        SoloCaratteriPerInserimentoLunghette(e)
    End Sub

ho aggiunto anche una function che imposta le Check posizioni tutte a checked = true al caricamento del form

Codice:
    Private Sub frmStatLung_Load(sender As Object, e As EventArgs) Handles MyBase.Load
        LoadComboSorte(cmbsorte)
        addcolumns()
        ctlSelPosizione1.SetCheckSelezionate(DefaultCheckPos())
    End Sub

Codice:
    Function DefaultCheckPos() As Boolean()
        Dim aCheck(5) As Boolean
        For k = 1 To 5
            aCheck(k) = True
        Next
        Return aCheck
    End Function
 
perfetto , ora bisogna alimentare la lista delle uscite , vedi che nella struttura formazione è presente un campo del tipo struct_uscita , vedi quali dati espone e intanto metti le colonne alla listview sotto
 
per evitare crash imprevisti sostituisci sia le 2 strutture che la routine della statistica. Inoltre la sub inizializza della struttura formazione è diventata una function , quindi devi cambiare con

if frz.inizializza (...) then
' fai la statistica
end if

Codice:
 Public Structure struct_uscita  'serve per memorizzare le uscite passate dopo l'esecuzione della statistica formazione

        Dim IdEstr As Integer
        Dim Ruota As Integer
        Dim aPos() As Boolean

        Dim Ritardo As Integer
        Dim RitardoMax As Integer
        Dim Frequenza As Integer
        Dim Presenze As Integer
        Dim IncrRitMax As Integer
        Dim EstrEsam As Integer

        Sub Dimensiona()
            ReDim aPos(5)
        End Sub
    End Structure

    Public Structure struct_formazione ' definisce una lunghetta da sottoporre all'analisi statistica
        Dim Inizio As Integer
        Dim Fine As Integer


        Dim Numeri As StrNumeri
        Dim aPosizioni() As Boolean
        Dim aRuote() As Boolean
        Dim Sorte As Integer

        Dim Ritardo As Integer
        Dim RitardoMax As Integer
        Dim Frequenza As Integer
        Dim Presenze As Integer
        Dim IncrRitMax As Integer


        Dim aUscite() As struct_uscita
        Dim UBoundaUscite As Integer
        Dim UBoundaUsciteCur As Integer

        Dim EstrEsam As Integer

        Function Inizializza(aNumeri() As Integer, aRuoteUsate() As Boolean, nSorte As Integer, RangeIni As Integer, RangeFin As Integer, Optional aPos() As Boolean = Nothing) As Boolean


            Try
                Dim qNumeri As Integer = aNumeri.GetUpperBound(0)
                Dim nPosUsate As Integer, nRuoteUsate As Integer

                Inizio = RangeIni
                Fine = RangeFin
                Sorte = nSorte

                ReDim aPosizioni(5)
                If IsNothing(aPos) Then
                    For k As Integer = 1 To 5
                        aPosizioni(k) = True
                        nPosUsate += 1
                    Next
                Else
                    For k As Integer = 1 To 5
                        aPosizioni(k) = aPos(k)
                        If aPos(k) Then nPosUsate += 1
                    Next
                End If

                ReDim aRuote(11)

                If aRuoteUsate(12) Then
                    For k As Integer = 1 To 10
                        aRuote(k) = True
                    Next
                    aRuote(11) = aRuoteUsate(11)
                Else
                    For k As Integer = 1 To 11
                        aRuote(k) = aRuoteUsate(k)
                    Next
                End If
                For k As Integer = 1 To 11
                    If aRuote(k) Then nRuoteUsate += 1

                Next


                Numeri.Dimensiona(qNumeri)
                For k As Integer = 1 To qNumeri
                    Numeri.SetNumero(aNumeri(k), k)
                Next

                Ritardo = 0
                RitardoMax = 0
                Frequenza = 0
                Presenze = 0
                EstrEsam = 0
                IncrRitMax = 0

                UBoundaUscite = 100
                UBoundaUsciteCur = 0
                ReDim aUscite(UBoundaUscite)
                If nRuoteUsate AndAlso nPosUsate AndAlso qNumeri AndAlso nSorte Then
                    If nSorte <= qNumeri Then Return True

                End If


            Catch ex As Exception

            End Try

            Return False

        End Function
        Sub AddUscita(Ritardo As Integer, RitardoMax As Integer, Frequenza As Integer, Presenze As Integer, IncrRitMax As Integer, IdEstr As Integer, Ruota As Integer, nEstrEsam As Integer, Optional aPos() As Boolean = Nothing)

            aUscite(UBoundaUsciteCur).IdEstr = IdEstr
            aUscite(UBoundaUsciteCur).Ritardo = Ritardo
            aUscite(UBoundaUsciteCur).RitardoMax = RitardoMax
            aUscite(UBoundaUsciteCur).Presenze = Presenze
            aUscite(UBoundaUsciteCur).Frequenza = Frequenza
            aUscite(UBoundaUsciteCur).IncrRitMax = IncrRitMax




            aUscite(UBoundaUsciteCur).Ruota = Ruota
            aUscite(UBoundaUsciteCur).Dimensiona()

            If Not IsNothing(aPos) Then
                For e = 1 To 5
                    aUscite(UBoundaUsciteCur).aPos(e) = aPos(e)
                Next
            End If

            UBoundaUsciteCur += 1

            If UBoundaUsciteCur = UBoundaUscite Then
                UBoundaUscite += 100
                ReDim Preserve aUscite(UBoundaUscite)
            End If
        End Sub
        Function GetQuantitaUscite() As Integer
            Return UBoundaUsciteCur - 1
        End Function

        Function GetQuantitaNumeri() As Integer
            Return Numeri.Estratto.GetUpperBound(0)

        End Function

        Sub ComprimiUscite()
            Dim x As Integer = GetQuantitaUscite()
            If x > 0 Then
                ReDim Preserve aUscite(GetQuantitaUscite)
            End If

        End Sub
    End Structure


Codice:
Friend Function StatFormazione(ByRef frz As struct_formazione) As Boolean
        Dim nPunti As Integer, nPuntiMax As Integer

        Dim aRetPosUscita() As Boolean
        Dim bNumPresenti As Boolean
        Dim nEstrTot As Integer = Estrazioni.GetUpperBound(0)
        Try

            If frz.Fine > nEstrTot Or frz.Fine <= 0 Then frz.Fine = nEstrTot
            If frz.Inizio <= 0 Then frz.Inizio = 1

            If frz.Inizio <= frz.Fine AndAlso nEstrTot > 0 AndAlso frz.GetQuantitaNumeri >= frz.Sorte Then
                For idEstr As Integer = frz.Inizio To frz.Fine


                    nPuntiMax = 0
                    bNumPresenti = False

                    For r As Integer = 1 To 11
                        If frz.aRuote(r) Then
                            nPunti = 0
                            ReDim aRetPosUscita(5)
                            If NumeroValido(Estrazioni(idEstr).Ruote(r).Estratto(1)) Then
                                bNumPresenti = True
                            End If
                            For e As Integer = 1 To 5
                                If frz.aPosizioni(e) Then
                                    If frz.Numeri.bEstratto(Estrazioni(idEstr).Ruote(r).Estratto(e)) Then
                                        nPunti += 1
                                        aRetPosUscita(e) = True

                                    End If
                                End If

                            Next
                            If nPunti > nPuntiMax Then
                                nPuntiMax = nPunti
                            End If
                            If nPunti >= frz.Sorte Then
                                frz.AddUscita(frz.Ritardo, frz.RitardoMax, frz.Frequenza, frz.Presenze, frz.IncrRitMax, idEstr, r, frz.EstrEsam + 1, aRetPosUscita)
                            End If
                        End If
                    Next
                    If bNumPresenti Then
                        If nPuntiMax >= frz.Sorte Then
                            If frz.Ritardo > frz.RitardoMax Then
                                frz.RitardoMax = frz.Ritardo
                            End If
                            frz.Ritardo = 0
                            frz.Presenze += 1
                            frz.Frequenza += Combinazioni(nPuntiMax, frz.Sorte)
                            frz.IncrRitMax = 0
                        Else
                            frz.Ritardo += 1
                            If frz.Ritardo > frz.RitardoMax Then
                                frz.IncrRitMax += 1
                            End If
                        End If


                        frz.EstrEsam += 1
                    End If


                Next

                frz.ComprimiUscite()
                Return frz.EstrEsam > 0
            End If
        Catch ex As Exception
            MessageBox.Show(ex.Message, "Errore", MessageBoxButtons.OK, MessageBoxIcon.Error)
        End Try

        Return False


    End Function
 
appena hai predisposto le colonne la cosa da fare è gestire l'evento della listview nel momento in cui si selezioan un item.
da quell'item tu devi ricavare tutti i parametri per inizializzare una formazione statistica , devi lanciare la statistica come facevi prima e questa volta
prima di tutto svuoti la lista (la seconda di cui stiamo parlando) e poi la alimenti leggendo l'array aUscite a partire dall'indice 0 fino al suo ubound
ogni elemento di quell'array contiene i dati da scrivere nella lista.
appena fatto posta il progetto che facciamo un punto della situazione
 
Codice:
 Private Sub CtlLvOrdinabile1_SelectedIndexChanged(sender As Object, e As EventArgs) Handles CtlLvOrdinabile1.SelectedIndexChanged
        PerformAddUscite()
    End Sub


    Sub PerformAddUscite()
        Dim frz As New struct_formazione
        Dim aNumeri() As Integer
        Dim aRuote() As Boolean
        Dim nSorte As Integer
        Dim Inizio As Integer
        Dim fine As Integer
        GetArrayNumeriFromString(TextBox1.Text, aNumeri)
        frmMain.CltSelRuote1.GetCheckSelezionate(aRuote)
        nSorte = Me.cmbsorte.SelectedItem
        Inizio = frmMain.CtlRangeEstrazioni1.Inizio
        fine = frmMain.CtlRangeEstrazioni1.Fine
        If frz.Inizializza(aNumeri, aRuote, nSorte, Inizio, fine) Then
            CtlLvOrdinabile2.Items.Clear()
            cArchivio.StatFormazione(frz)
            For k = 0 To UBound(frz.aUscite)
                Dim itm As ListViewItem = CtlLvOrdinabile2.Items.Add(frz.aUscite(k).IdEstr)
                itm.SubItems.Add(frz.aUscite(k).Ritardo)
                itm.SubItems.Add(frz.aUscite(k).RitardoMax)
                itm.SubItems.Add(frz.aUscite(k).Presenze)
                itm.SubItems.Add(frz.aUscite(k).Frequenza)
                itm.SubItems.Add(frz.aUscite(k).IncrRitMax)
            Next
        End If

    End Sub


Perfetto ora posto il progetto però devo dirti una cosa. A causa di un piccolo intervento (nulla di estremamente grave, quasi di routine) mi assenterò per una settimana a partire da domani. Non appena mi scarcerano ahaha sarò più che felice di continuare ad imparare con il tuo aiuto :D
Grazie davvero per quello che stai facendo per me :D Finalmente sto imparando come applicare il linguaggio :D
 
Ecco qui :D

 
Bravissimo Edo.

La salute prima di tutto :)

In questa settimana di pausa chi sta scaricando questo lavoro avrà tempo per studiare un po 👍
Ciao :)
 

Ultima estrazione Lotto

  • Estrazione del lotto
    sabato 11 gennaio 2025
    Bari
    73
    43
    01
    58
    81
    Cagliari
    69
    60
    18
    02
    10
    Firenze
    25
    32
    18
    55
    54
    Genova
    48
    05
    40
    34
    69
    Milano
    10
    07
    70
    44
    79
    Napoli
    11
    89
    01
    34
    80
    Palermo
    37
    80
    82
    44
    77
    Roma
    78
    04
    38
    39
    56
    Torino
    08
    13
    30
    27
    24
    Venezia
    56
    75
    36
    18
    70
    Nazionale
    63
    83
    19
    31
    80
    Estrazione Simbolotto
    Bari
    35
    34
    12
    23
    20
Indietro
Alto