L
LuigiB
Guest
bravo t ifunziona ?
Follow along with the video below to see how to install our site as a web app on your home screen.
Nota: This feature may not be available in some browsers.
Public collRuote As Dictionary(Of String, clsItemCombo)
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
If collRuote.ContainsKey("Ba") Then
cItm = collRuote("Ba")
End If
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
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.
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
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
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
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
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
Private Sub TextBox1_KeyDown(sender As Object, e As KeyEventArgs) Handles TextBox1.KeyDown
SoloCaratteriPerInserimentoLunghette(e)
End Sub
Private Sub frmStatLung_Load(sender As Object, e As EventArgs) Handles MyBase.Load
LoadComboSorte(cmbsorte)
addcolumns()
ctlSelPosizione1.SetCheckSelezionate(DefaultCheckPos())
End Sub
Function DefaultCheckPos() As Boolean()
Dim aCheck(5) As Boolean
For k = 1 To 5
aCheck(k) = True
Next
Return aCheck
End Function
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
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
non avevo letto questo, procedoperfetto , 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
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
bhe non ti porti il portatile per lavorare giorno e notte ? ehehh scherzo in bocca al lupo , avro tempo per fare i lpunto della situazione sul progetto. ciao ..E scusami per l'imprevisto
ahaha magari .. Crepi Perfetto ..ed io proverò a tirare fuori qualche idea innovativabhe non ti porti il portatile per lavorare giorno e notte ? ehehh scherzo in bocca al lupo , avro tempo per fare i lpunto della situazione sul progetto. ciao ..
Beh allora sarete in tanti credimi ahahaha ... L'ultima versione è stata scaricata da ben 50 persone e siamo solo all'inizioBravissimo Edo.
La salute prima di tutto
In questa settimana di pausa chi sta scaricando questo lavoro avrà tempo per studiare un po
Ciao