lotto_tom75
Advanced Premium Member
Codice:
Class clsSviluppo
Private aBNumDaSvil
Private nQNumeri
Private nCombInt
Private nClasse
Private aRighe
Private nQNumPerRiga
Private aPuntatore
Private nSviluppate
Function InitSviluppo(aNumeri,Classe)
nQNumeri = AlimentArrayNumDaSvil(aNumeri)
nCombInt = Combinazioni(nQNumeri,Classe)
nClasse = Classe
nSviluppate = 0
If nCombInt > 0 Then
Call AlimentaArrayRighe
Call InitArrayPuntatore
End If
InitSviluppo = nCombInt
End Function
Function GetQuantitaNumeriDaSvil
GetQuantitaNumeriDaSvil = nQNumeri
End Function
Function GetStringaNumDaSvil
Dim s,k
s = ""
For k = 1 To UBound(aBNumDaSvil)
If aBNumDaSvil(k) Then
s = s & Format2(k) & "."
End If
Next
GetStringaNumDaSvil = RimuoviLastChr(s,".")
End Function
Private Sub InitArrayPuntatore
Dim k
ReDim aPuntatore(nClasse)
For k = 1 To nClasse - 1
aPuntatore(k) = 1
Next
aPuntatore(k) = 0
End Sub
Function GetComb(aComb)
Dim nTmp,k,nPuntatore
nPuntatore = nClasse
nTmp = aPuntatore(nPuntatore) + 1
Do While nTmp > nQNumPerRiga
nPuntatore = nPuntatore - 1
If nPuntatore <= 0 Then Exit Do
nTmp = aPuntatore(nPuntatore) + 1
Loop
If nPuntatore > 0 Then
For k = nPuntatore To nClasse
aPuntatore(k) = nTmp
Next
ReDim aComb(nClasse)
For k = 1 To nClasse
aComb(k) = aRighe(k,aPuntatore(k))
Next
nSviluppate = nSviluppate + 1
GetComb = True
Else
GetComb = False
End If
End Function
Function GetQuantitaSviluppate
GetQuantitaSviluppate = nSviluppate
End Function
Private Function AlimentArrayNumDaSvil(aNumeri)
Dim k,q
aBNumDaSvil = ArrayNumeriToBool(aNumeri)
For k = 1 To 90
If aBNumDaSvil(k) Then
q = q + 1
End If
Next
AlimentArrayNumDaSvil = q
End Function
Private Sub AlimentaArrayRighe
Dim nRiga,k,aNumeri
Call ArrayBNumToArrayNum(aBNumDaSvil,aNumeri)
nQNumPerRiga =(nQNumeri - nClasse) + 1
ReDim aRighe(nClasse,nQNumPerRiga)
For nRiga = 1 To nClasse
For k = nRiga To(nRiga + nQNumPerRiga) - 1
aRighe(nRiga,(k - nRiga) + 1) = aNumeri(k)
Next
Next
End Sub
Sub OutputARighe
Dim k,j,s
For k = 1 To nClasse
s = ""
For j = 1 To nQNumPerRiga
s = s & Format2(aRighe(k,j)) & "."
Next
Call Scrivi(Format2(k) & ") " & RimuoviLastChr(s,"."))
Next
End Sub
End Class
Sub Main
Dim ce
Dim vettoreestrattiusciti
Dim estrattiusciti
estrattiusciti = "5 7 8"
Call SplitByChar(estrattiusciti," ",vettoreestrattiusciti)
For ce = 0 To UBound(vettoreestrattiusciti)
Scrivi "singolo estratto " & vettoreestrattiusciti(ce)
Next
Dim c
Dim aNumok
aNumok = Array(0)
Dim clSvi
Dim nClasse
Dim k,j
Dim sNumeri
Dim idComb
Dim nInizio,nFine
Dim idValoreDaAna
Dim sValoreUsato
Dim CombTot
Set clSvi = New clsSviluppo
Dim quantirisultati
Dim Col_Ord
Dim Tipo_Ord
Dim QNS
Dim aruote
Dim aNum
Dim tipoordinamentoscelto
Dim numeridaverificare
numeridaverificare = "1.2.3.4.5.6.7.8.9.10"
Call SplitByChar(numeridaverificare,".",aNum)
Dim v
'
For v = 0 To UBound(aNum)
Scrivi "|" & aNum(v) & "|"
Next
For c = 1 To UBound(aNum) - 1
aNum(c) = Int(aNum(c))
aNumok = array_push(aNumok,aNum(c))
Next
nClasse = 1
Dim nsorte
Call ScegliRuote(aruote)
nsorte = 1
Dim parametrodiordinamentofinale
parametrodiordinamentofinale = "f"
Dim tipodiordinamentofinale
tipodiordinamentofinale = "d"
Select Case(parametrodiordinamentofinale)
Case "f"
idValoreDaAna = 1
Col_Ord = 2
sValoreUsato = " frequenza "
Case "r"
idValoreDaAna = 2
Col_Ord = 3
sValoreUsato = " ritardo "
End Select
Select Case(tipodiordinamentofinale)
Case "d"
Tipo_Ord = 0
tipoordinamentoscelto = " decrescente "
Case "c"
Tipo_Ord = 1
tipoordinamentoscelto = " crescente "
End Select
nInizio = EstrazioneIni
nFine = EstrazioneFin
If nClasse > 0 And nsorte > 0 And nsorte <= nClasse And idValoreDaAna > 0 Then
Call Messaggio("Sviluppo combinazioni di classe " & nClasse)
CombTot = clSvi.InitSviluppo(aNumok,nClasse)
Call Messaggio("Lunghette totali da analizzare " & CombTot)
ReDim aCombMigliori(CombTot,6)
Call Messaggio("Statistica combinazioni in corso ")
ReDim aCol(nClasse)
Do While clSvi.GetComb(aCol) = True
Call AnalisiComb(aCol,aruote,nsorte,aCombMigliori,nInizio,nFine,idValoreDaAna)
k = k + 1
If k Mod 1 = 0 Then
Call Messaggio("Statistica combinazioni in corso " & k & " di " & CombTot)
Call AvanzamentoElab(1,CombTot,k)
If ScriptInterrotto Then Exit Do
End If
Call AvanzamentoElab(1,CombTot,k)
Loop
Call Messaggio("")
Scrivi
Scrivi
Call Scrivi("Combinazioni di" & "<font color=red> classe " & nClasse & "</font>" & " analizzate per" & "<font color=red> punti " & nsorte & "</font>" & " sulle ruote " & "<font color=red>" & GetRuoteUsate(aruote) & "</font>")
Call Scrivi("Combinazioni riportate in base al valore di" & "<font color=red>" & sValoreUsato & "</font>")
Call Scrivi("Risultati ordinati in modo" & "<font color=red>" & tipoordinamentoscelto & "</font>")
Call Scrivi("Range analizzato " & GetInfoEstrazione(nInizio) & " fino a " & GetInfoEstrazione(nFine))
Call Scrivi("Estrazioni analizzate totali : " &(nFine + 1) - nInizio)
Call Scrivi
For k = 1 To UBound(aCombMigliori)
ReDim ADati(6)
ADati(1) = aCombMigliori(k,4)
ADati(2) = aCombMigliori(k,1)
ADati(3) = aCombMigliori(k,2)
ADati(4) = aCombMigliori(k,3)
ADati(5) = aCombMigliori(k,5)
ADati(6) = aCombMigliori(k,6)
Dim cColonna
Dim contatore
contatore = contatore + 1
Dim diff
For ce = 0 To UBound(vettoreestrattiusciti)
If ADati(1) = vettoreestrattiusciti(ce) Then
Call Scrivi("<font color=red>formazione: " & ADati(1) & " -" & " FQ " & ADati(2) & " -" & " RA " & ADati(3) & " -" & " RS " & ADati(4) & " -" & diff & " <font color=red bgcolor=yellow>" & ADati(5) & " -" & " INCMAX " & ADati(6) & "</font>" & " -" & " contatore " & contatore & "</font>")
Else
Call Scrivi("formazione: " & ADati(1) & " -" & " FQ " & ADati(2) & " -" & " RA " & ADati(3) & " -" & " RS " & ADati(4) & " - DIFF " & ADati(5) & " -" & " INCMAX " & ADati(6) & " -" & " contatore " & contatore)
End If
If ScriptInterrotto Then Exit For
Next
If ScriptInterrotto Then Exit For
Next
Call Scrivi
Call Scrivi("Tempo trascorso: " & TempoTrascorso)
Call Scrivi
Else
MsgBox "Selezionare la classe di sviluppo e la Sorte , " & _
"si ricorda che la Sorte non puo essere maggiore della classe di sviluppo " & _
"e che bisogna scegliere quale valore statistico considerare per " & _
"alimentare la lista delle prime N Combinazioni desiderate da mostrare in output "
Stop
End If
End Sub
Sub AnalisiComb(aNum,aRuote,Sorte,aCombMig,nInizio,nFine,idValoreDaAna)
Dim k,j
Dim Rit
Dim RitMax
Dim Freq
Dim Valore
Dim diff
Dim RetIncrRitMax
Call StatisticaFormazioneTurbo(aNum,aRuote,Sorte,Rit,RitMax,RetIncrRitMax,Freq,nInizio,nFine)
diff = RitMax - Rit
Select Case idValoreDaAna
Case 1
Valore = Freq
Case 2
Valore = Rit
Case 3
Valore = RitMax
End Select
For k = 1 To UBound(aCombMig)
If Valore >= aCombMig(k,0) Then
For j = UBound(aCombMig) To(k + 1) Step - 1
aCombMig(j,0) = aCombMig(j - 1,0)
aCombMig(j,1) = aCombMig(j - 1,1)
aCombMig(j,2) = aCombMig(j - 1,2)
aCombMig(j,3) = aCombMig(j - 1,3)
aCombMig(j,4) = aCombMig(j - 1,4)
aCombMig(j,5) = aCombMig(j - 1,5)
aCombMig(j,6) = aCombMig(j - 1,6)
Next
aCombMig(k,0) = Valore
aCombMig(k,1) = Freq
aCombMig(k,2) = Rit
aCombMig(k,3) = RitMax
aCombMig(k,4) = StringaNumeri(aNum)
aCombMig(k,5) = diff
aCombMig(k,6) = RetIncrRitMax
Exit For
End If
Next
End Sub
Function ScegliSorte()
ReDim aVoci(4)
aVoci(0) = "Estratto"
aVoci(1) = "Ambo"
aVoci(2) = "Terno"
aVoci(3) = "Quaterna"
aVoci(4) = "Cinquina"
ScegliSorte = ScegliOpzioneMenu(aVoci,1,"Scegli Sorte") + 1
End Function
Function ScegliValoreDaAnalizzare(sValore,parametro)
ReDim aVoci(4)
Dim i
aVoci(0) = "Frequenza"
aVoci(1) = "Ritardo"
aVoci(2) = "Ritardo massimo"
aVoci(3) = "Differenza Aurea"
aVoci(4) = "IncMax"
i = ScegliOpzioneMenu(aVoci,1,"Quale valore considerare per l'ordinamento ? ")
sValore = aVoci(i)
ScegliValoreDaAnalizzare = i + 1
End Function
Function GetRuoteUsate(aRuote)
Dim k
Dim s
For k = 1 To UBound(aRuote)
s = s & SiglaRuota(aRuote(k)) & " "
Next
GetRuoteUsate = Trim(s)
End Function
Function array_push(arr,vars)
Dim k,newelem,newarrsize,elem
If IsArray(arr) Then
If Len(vars) > 0 Then
If InStr(vars,",") = False Then
newarrsize = CInt(UBound(arr) + 1)
ReDim Preserve arr(newarrsize)
arr(newarrsize) = vars
Else
k =(UBound(arr) + 1)
newelem = Split(vars,",")
newarrsize = CInt(UBound(arr) + UBound(newelem) + 1)
ReDim Preserve arr(newarrsize)
For Each elem In newelem
arr(k) = Trim(elem)
k = k + 1
Next
End If
End If
array_push = arr
Else
array_push = False
End If
End Function
Function SelEsito
Dim ret
Dim aVoci
For ret = 1 To 1
SelEsito = ret
Next
End FunctionSe lo si esegue si ottiene il seguente output
singolo estratto 5
singolo estratto 7
singolo estratto 8
|1|
|2|
|3|
|4|
|5|
|6|
|7|
|8|
|9|
|10|
Combinazioni di classe 1 analizzate per punti 1 sulle ruote BA
Combinazioni riportate in base al valore di frequenza
Risultati ordinati in modo decrescente
Range analizzato [00001] [ 1 ] 07.01.1871 fino a [10032] [ 9 ] 20.01.2022
Estrazioni analizzate totali : 10032
formazione: 5 - FQ 591 - RA 19 - RS 108 - 89 - INCMAX 0 - contatore 1
formazione: 5 - FQ 591 - RA 19 - RS 108 - DIFF 89 - INCMAX 0 - contatore 1
formazione: 5 - FQ 591 - RA 19 - RS 108 - DIFF 89 - INCMAX 0 - contatore 1
formazione: 4 - FQ 570 - RA 51 - RS 103 - DIFF 52 - INCMAX 0 - contatore 2
formazione: 4 - FQ 570 - RA 51 - RS 103 - DIFF 52 - INCMAX 0 - contatore 2
formazione: 4 - FQ 570 - RA 51 - RS 103 - DIFF 52 - INCMAX 0 - contatore 2
formazione: 8 - FQ 548 - RA 25 - RS 145 - DIFF 120 - INCMAX 0 - contatore 3
formazione: 8 - FQ 548 - RA 25 - RS 145 - DIFF 120 - INCMAX 0 - contatore 3
formazione: 8 - FQ 548 - RA 25 - RS 145 - 120 - INCMAX 0 - contatore 3
formazione: 3 - FQ 540 - RA 25 - RS 115 - DIFF 90 - INCMAX 0 - contatore 4
formazione: 3 - FQ 540 - RA 25 - RS 115 - DIFF 90 - INCMAX 0 - contatore 4
formazione: 3 - FQ 540 - RA 25 - RS 115 - DIFF 90 - INCMAX 0 - contatore 4
formazione: 9 - FQ 539 - RA 9 - RS 91 - DIFF 82 - INCMAX 0 - contatore 5
formazione: 9 - FQ 539 - RA 9 - RS 91 - DIFF 82 - INCMAX 0 - contatore 5
formazione: 9 - FQ 539 - RA 9 - RS 91 - DIFF 82 - INCMAX 0 - contatore 5
formazione: 2 - FQ 529 - RA 12 - RS 104 - DIFF 92 - INCMAX 0 - contatore 6
formazione: 2 - FQ 529 - RA 12 - RS 104 - DIFF 92 - INCMAX 0 - contatore 6
formazione: 2 - FQ 529 - RA 12 - RS 104 - DIFF 92 - INCMAX 0 - contatore 6
formazione: 6 - FQ 513 - RA 96 - RS 125 - DIFF 29 - INCMAX 0 - contatore 7
formazione: 6 - FQ 513 - RA 96 - RS 125 - DIFF 29 - INCMAX 0 - contatore 7
formazione: 6 - FQ 513 - RA 96 - RS 125 - DIFF 29 - INCMAX 0 - contatore 7
formazione: 7 - FQ 499 - RA 46 - RS 146 - DIFF 100 - INCMAX 0 - contatore 8
formazione: 7 - FQ 499 - RA 46 - RS 146 - 100 - INCMAX 0 - contatore 8
formazione: 7 - FQ 499 - RA 46 - RS 146 - DIFF 100 - INCMAX 0 - contatore 8
Tempo trascorso: 00:00:08
Tutto bene... tranne il fatto che le risultanze di riga sono sempre uguali al numero degli estratti verificati... anzichè essere una riga soltanto per ogni numero da verificare come dovrebbe essere...
es. se gli estratti fossero stati 5 lo script avrebbe mostrato 5 righe per ogni numero da verificare... ecc...
Grazie a chi riuscirà a sistemarlo in modo che l'output di esempio diventi...
Combinazioni di classe 1 analizzate per punti 1 sulle ruote BA
Combinazioni riportate in base al valore di frequenza
Risultati ordinati in modo decrescente
Range analizzato [00001] [ 1 ] 07.01.1871 fino a [10032] [ 9 ] 20.01.2022
Estrazioni analizzate totali : 10032
formazione: 5 - FQ 591 - RA 19 - RS 108 - 89 - INCMAX 0 - contatore 1
formazione: 4 - FQ 570 - RA 51 - RS 103 - DIFF 52 - INCMAX 0 - contatore 2
formazione: 8 - FQ 548 - RA 25 - RS 145 - DIFF 120 - INCMAX 0 - contatore 3
formazione: 3 - FQ 540 - RA 25 - RS 115 - DIFF 90 - INCMAX 0 - contatore 4
formazione: 9 - FQ 539 - RA 9 - RS 91 - DIFF 82 - INCMAX 0 - contatore 5
formazione: 2 - FQ 529 - RA 12 - RS 104 - DIFF 92 - INCMAX 0 - contatore 6
formazione: 6 - FQ 513 - RA 96 - RS 125 - DIFF 29 - INCMAX 0 - contatore 7
formazione: 7 - FQ 499 - RA 46 - RS 146 - DIFF 100 - INCMAX 0 - contatore 8
ovvero presenti appunto una sola riga per numero da verificare...
usando PuntiSuArray 
