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.
testala solo virtualmente con classi medio alte tipo <= 10 elementi e per sorti medio basse <= 2. su una o più ruote unite e divertiti.. a vedere se, magari anche testando vari range temporali di analisi, le relative risultanze sfaldano o meno nei colpi ipotizzati dai valori estremi di ra , fq, diff ecc... riportati in output...
Option Explicit
Sub Main
'script by lotto_tom75 per raggruppare e analizzare i numeri estratti in una determinata posizione su TT le 'ruote. Interessante per generare gruppi base estremamente ridotti per ulteriori sviluppi x s2 e superiori su TT 'unite e separate.
Dim es
Dim Ruota
Dim esito
Dim colpi
Dim sorte
Dim alcolpo,estratti,idesuscita
Dim aruote(11)
Dim colpomassimo
colpomassimo = 0
Dim esitinegativientroicolpiimpostati
esitinegativientroicolpiimpostati = 0
Dim esitipositivientroicolpiimpostati
esitipositivientroicolpiimpostati = 0
Dim EstrazioneInizio
Dim quanteultimeestrazionianalizzare
Dim EstrazioneIniziooultimeestrazioni
Dim opzioneiuscelta
aruote(1) = BA_
aruote(2) = CA_
aruote(3) = FI_
aruote(4) = GE_
aruote(5) = MI_
aruote(6) = NA_
aruote(7) = PA_
aruote(8) = RO_
aruote(9) = TO_
aruote(10) = VE_
aruote(11) = NZ_
ReDim gu(12)
Dim Estrattoinposizionevoluta
Dim Posizionevoluta
Dim sortediverifica
Dim colpidiverifica
Posizionevoluta = CInt(InputBox("posizione voluta",,1))
sortediverifica = ScegliEsito(2,1,5)
colpidiverifica = CInt(InputBox("colpidiverifica",,16))
EstrazioneIniziooultimeestrazioni = InputBox("estrazione inizio (i) o ultime estrazioni (u)",,"i")
If EstrazioneIniziooultimeestrazioni = "i" Then
EstrazioneInizio = CInt(InputBox("estrazione inizio voluta",,8117))
opzioneiuscelta = EstrazioneInizio
Else
quanteultimeestrazionianalizzare = CInt(InputBox("quante ultime estrazioni analizzare ",,180))
opzioneiuscelta = EstrazioneFin - quanteultimeestrazionianalizzare
End If
For es = opzioneiuscelta To EstrazioneFin
For Ruota = 1 To 12
If Ruota = 11 Then
Ruota = 12
End If
Estrattoinposizionevoluta = Int(Estratto(es,Ruota,Posizionevoluta))
gu(Ruota) = Estrattoinposizionevoluta
'Scrivi StringaNumeri(gu)
If ScriptInterrotto Then Exit For
Next 'x ruota
Scrivi StringaNumeri(gu)
Call VerificaEsitoTurbo(gu,aruote,es + 1,sortediverifica,colpidiverifica,,esito,alcolpo,estratti,idesuscita)
If esito <> "" Or esito <> Null Then
Scrivi esito & " - al colpo numero " & alcolpo & " con estratti " & estratti & " nell'es num. " & idesuscita
esitipositivientroicolpiimpostati = esitipositivientroicolpiimpostati +1
If alcolpo > colpomassimo Then
colpomassimo = alcolpo
End If
Else
Scrivi "no",True,,,vbRed
esitinegativientroicolpiimpostati = esitinegativientroicolpiimpostati + 1
End If
Call AvanzamentoElab(EstrazioneIni,EstrazioneFin,es)
If ScriptInterrotto Then Exit For
Next ' x es
Scrivi
Scrivi
If opzioneiuscelta = "i" Then
Scrivi "range temporale analizzato a partire dall'es num. " & EstrazioneInizio
Else
Scrivi "range temporale analizzato : le ultime " & quanteultimeestrazionianalizzare & " estrazioni"
End If
Scrivi "posizione di raccolta " & Posizionevoluta
Scrivi "colpo massimo " & colpomassimo
Scrivi "esiti positivi entro i colpi impostati " & esitipositivientroicolpiimpostati
Scrivi "esiti negativi entro i colpi impostati " & esitinegativientroicolpiimpostati
Scrivi
Scrivi "Nessuna Certezza Solo Poca Probabilità"
Scrivi
Scrivi TempoTrascorso
End Sub
'tom's bakery cript by tom genera archivi voluti per ruota voluta con ordinamento estrazione recente in alto ed estrazione remota in basso.
Option Explicit
Sub Main
Dim es
Dim ruota
Dim Inizio
Dim ruotavoluta
Dim tempo
Dim Posizionevoluta
Dim fileestrazionixAIlottoProject
Dim fc
Dim fileconfermaazione
ruotavoluta = ScegliRuota
Inizio = EstrazioneIni '
Dim filearchivioxruotavoluta
filearchivioxruotavoluta = "estrazioni-" & SiglaRuota(ruotavoluta) & ".txt"
Scrivi
Scrivi "File " & "estrazioni-" & SiglaRuota(ruotavoluta) & ".txt" & " per la ruota di " & NomeRuota(ruotavoluta) & " aggiornato con successo!"
Scrivi "All'ultima estrazione della ruota " & NomeRuota(ruotavoluta) & " n. " & GetInfoEstrazione(EstrazioniArchivio)
Scrivi "Range archivio estrazioni presente nel file " & GetInfoEstrazione(EstrazioneIni) & "-" & GetInfoEstrazione(EstrazioniArchivio)
Scrivi "Estrazioni presenti nel file: " &(EstrazioniArchivio - EstrazioneIni) + 1
Scrivi "Ordine di apparizione delle estrazioni: estrazione + recente in alto ed estrazione + remota in basso"
Scrivi
For es = EstrazioneFin To Inizio Step - 1
tempo = Int(tempo + 1)
For ruota = ruotavoluta To ruotavoluta
If ruota = 11 Then
ruota = 12
End If
Scrivi StringaEstratti(es,ruota,".")
ScriviFile filearchivioxruotavoluta,StringaEstratti(es,ruota,".")
If ScriptInterrotto Then Exit For
Next 'x ruota
If ScriptInterrotto Then Exit For
Next ' x es
CloseFileHandle(filearchivioxruotavoluta)
Call MsgBox("Archivio lotto per la ruota " & NomeRuota(ruotavoluta) & " aggiornato con successo!")
End SubBuon di Lotto Tom....sto facendo delle prove con questa tua "Ferrari" Script 37/B.. cortesemente possibile fare una piccola modifica?Option Explicit
Sub Main
'Script n. 37B tom's bakery x lotto by tom ; rileva ordinamenti per parametro voluto secondo classe (<= 20) e sorte desiderate sulle ruote separate selezionate
'dando la possibilità di scegliere anche numeri fissi x il relativo sviluppo. Ordinando i risultati per il parametro voluto è possibile avere subito a colpo d'occhio
'la situazione per l'eventuale presenza di casi sincroni, isofrequenti ecc.. Aggiunte opzioni: 0 fissi e ruote unite
Dim nClasse,nSorte,RetRit1,RetRitMax,RetIncrRitMax,RetFreq
Dim k,i
Dim RuoteSelezionate,QuantitaNumeriScelti
Dim MS,aRetCol
ReDim anumeri(0)
ReDim aFissi(0)
Dim contatore
Dim modalitaruote
Dim confissiosenza
MsgBox("scegli classe; ricorda che deve essere <=20")
nClasse = CInt(InputBox("scegli classe (<= 20) ",,2))
Dim fissiono
fissiono = InputBox("analisi con fissi (f) o no?",,"n")
Dim ruoteuniteoseparate
ruoteuniteoseparate = InputBox("ruote unite (u) o separate (s)?",,"u")
If ruoteuniteoseparate = "s" Then
MsgBox "hai scelto di elaborare su ruote separate"
If fissiono = "f" Then
MsgBox("Scegli fisso(i)")
ScegliNumeri(aFissi)
MsgBox("fissi " & StringaNumeri(aFissi))
If UBound(aFissi) <= nClasse Then
nSorte = ScegliEsito(2,1,5)
Else
MsgBox("La quantità di numeri fissi deve essere ovviamente minore o uguale rispetto il numero di classe di sviluppo")
End If
MsgBox("Scegli gruppo base che deve essere ovviamente maggiore o uguale rispetto alla classe scelta")
ScegliNumeri(anumeri)
Else ' x fissiono
aFissino = Array(0)
MsgBox("Scegli gruppo base che deve essere ovviamente maggiore o uguale rispetto alla classe scelta")
ScegliNumeri(anumeri)
MsgBox "scegli sorte di ricerca"
nSorte = ScegliEsito(2,1,5)
End If 'x fissiono
If UBound(anumeri) >= nClasse Then
ReDim aRuoteSel(12)
MsgBox("Scegli ruota o ruote")
RuoteSelezionate = ScegliRuote(aRuoteSel)
Else
MsgBox("La quantità di numeri del gruppo base deve essere ovviamente maggiore o uguale rispetto il numero di classe di sviluppo")
End If
Dim parametroxordinamento
Dim versodiordinamento
parametroxordinamento = CInt(InputBox("Scegli il parametro di ordinamento per i risultati in tabella: ra (1); rs (2); fq (3); incmax (4)",,1))
versodiordinamento = CInt(InputBox("Scegli il verso di ordinamento dei risultati in tabella: decrescente (0): crescente (1)",,0))
Scrivi "Elaborazione effettuata con archivio aggiornato al " & GetInfoEstrazione(EstrazioneFin)
Scrivi "Range temporale analizzato " & GetInfoEstrazione(EstrazioneIni) & " - " & GetInfoEstrazione(EstrazioneFin)
Scrivi TestoInBandaPassante("Enjoy with this little script n.37 by tom's bakery
Scrivi "Classe di sviluppo " & nClasse
Scrivi "Sorte di ricerca " & nSorte
Scrivi "Numeri fissi (cg) " & StringaNumeri(aFissi)
Scrivi "Parametro di ordinamento (1:ra; 2:rs; 3:fq; 4:incmax) : " & parametroxordinamento
Scrivi "Modalità di ordinamento (0: decrescente ; 1: crescente) : " & versodiordinamento
If fissiono = "f" Then
Scrivi "Modalità elaborazione con fissi: " & " attiva "
Else
Scrivi "Modalità elaborazione con fissi: " & " disattiva "
End If
If ruoteuniteoseparate = "s" Then
Scrivi "Modalità elaborazione con ruote: " & " separate "
Else
Scrivi "Modalità elaborazione con ruote: " & " unite "
End If
Dim raccoltarisultati
ReDim titolitabella(6)
titolitabella(1) = "ruota"
titolitabella(2) = "numeri"
titolitabella(3) = "ra"
titolitabella(4) = "rs"
titolitabella(5) = "incmax"
titolitabella(6) = "fq"
Call InitTabella(titolitabella)
ReDim Valoriditabella(6)
For k = 1 To RuoteSelezionate
Call Scrivi("Scelta ruota " & NomeRuota(aRuoteSel(k)) & " - " & SiglaRuota(aRuoteSel(k)))
Next
Set MS = GetMotoreSviluppoIntegrale
If fissiono = "f" Then
Call MS.InitSviluppoIntegrale(anumeri,nClasse,aFissi)
Else
Call MS.InitSviluppoIntegrale(anumeri,nClasse,aFissino)
End If
Do While ms.GetCombSviluppo(aRetCol)
i = i + 1
ReDim aRuoteTmp(1)
For k = 1 To RuoteSelezionate
aRuoteTmp(1) = aRuoteSel(k)
Call StatisticaFormazioneTurbo(aRetCol,aRuoteTmp,nSorte,RetRit1,RetRitMax,RetIncrRitMax,RetFreq)
Dim Diff
Diff = RetRitMax - RetRit1
Dim rapportoRARS
If(RetRit1 >= 0) Then ' <- qui si può modificare il filtro di selezione come si preferisce...
contatore = contatore + 1
Valoriditabella(1) = NomeRuota(aRuoteTmp(1))
Valoriditabella(2) = StringaNumeri(aRetCol)
Valoriditabella(3) = RetRit1
Valoriditabella(4) = RetRitMax
Valoriditabella(5) = RetIncrRitMax
Valoriditabella(6) = RetFreq
Call AddRigaTabella(Valoriditabella)
End If
If ScriptInterrotto Then Exit For
Next
If ScriptInterrotto Then Exit Do
Call Messaggio("riga: " & i & " | " & "trovate: " & contatore)
Loop
Set MS = Nothing
Call Scrivi
Select Case(parametroxordinamento)
Case 1
Call CreaTabella(3,versodiordinamento)
Case 2
Call CreaTabella(4,versodiordinamento)
Case 3
Call CreaTabella(5,versodiordinamento)
Case 5
Call CreaTabella(6,versodiordinamento)
End Select
Call Scrivi
Call Scrivi("Tempo trascorso " & TempoTrascorso)
Else ' x ruote unite
MsgBox "hai scelto di elaborare su ruote unite"
If fissiono = "f" Then
MsgBox "hai scelto di elaborare con i fissi"
MsgBox("Scegli fisso(i)")
ScegliNumeri(aFissi)
MsgBox("fissi " & StringaNumeri(aFissi))
If UBound(aFissi) <= nClasse Then
nSorte = ScegliEsito(2,1,5)
Else
MsgBox("La quantità di numeri fissi deve essere ovviamente minore o uguale rispetto il numero di classe di sviluppo")
End If
MsgBox("Scegli gruppo base che deve essere ovviamente maggiore o uguale rispetto alla classe scelta")
ScegliNumeri(anumeri)
Else ' x fissiono
MsgBox "hai scelto di elaborare senza fissi"
Dim aFissino
aFissino = Array(0)
MsgBox("Scegli gruppo base che deve essere ovviamente maggiore o uguale rispetto alla classe scelta")
ScegliNumeri(anumeri)
MsgBox "scegli sorte di ricerca"
nSorte = ScegliEsito(2,1,5)
End If 'x fissiono
If UBound(anumeri) >= nClasse Then
ReDim aRuoteSel(12)
MsgBox("Scegli ruota o ruote")
RuoteSelezionate = ScegliRuote(aRuoteSel)
Else
MsgBox("La quantità di numeri del gruppo base deve essere ovviamente maggiore o uguale rispetto il numero di classe di sviluppo")
End If
parametroxordinamento = CInt(InputBox("Scegli il parametro di ordinamento per i risultati in tabella: ra (1); rs (2); fq (3); incmax (4)",,1))
versodiordinamento = CInt(InputBox("Scegli il verso di ordinamento dei risultati in tabella: decrescente (0): crescente (1)",,0))
Scrivi "Elaborazione effettuata con archivio aggiornato al " & GetInfoEstrazione(EstrazioneFin)
Scrivi "Range temporale analizzato " & GetInfoEstrazione(EstrazioneIni) & " - " & GetInfoEstrazione(EstrazioneFin)
Scrivi TestoInBandaPassante("Enjoy with this little script n.37 by tom's bakery
Scrivi "Classe di sviluppo " & nClasse
Scrivi "Sorte di ricerca " & nSorte
Scrivi "Numeri fissi (cg) " & StringaNumeri(aFissino)
Scrivi "Parametro di ordinamento (1:ra; 2:rs; 3:fq; 4:incmax) : " & parametroxordinamento
Scrivi "Modalità di ordinamento (0: decrescente ; 1: crescente) : " & versodiordinamento
If fissiono = "f" Then
Scrivi "Modalità elaborazione con fissi: " & " attiva "
Else
Scrivi "Modalità elaborazione con fissi: " & " disattiva "
End If
If ruoteuniteoseparate = "s" Then
Scrivi "Modalità elaborazione con ruote: " & " separate "
Else
Scrivi "Modalità elaborazione con ruote: " & " unite "
End If
ReDim titolitabella(6)
titolitabella(1) = "ruota"
titolitabella(2) = "numeri"
titolitabella(3) = "ra"
titolitabella(4) = "rs"
titolitabella(5) = "incmax"
titolitabella(6) = "fq"
Call InitTabella(titolitabella)
ReDim Valoriditabella(6)
Set MS = GetMotoreSviluppoIntegrale
If fissiono = "f" Then
Call MS.InitSviluppoIntegrale(anumeri,nClasse,aFissi)
Else
Call MS.InitSviluppoIntegrale(anumeri,nClasse,aFissino)
End If
Do While ms.GetCombSviluppo(aRetCol)
i = i + 1
ReDim aRuote(UBound(aRuoteSel))
For k = 1 To UBound(aRuoteSel)
aRuote(k) = aRuoteSel(k)
Next
Call StatisticaFormazioneTurbo(aRetCol,aRuote,nSorte,RetRit1,RetRitMax,RetIncrRitMax,RetFreq)
Diff = RetRitMax - RetRit1
If(RetRit1 >= 0) Then ' <- qui si può modificare il filtro di selezione come si preferisce...
contatore = contatore + 1
Valoriditabella(1) = StringaRuote(aRuote)
Valoriditabella(2) = StringaNumeri(aRetCol)
Valoriditabella(3) = RetRit1
Valoriditabella(4) = RetRitMax
Valoriditabella(5) = RetIncrRitMax
Valoriditabella(6) = RetFreq
Call AddRigaTabella(Valoriditabella)
End If
If ScriptInterrotto Then Exit Do
Call Messaggio("riga: " & i & " | " & "trovate: " & contatore)
Loop
Set MS = Nothing
Call Scrivi
Select Case(parametroxordinamento)
Case 1
Call CreaTabella(3,versodiordinamento)
Case 2
Call CreaTabella(4,versodiordinamento)
Case 3
Call CreaTabella(5,versodiordinamento)
Case 5
Call CreaTabella(6,versodiordinamento)
End Select
Call Scrivi
Call Scrivi("Tempo trascorso " & TempoTrascorso)
End If ' per uniteoseparate
End Sub
[/code]
Ciao scusami ti faccio vedere che tipo di ricerca faccio Elaborazione effettuata con archivio aggiornato al [10544] [182] 14.11.2024
Sub Main()
Dim nClasse,nSorte,RetRit1,RetRitMax,RetIncrRitMax,RetFreq
Dim k,i
Dim RuoteSelezionate,QuantitaNumeriScelti
Dim MS,aRetCol
ReDim anumeri(0)
ReDim aFissi(0)
Dim contatore
Dim modalitaruote
Dim confissiosenza
Dim TutteRuote
MsgBox("scegli classe; ricorda che deve essere <=20")
nClasse = CInt(InputBox("scegli classe (<= 20) ",,2))
Dim fissiono
fissiono = InputBox("analisi con fissi (f) o no (n)?",,"n")
Dim ruoteuniteoseparate
ruoteuniteoseparate = InputBox("ruote unite (u) o separate (s)?",,"u")
If ruoteuniteoseparate = "s" Then
MsgBox "hai scelto di elaborare su ruote separate"
If fissiono = "f" Then
MsgBox("Scegli fisso(i)")
ScegliNumeri(aFissi)
MsgBox("fissi " & StringaNumeri(aFissi))
If UBound(aFissi) <= nClasse Then
nSorte = ScegliEsito(2,1,5)
Else
MsgBox("La quantità di numeri fissi deve essere ovviamente minore o uguale rispetto il numero di classe di sviluppo")
End If
MsgBox("Scegli gruppo base che deve essere ovviamente maggiore o uguale rispetto alla classe scelta")
ScegliNumeri(anumeri)
Else ' x fissiono
aFissino = Array(0)
MsgBox("Scegli gruppo base che deve essere ovviamente maggiore o uguale rispetto alla classe scelta")
ScegliNumeri(anumeri)
MsgBox "scegli sorte di ricerca"
nSorte = ScegliEsito(2,1,5)
End If 'x fissiono
If UBound(anumeri) >= nClasse Then
ReDim aRuoteSel(12)
MsgBox("Scegli ruota o ruote")
RuoteSelezionate = ScegliRuote(aRuoteSel,TutteRuote)
Else
MsgBox("La quantità di numeri del gruppo base deve essere ovviamente maggiore o uguale rispetto il numero di classe di sviluppo")
End If
Dim parametroxordinamento
Dim versodiordinamento
parametroxordinamento = CInt(InputBox("Scegli il parametro di ordinamento per i risultati in tabella: ra (1); rs (2); fq (3); incmax (4)",,1))
versodiordinamento = CInt(InputBox("Scegli il verso di ordinamento dei risultati in tabella: decrescente (0): crescente (1)",,0))
Scrivi "Elaborazione effettuata con archivio aggiornato al " & GetInfoEstrazione(EstrazioneFin)
Scrivi "Range temporale analizzato " & GetInfoEstrazione(EstrazioneIni) & " - " & GetInfoEstrazione(EstrazioneFin)
Scrivi TestoInBandaPassante("Enjoy with this little script n.37 by tom's bakery :) ",True,vbYellow,vbRed)
Scrivi "Classe di sviluppo " & nClasse
Scrivi "Sorte di ricerca " & nSorte
Scrivi "Numeri fissi (cg) " & StringaNumeri(aFissi)
Scrivi "Parametro di ordinamento (1:ra; 2:rs; 3:fq; 4:incmax) : " & parametroxordinamento
Scrivi "Modalità di ordinamento (0: decrescente ; 1: crescente) : " & versodiordinamento
If fissiono = "f" Then
Scrivi "Modalità elaborazione con fissi: " & " attiva "
Else
Scrivi "Modalità elaborazione con fissi: " & " disattiva "
End If
If ruoteuniteoseparate = "s" Then
Scrivi "Modalità elaborazione con ruote: " & " separate "
Else
Scrivi "Modalità elaborazione con ruote: " & " unite "
End If
Dim raccoltarisultati
ReDim titolitabella(6)
titolitabella(1) = "ruota"
titolitabella(2) = "numeri"
titolitabella(3) = "ra"
titolitabella(4) = "rs"
titolitabella(5) = "incmax"
titolitabella(6) = "fq"
Call InitTabella(titolitabella)
ReDim Valoriditabella(6)
For k = 1 To RuoteSelezionate
Call Scrivi("Scelta ruota " & NomeRuota(aRuoteSel(k)) & " - " & SiglaRuota(aRuoteSel(k)))
Next
Set MS = GetMotoreSviluppoIntegrale
If fissiono = "f" Then
Call MS.InitSviluppoIntegrale(anumeri,nClasse,aFissi)
Else
Call MS.InitSviluppoIntegrale(anumeri,nClasse,aFissino)
End If
Do While ms.GetCombSviluppo(aRetCol)
i = i + 1
ReDim aRuoteTmp(1)
For k = 1 To RuoteSelezionate
aRuoteTmp(1) = aRuoteSel(k)
Call StatisticaFormazioneTurbo(aRetCol,aRuoteTmp,nSorte,RetRit1,RetRitMax,RetIncrRitMax,RetFreq)
Dim Diff
Diff = RetRitMax - RetRit1
Dim rapportoRARS
If(RetRit1 >= 0) Then ' <- qui si può modificare il filtro di selezione come si preferisce...
contatore = contatore + 1
Valoriditabella(1) = NomeRuota(aRuoteTmp(1))
Valoriditabella(2) = StringaNumeri(aRetCol)
Valoriditabella(3) = RetRit1
Valoriditabella(4) = RetRitMax
Valoriditabella(5) = RetIncrRitMax
Valoriditabella(6) = RetFreq
Call AddRigaTabella(Valoriditabella)
End If
If ScriptInterrotto Then Exit For
Next
If ScriptInterrotto Then Exit Do
Call Messaggio("riga: " & i & " | " & "trovate: " & contatore)
Loop
Set MS = Nothing
Call Scrivi
Select Case(parametroxordinamento)
Case 1
Call CreaTabella(3,versodiordinamento)
Case 2
Call CreaTabella(4,versodiordinamento)
Case 3
Call CreaTabella(5,versodiordinamento)
Case 5
Call CreaTabella(6,versodiordinamento)
End Select
Call Scrivi
Call Scrivi("Tempo trascorso " & TempoTrascorso)
Else ' x ruote unite
MsgBox "hai scelto di elaborare su ruote unite"
If fissiono = "f" Then
MsgBox "hai scelto di elaborare con i fissi"
MsgBox("Scegli fisso(i)")
ScegliNumeri(aFissi)
MsgBox("fissi " & StringaNumeri(aFissi))
If UBound(aFissi) <= nClasse Then
nSorte = ScegliEsito(2,1,5)
Else
MsgBox("La quantità di numeri fissi deve essere ovviamente minore o uguale rispetto il numero di classe di sviluppo")
End If
MsgBox("Scegli gruppo base che deve essere ovviamente maggiore o uguale rispetto alla classe scelta")
ScegliNumeri(anumeri)
Else ' x fissiono
MsgBox "hai scelto di elaborare senza fissi"
Dim aFissino
aFissino = Array(0)
MsgBox("Scegli gruppo base che deve essere ovviamente maggiore o uguale rispetto alla classe scelta")
ScegliNumeri(anumeri)
MsgBox "scegli sorte di ricerca"
nSorte = ScegliEsito(2,1,5)
End If 'x fissiono
If UBound(anumeri) >= nClasse Then
ReDim aRuoteSel(12)
MsgBox("Scegli ruota o ruote")
RuoteSelezionate = ScegliRuote(aRuoteSel,TutteRuote)
Else
MsgBox("La quantità di numeri del gruppo base deve essere ovviamente maggiore o uguale rispetto il numero di classe di sviluppo")
End If
parametroxordinamento = CInt(InputBox("Scegli il parametro di ordinamento per i risultati in tabella: ra (1); rs (2); fq (3); incmax (4)",,1))
versodiordinamento = CInt(InputBox("Scegli il verso di ordinamento dei risultati in tabella: decrescente (0): crescente (1)",,0))
Scrivi "Elaborazione effettuata con archivio aggiornato al " & GetInfoEstrazione(EstrazioneFin)
Scrivi "Range temporale analizzato " & GetInfoEstrazione(EstrazioneIni) & " - " & GetInfoEstrazione(EstrazioneFin)
Scrivi TestoInBandaPassante("Enjoy with this little script n.37 by tom's bakery :) ",True,vbYellow,vbRed)
Scrivi "Classe di sviluppo " & nClasse
Scrivi "Sorte di ricerca " & nSorte
Scrivi "Numeri fissi (cg) " & StringaNumeri(aFissino)
Scrivi "Parametro di ordinamento (1:ra; 2:rs; 3:fq; 4:incmax) : " & parametroxordinamento
Scrivi "Modalità di ordinamento (0: decrescente ; 1: crescente) : " & versodiordinamento
If fissiono = "f" Then
Scrivi "Modalità elaborazione con fissi: " & " attiva "
Else
Scrivi "Modalità elaborazione con fissi: " & " disattiva "
End If
If ruoteuniteoseparate = "s" Then
Scrivi "Modalità elaborazione con ruote: " & " separate "
Else
Scrivi "Modalità elaborazione con ruote: " & " unite "
End If
ReDim titolitabella(6)
titolitabella(1) = "ruota"
titolitabella(2) = "numeri"
titolitabella(3) = "ra"
titolitabella(4) = "rs"
titolitabella(5) = "incmax"
titolitabella(6) = "fq"
Call InitTabella(titolitabella)
ReDim Valoriditabella(6)
Set MS = GetMotoreSviluppoIntegrale
If fissiono = "f" Then
Call MS.InitSviluppoIntegrale(anumeri,nClasse,aFissi)
Else
Call MS.InitSviluppoIntegrale(anumeri,nClasse,aFissino)
End If
Do While ms.GetCombSviluppo(aRetCol)
i = i + 1
ReDim aRuote(UBound(aRuoteSel))
For k = 1 To UBound(aRuoteSel)
aRuote(k) = aRuoteSel(k)
Next
Call StatisticaFormazioneTurbo(aRetCol,aRuote,nSorte,RetRit1,RetRitMax,RetIncrRitMax,RetFreq)
Diff = RetRitMax - RetRit1
If(RetRit1 >= 0) Then ' <- qui si può modificare il filtro di selezione come si preferisce...
contatore = contatore + 1
If TutteRuote = True Then
Valoriditabella(1) = "TT+NZ" 'StringaRuote(aRuote)
Else
Valoriditabella(1) = StringaRuote(aRuote)
End If
Valoriditabella(2) = StringaNumeri(aRetCol)
Valoriditabella(3) = RetRit1
Valoriditabella(4) = RetRitMax
Valoriditabella(5) = RetIncrRitMax
Valoriditabella(6) = RetFreq
Call AddRigaTabella(Valoriditabella)
End If
If ScriptInterrotto Then Exit Do
Call Messaggio("riga: " & i & " | " & "trovate: " & contatore)
Loop
Set MS = Nothing
Call Scrivi
Select Case(parametroxordinamento)
Case 1
Call CreaTabella(3,versodiordinamento)
Case 2
Call CreaTabella(4,versodiordinamento)
Case 3
Call CreaTabella(5,versodiordinamento)
Case 5
Call CreaTabella(6,versodiordinamento)
End Select
Call Scrivi
Call Scrivi("Tempo trascorso " & TempoTrascorso)
End If ' per uniteoseparate
End Sub
Function ScegliRuote(aRuoteSel,TutteRuote) 'As Integer
Dim i,j,k
Dim RuoteSelezionate
'Dim TutteRuote
Dim risposta
risposta = MsgBox("Vuoi selezionare tutte le ruote inclusa la nazionale?",vbYesNo + vbQuestion,"Selezione Ruote")
If risposta = vbYes Then
TutteRuote = True
Else
TutteRuote = False
End If
If TutteRuote Then
' Seleziona tutte le ruote inclusa la nazionale
For i = 1 To 12
aRuoteSel(i) = i
'If i=11 Then
'i = 12
'aRuoteSel(i) = i
'End If
Next
aRuoteSel(11) = 12 ' Nazionale
'RuoteSelezionate = 12
Else
' Seleziona le ruote manualmente
For i = 1 To 12
risposta = MsgBox("Vuoi selezionare la ruota " & NomeRuota(i) & "?",vbYesNo + vbQuestion,"Selezione Ruote")
If risposta = vbYes Then
j = j + 1
aRuoteSel(j) = i
End If
Next
RuoteSelezionate = j
End If
ScegliRuote = RuoteSelezionate
End FunctionSub Main()
' NUMERI CHE SI PRESENTANO ENTRO 9 ESTRAZIONI PRIMA DELL' USCITA DELLA SPIA
Dim nu(1)
Dim ru(1)
Dim prnu(90,2)
Dim rig1(90)
Dim rig2(90)
Dim fin
Dim r
Dim cs
Dim cs1
Dim es
Dim x
Dim y
Dim spia
fin = EstrazioneFin
r = InputBox("SU' CHE RUOTA FACCIO LA RICERCA","",1)
ColoreTesto 2
Scrivi "Ricerca sulla ruota di " & NomeRuota(r) & " relativa alle " & _
"ultime 18 sortite della spia e alle 15 " & _
"maggiori presenze in un periodo di 9 estr. precedenti " & _
" alla spiata" & String(18," ") & "Robyca"
ColoreTesto 0
Scrivi String(89,"*")
Scrivi
ru(1) = r
For spia = 1 To 90
Messaggio "NUMERO SPIA " & spia
cs = 0
For x = 0 To 2000
es =(fin - x) - 9
If Posizione(es,r,spia) > 0 Then
cs = cs + 1
For y = 1 To 90
nu(1) = y
If SerieFreq(es - 9,es - 1,nu,ru,1) > 0 Then
prnu(y,1) = y
prnu(y,2) = prnu(y,2) + 1
End If
Next
If cs = 18 Then
cs1 = x
Exit For
End If
End If
Next
OrdinaMatrice prnu,1,2
For j = 1 To 90
rig1(spia) = rig1(spia) + FormatSpace(prnu(j,1),3,True)
rig2(spia) = rig2(spia) + FormatSpace(prnu(j,2),3,True)
Next
ColoreTesto 2
Scrivi NomeRuota(r) & " N. spia: " & spia & " sortito " & _
cs & " volte in " & cs1 & " estr."
ColoreTesto 0
Scrivi rig1(spia)
ColoreTesto 1
Scrivi rig2(spia)
Scrivi
cs = 0
' Correzione: utilizza ReDim per resettare la matrice
ReDim prnu(90,2)
Next
End SubCiao...in questo momento sono fuori sedeCodice:Sub Main() ' NUMERI CHE SI PRESENTANO ENTRO 9 ESTRAZIONI PRIMA DELL' USCITA DELLA SPIA Dim nu(1) Dim ru(1) Dim prnu(90,2) Dim rig1(90) Dim rig2(90) Dim fin Dim r Dim cs Dim cs1 Dim es Dim x Dim y Dim spia fin = EstrazioneFin r = InputBox("SU' CHE RUOTA FACCIO LA RICERCA","",1) ColoreTesto 2 Scrivi "Ricerca sulla ruota di " & NomeRuota(r) & " relativa alle " & _ "ultime 18 sortite della spia e alle 15 " & _ "maggiori presenze in un periodo di 9 estr. precedenti " & _ " alla spiata" & String(18," ") & "Robyca" ColoreTesto 0 Scrivi String(89,"*") Scrivi ru(1) = r For spia = 1 To 90 Messaggio "NUMERO SPIA " & spia cs = 0 For x = 0 To 2000 es =(fin - x) - 9 If Posizione(es,r,spia) > 0 Then cs = cs + 1 For y = 1 To 90 nu(1) = y If SerieFreq(es - 9,es - 1,nu,ru,1) > 0 Then prnu(y,1) = y prnu(y,2) = prnu(y,2) + 1 End If Next If cs = 18 Then cs1 = x Exit For End If End If Next OrdinaMatrice prnu,1,2 For j = 1 To 90 rig1(spia) = rig1(spia) + FormatSpace(prnu(j,1),3,True) rig2(spia) = rig2(spia) + FormatSpace(prnu(j,2),3,True) Next ColoreTesto 2 Scrivi NomeRuota(r) & " N. spia: " & spia & " sortito " & _ cs & " volte in " & cs1 & " estr." ColoreTesto 0 Scrivi rig1(spia) ColoreTesto 1 Scrivi rig2(spia) Scrivi cs = 0 ' Correzione: utilizza ReDim per resettare la matrice ReDim prnu(90,2) Next End Sub
Questa volta non ringraziate me.. che sono solo un semplice domatore di AI
Ok...ora ci siamo ...
'SpazioScript - Analizzatore Combinazioni con Rolling Backtest, Analisi Ipergeometrica & Filtrazione Selettiva
'Versione v2.3 (ByVal Stack Protection & Deterministic Sorting)
Sub Main()
' Dichiarazione delle variabili principali
Dim aFissi,aPool,aComboCompleta,aSfissi
Dim nFissi,nDinamici,nRuota,nSorte,max_diff
Dim i,r,temp,k,c
Dim RetRit,RetRitMax,RetIncrRitMax,RetFreq
Dim nInizio,nFine
Dim sFissi,sDinamici,sCompleta
Dim nDiff,nTrovate
Dim sFissiTemp,aFissiString
Dim aRuote(1)
' Variabili per il calcolo dello spazio combinatorio e probabilità
Dim nIntegrali,nCoperturaPerc
Dim nClasseIbrida,nAmbiInClasse,nCoverageAmbiPerc
Dim nComb90_5,nComb90MinusC_5,nComb90MinusC_4,p0,p1,pAtLeast2,pAtLeast2Perc
' Variabili per il Backtest Rolling
Dim bEseguiBacktest,nRangeBacktest,nCombinazioniBT,nColpi
Dim nStartBT,nEndBT,t,iBT,nCasiTotali,nCasiVincenti
Dim nTrovateInQuestoT,FreqEsito,sPercent
' Variabili per la Mappatura di Pre-Sfaldamento dei Singoli Estratti
Dim nTotalWNums,nSumRA,nSumRS,nSumFreq
Dim nFascia1,nFascia2,nFascia3,nFascia4
Dim tEsito,colpo,aInCombo,nVal,Pos,Estr,matchesCount,aMatches
Dim idxM,WNum,aNumSingle,RA_single,RS_single,Freq_single
' Variabili per il Salvataggio e l'Ordinamento in Memoria (Sostituiscono la tabella grafica)
Dim nMaxSalvate,nSalvateCount
Dim aSalvateComboStr,aSalvateFissiStr,aSalvateDinamiciStr
Dim aSalvateDiff,aSalvateRA,aSalvateRS,aSalvateFreq,aSalvateNumeri
Dim x,y,bScambiato,bScambia
Dim tempDiff,tempRA,tempRS,tempFreq,tempComboStr,tempFissiStr,tempDinamiciStr,tempNum,colNum
' Variabili per la Filtrazione Dinamica (Fase 3)
Dim bMiglioreTrovata,aMiglioreComboDiOggi
Dim bFasciaFav(4),sFasceFav,anyFasciaActive,maxFascia,maxCount
Dim aFavoriti,nFavoritiCount,numCurrent,RA_current,fasciaCurrent
' Variabili per i filtri finali (Fase 4)
Dim nTipoFiltroFinale ' 1 = Multi-Convergenza Terzine | 2 = Riduzione Sequenziale Quartine
Dim nMinRATerzina ' Ritardo minimo per Ambo in Terzina (~6.7 cicli = 900)
Dim nMaxElementiUnione ' Soglia massima di giocabilità impostata dall'utente (es. 22)
Dim nMinPresenze ' Per Filtro 1: presenze minime nelle terzine iper-ritardate
Dim nMinRAQuartina ' Per Filtro 2: ritardo minimo per Ambo in Quartina (~7 cicli = 467)
Dim i1,i2,i3,nRA_terz,aTerzina,aUnionMap,nUnionCount,aUnionNumeri,nCombTotaliTerz
Dim aUnionFreq,q1,q2,q3,q4,aQuartina,aQuartUnionMap,nQuartUnionCount,aQuartUnionNumeri,nRA_quart,nCombTotaliQuart
' Variabili per l'analisi odierna
Dim nCombinazioniOggi,nTopPrint,idxP
' Inizializzazione del generatore casuale nativo di VBScript
Randomize
' ==================================================================
' --- CONFIGURAZIONE PARAMETRI ---
nRuota = ScegliRuota() 'PA_ ' Ruota di Palermo (PA)
nSorte = CInt(InputBox("Sorte di ricerca","sorte",2)) '2 ' Sorte di ricerca: 2 = AMBO
max_diff = CInt(InputBox("Max diff","max diff",1)) '1 ' Massimo scarto (RS - RA) per ritenere idonea una combinazione
nDinamici = CInt(InputBox("Num. dinamici","num dinamici",33)) '37 ' 33 ' Numero di elementi dinamici da pescare dal pool (Ora protetto da ByVal!)
' PARAMETRI PER L'ANALISI CORRENTE (OGGI)
nCombinazioniOggi = 10000 ' Quante combinazioni testare per l'estrazione odierna
' PARAMETRI PER IL ROLLING BACKTEST & MAPPATURA
bEseguiBacktest = True ' True = Attiva il Backtest e la Mappatura; False = Salta
nRangeBacktest = 100 ' Quante estrazioni andare indietro nel passato (es. ultime 30)
nCombinazioniBT = 500 ' Combinazioni da generare per ogni estrazione passata
nColpi = 1 ' Colpi di gioco per verificare lo sfaldamento
' ------------------------------------------------------------------
' --- IMPOSTAZIONE PARAMETRI DI FILTRAZIONE FINALE (FASE 4) ---
' ------------------------------------------------------------------
nTipoFiltroFinale = 2 ' SCEGLI: 1 = Multi-Convergenza Terzine | 2 = Riduzione Sequenziale Quartine
nMinRATerzina = 900 ' Ritardo Attuale minimo per Ambo della terzina (6.7 cicli = 900)
nMaxElementiUnione = 22 ' Limite massimo di elementi nell'unione finale (es. 22)
' Parametri specifici se nTipoFiltroFinale = 1 (Multi-Convergenza)
nMinPresenze = 2 ' Presenza minima di un numero nelle terzine iper-ritardate (es. 2 o 3)
' Parametri specifici se nTipoFiltroFinale = 2 (Riduzione Sequenziale Quartine)
nMinRAQuartina = 467 ' Ritardo Attuale minimo per Ambo in Quartina (7 cicli = 467)
' ==================================================================
' Prepariamo l'array delle ruote
aRuote(1) = nRuota
' Range di analisi dell'archivio complessivo
nInizio = 1
nFine = EstrazioneFin
' Calcolo dei limiti temporali del Backtest
nStartBT = nFine - nRangeBacktest
If nStartBT < nInizio Then nStartBT = nInizio
nEndBT = nFine - nColpi
If nEndBT < nStartBT Then nEndBT = nStartBT
' Inizializzazione contatori della mappatura pre-sfaldamento
nTotalWNums = 0
nSumRA = 0
nSumRS = 0
nSumFreq = 0
nFascia1 = 0
nFascia2 = 0
nFascia3 = 0
nFascia4 = 0
bMiglioreTrovata = False
ReDim aNumSingle(1)
' Caricamento dei 33 numeri fissi
sFissiTemp = "1.4.9.11.13.16.17.23.24.25.26.30.36.38.40.42.49.55.58.59.61.67.68.73.77.81.83.85.86.87.88.89.90"
'absc29
' sFissiTemp = "1.4.9.11.13.16.17.23.25.26.30.40.42.49.55.58.59.61.67.68.73.77.81.83.85.86.88.89.90"
aFissiString = Split(sFissiTemp,".")
nFissi = UBound(aFissiString) + 1
ReDim aFissi(nFissi)
ReDim aSfissi(90)
For i = 1 To nFissi
aFissi(i) = CInt(aFissiString(i - 1))
aSfissi(aFissi(i)) = True
Next
' Creazione del Pool con i rimanenti numeri
Dim nPoolSize
nPoolSize = 90 - nFissi
ReDim aPool(nPoolSize)
c = 0
For i = 1 To 90
If Not aSfissi(i) Then
c = c + 1
aPool(c) = i
End If
Next
' Inizializziamo le strutture di salvataggio in memoria (Max 1000 righe per l'output)
nMaxSalvate = 1000
nSalvateCount = 0
ReDim aSalvateComboStr(nMaxSalvate)
ReDim aSalvateFissiStr(nMaxSalvate)
ReDim aSalvateDinamiciStr(nMaxSalvate)
ReDim aSalvateDiff(nMaxSalvate)
ReDim aSalvateRA(nMaxSalvate)
ReDim aSalvateRS(nMaxSalvate)
ReDim aSalvateFreq(nMaxSalvate)
ReDim aSalvateNumeri(nMaxSalvate,nFissi + nDinamici)
' Presentazione a video delle informazioni iniziali
Call Titolazione()
' ==================================================================
' --- FASE 1: ROLLING BACKTEST & MAPPATURA NEL PASSATO ---
' ==================================================================
If bEseguiBacktest Then
Call Scrivi("==========================================================================================")
Call Scrivi(" FASE 1: ROLLING BACKTEST & MAPPATURA DEI SINGOLI ESTRATTI",True)
Call Scrivi("==========================================================================================")
Call Scrivi("Avvio della simulazione storica passata passo-passo...")
Call Scrivi("Ogni estrazione passata viene analizzata singolarmente. Se una combinazione idonea vince,")
Call Scrivi("mappiamo i parametri di ritardo e frequenza dei singoli numeri che hanno composto l'ambo.")
Call Scrivi("")
nCasiTotali = 0
nCasiVincenti = 0
For t = nStartBT To nEndBT
Call AvanzamentoElab(nStartBT,nEndBT,t)
Call Messaggio("Backtest Estrazione: " & t & " / " & nEndBT & " | Casi: " & nCasiTotali)
If ScriptInterrotto Then Exit For
nTrovateInQuestoT = 0
For iBT = 1 To nCombinazioniBT
For k = 1 To nDinamici
r = Int((nPoolSize - k + 1) * Rnd + k)
temp = aPool(k)
aPool(k) = aPool(r)
aPool(r) = temp
Next
ReDim aComboCompleta(nFissi + nDinamici)
For k = 1 To nFissi
aComboCompleta(k) = aFissi(k)
Next
For k = 1 To nDinamici
aComboCompleta(nFissi + k) = aPool(k)
Next
Call OrdinaMatrice(aComboCompleta,1)
Call StatisticaFormazioneTurbo(aComboCompleta,aRuote,nSorte,RetRit,RetRitMax,RetIncrRitMax,RetFreq,nInizio,t)
nDiff = RetRitMax - RetRit
If nDiff <= max_diff Then
nCasiTotali = nCasiTotali + 1
nTrovateInQuestoT = nTrovateInQuestoT + 1
FreqEsito = SerieFreqTurbo(t + 1,t + nColpi,aComboCompleta,aRuote,nSorte)
If FreqEsito > 0 Then
nCasiVincenti = nCasiVincenti + 1
tEsito = 0
For colpo = 1 To nColpi
If t + colpo <= nFine Then
If SerieFreqTurbo(t + colpo,t + colpo,aComboCompleta,aRuote,nSorte) > 0 Then
tEsito = t + colpo
Exit For
End If
End If
Next
If tEsito > 0 Then
ReDim aInCombo(90)
For nVal = 1 To 90
aInCombo(nVal) = False
Next
For nVal = 1 To UBound(aComboCompleta)
aInCombo(aComboCompleta(nVal)) = True
Next
ReDim aMatches(5)
matchesCount = 0
For Pos = 1 To 5
Estr = Estratto(tEsito,nRuota,Pos)
If aInCombo(Estr) Then
matchesCount = matchesCount + 1
aMatches(matchesCount) = Estr
End If
Next
For idxM = 1 To matchesCount
WNum = aMatches(idxM)
aNumSingle(1) = WNum
RA_single = SerieRitardoTurbo(nInizio,t,aNumSingle,aRuote,1)
RS_single = SerieStoricoTurbo(nInizio,t,aNumSingle,aRuote,1)
Freq_single = SerieFreqTurbo(nInizio,t,aNumSingle,aRuote,1)
nTotalWNums = nTotalWNums + 1
nSumRA = nSumRA + RA_single
nSumRS = nSumRS + RS_single
nSumFreq = nSumFreq + Freq_single
If RA_single <= 9 Then
nFascia1 = nFascia1 + 1
ElseIf RA_single <= 18 Then
nFascia2 = nFascia2 + 1
ElseIf RA_single <= 36 Then
nFascia3 = nFascia3 + 1
Else
nFascia4 = nFascia4 + 1
End If
Next
End If
End If
End If
Next
If nCasiTotali > 0 Then
sPercent = Round((nCasiVincenti / nCasiTotali) * 100,1) & "%"
Else
sPercent = "0.0%"
End If
Call Scrivi("Estr. " & t & " (" & DataEstrazione(t) & ") | Idonee trovate: " & nTrovateInQuestoT & " | Progressivo: " & nCasiVincenti & " vinti su " & nCasiTotali & " casi (" & sPercent & ")")
Next
Call Scrivi("")
Call Scrivi("------------------------------------------------------------------------------------------")
Call Scrivi("RIEPILOGO STORICO BACKTEST ROLLING:",True)
Call Scrivi("Totale combinazioni idonee rilevate nel passato: " & nCasiTotali)
Call Scrivi("Totale combinazioni vincenti entro " & nColpi & " colpi: " & nCasiVincenti)
Call Scrivi("Rendimento medio (Win-Rate) della strategia: " & sPercent,True)
Call Scrivi("------------------------------------------------------------------------------------------")
Call Scrivi("")
If nTotalWNums > 0 Then
Call Scrivi("==========================================================================================",True)
Call Scrivi(" MAPPATURA STATISTICA PRE-SFALDAMENTO DEI SINGOLI ESTRATTI VINCENTI (AMBO)",True)
Call Scrivi("==========================================================================================",True)
Call Scrivi("Analisi eseguita su un campione di " & nTotalWNums & " singoli estratti usciti nelle vincite:")
Call Scrivi(" - Ritardo Medio individuale un attimo prima dell'uscita: " & Round(nSumRA / nTotalWNums,1) & " estrazioni")
Call Scrivi(" - Ritardo Storico Medio individuale dei numeri vincenti : " & Round(nSumRS / nTotalWNums,1) & " estrazioni")
Call Scrivi(" - Frequenza Media individuale dei numeri usciti : " & Round(nSumFreq / nTotalWNums,1) & " presenze")
Call Scrivi("")
Call Scrivi("DISTRIBUZIONE DEL RITARDO (RA) AL MOMENTO DEL RILEVAMENTO:")
Call Scrivi(" - Fascia 1 (Ritardo da 0 a 9 colpi - Warm) : " & nFascia1 & " estratti (" & Round((nFascia1 / nTotalWNums) * 100,1) & "%)")
Call Scrivi(" - Fascia 2 (Ritardo da 10 a 18 colpi - Medium) : " & nFascia2 & " estratti (" & Round((nFascia2 / nTotalWNums) * 100,1) & "%)")
Call Scrivi(" - Fascia 3 (Ritardo da 19 a 36 colpi - Cold) : " & nFascia3 & " estratti (" & Round((nFascia3 / nTotalWNums) * 100,1) & "%)")
Call Scrivi(" - Fascia 4 (Ritardo superiore a 36 colpi - Ice) : " & nFascia4 & " estratti (" & Round((nFascia4 / nTotalWNums) * 100,1) & "%)")
Call Scrivi("==========================================================================================")
Call Scrivi("")
End If
End If
' ==================================================================
' --- FASE 2: ANALISI COMBINAZIONI PER L'ESTRAZIONE CORRENTE ---
' ==================================================================
' Calcoli matematici e probabilistici della classe
nClasseIbrida = nFissi + nDinamici
nAmbiInClasse = CombinazioniSenzaRipetizione(nClasseIbrida,2)
nCoverageAmbiPerc =(nAmbiInClasse / 4005) * 100
nComb90_5 = CombinazioniSenzaRipetizione(90,5)
nComb90MinusC_5 = CombinazioniSenzaRipetizione(90 - nClasseIbrida,5)
nComb90MinusC_4 = CombinazioniSenzaRipetizione(90 - nClasseIbrida,4)
p0 = nComb90MinusC_5 / nComb90_5
p1 =(nClasseIbrida * nComb90MinusC_4) / nComb90_5
pAtLeast2 = 1.0 - p0 - p1
pAtLeast2Perc = pAtLeast2 * 100
' Ora protetto da ByVal, nDinamici non viene più corrotto internamente!
nIntegrali = CombinazioniSenzaRipetizione(90 - nFissi,nDinamici)
nCoperturaPerc =(nCombinazioniOggi / nIntegrali) * 100
Call Scrivi("==========================================================================================")
Call Scrivi(" FASE 2: ANALISI PER L'ESTRAZIONE CORRENTE (DI OGGI)",True)
Call Scrivi("==========================================================================================")
Call Scrivi("DATI PARAMETRICI DELL'ANALISI:")
Call Scrivi(" - Ruota di Analisi : " & NomeRuota(nRuota))
Call Scrivi(" - Sorte Target : " & nSorte & " (Ambo)")
Call Scrivi(" - Estrazione di Riferimento : " & nFine & " (" & DataEstrazione(nFine) & ")")
Call Scrivi(" - Struttura Massa Ibrida : " & nFissi & " Fissi + " & nDinamici & " Dinamici (Totale: " & nClasseIbrida & " numeri)")
Call Scrivi(" - Dimensione Pool Numeri Dinamici : " &(90 - nFissi) & " numeri")
Call Scrivi(" - Filtro Scarto Massimo (max_diff) : <= " & max_diff)
Call Scrivi(" - Combinazioni Integrali Teoriche : " & FormatNumber(nIntegrali,0))
Call Scrivi(" - Combinazioni Ibride Generate per Test : " & FormatNumber(nCombinazioniOggi,0))
Call Scrivi(" - Percentuale di Copertura dell'Analisi : " & FormatNumber(nCoperturaPerc,6) & "%")
Call Scrivi("")
Call Scrivi("GIUSTIFICAZIONE MATEMATICA DELLA CLASSE IBRIDA SCELTA:")
Call Scrivi(" - Classe Ibrida Attiva : " & nClasseIbrida & " numeri")
Call Scrivi(" - Ambi Interni Sviluppabili : " & nAmbiInClasse & " su 4.005 totali (" & FormatNumber(nCoverageAmbiPerc,2) & "% del totale)")
Call Scrivi(" - Probabilità Matematica Ambo a Colpo : " & FormatNumber(pAtLeast2Perc,2) & "% (Distribuzione Ipergeometrica)")
Call Scrivi(" - Nota di Sintesi Statistica: ")
Call Scrivi(" La scelta di questa classe numerica (" & nClasseIbrida & " numeri) è ottimizzata per garantire che")
Call Scrivi(" la formazione di partenza contenga statisticamente almeno un ambo vincente in circa")
Call Scrivi(" " & FormatNumber(pAtLeast2Perc,1) & " estrazioni su 100. Questo costituisce un eccellente bacino")
Call Scrivi(" di partenza (massa numerica densa) su cui applicare i filtri di ritardo storici")
Call Scrivi(" (Fase 2) e le riduzioni successive (Fase 3 e Fase 4), isolando solo i blocchi sincroni")
Call Scrivi(" iper-ritardati pronti allo sfaldamento.")
Call Scrivi("")
Call Scrivi("Generazione e analisi di " & FormatNumber(nCombinazioniOggi,0) & " combinazioni per il prossimo colpo...")
Call Scrivi("")
nTrovate = 0
For i = 1 To nCombinazioniOggi
If i = 1 Or i Mod 2000 = 0 Or i = nCombinazioniOggi Then
Call AvanzamentoElab(1,nCombinazioniOggi,i)
Call Messaggio("Analisi odierna: " & i & " / " & nCombinazioniOggi & " | Idonee: " & nTrovate)
If ScriptInterrotto Then Exit For
End If
For k = 1 To nDinamici
r = Int((nPoolSize - k + 1) * Rnd + k)
temp = aPool(k)
aPool(k) = aPool(r)
aPool(r) = temp
Next
ReDim aComboCompleta(nFissi + nDinamici)
For k = 1 To nFissi
aComboCompleta(k) = aFissi(k)
Next
For k = 1 To nDinamici
aComboCompleta(nFissi + k) = aPool(k)
Next
Call OrdinaMatrice(aComboCompleta,1)
Call StatisticaFormazioneTurbo(aComboCompleta,aRuote,nSorte,RetRit,RetRitMax,RetIncrRitMax,RetFreq,nInizio,nFine)
nDiff = RetRitMax - RetRit
If nDiff <= max_diff Then
nTrovate = nTrovate + 1
If nSalvateCount < nMaxSalvate Then
nSalvateCount = nSalvateCount + 1
aSalvateDiff(nSalvateCount) = nDiff
aSalvateRA(nSalvateCount) = RetRit
aSalvateRS(nSalvateCount) = RetRitMax
aSalvateFreq(nSalvateCount) = RetFreq
For k = 1 To UBound(aComboCompleta)
aSalvateNumeri(nSalvateCount,k) = aComboCompleta(k)
Next
Dim aDinamiciOrdinati
ReDim aDinamiciOrdinati(nDinamici)
For k = 1 To nDinamici
aDinamiciOrdinati(k) = aPool(k)
Next
Call OrdinaMatrice(aDinamiciOrdinati,1)
aSalvateComboStr(nSalvateCount) = StringaNumeri(aComboCompleta,".")
aSalvateFissiStr(nSalvateCount) = StringaNumeri(aFissi,".")
aSalvateDinamiciStr(nSalvateCount) = StringaNumeri(aDinamiciOrdinati,".")
End If
End If
Next
If nSalvateCount > 0 Then
Call Messaggio("Ordinamento dei risultati in corso...")
For x = 1 To nSalvateCount - 1
bScambiato = False
For y = 1 To nSalvateCount - x
bScambia = False
If aSalvateDiff(y) > aSalvateDiff(y + 1) Then
bScambia = True
ElseIf aSalvateDiff(y) = aSalvateDiff(y + 1) Then
If aSalvateRA(y) < aSalvateRA(y + 1) Then
bScambia = True
ElseIf aSalvateRA(y) = aSalvateRA(y + 1) Then
If aSalvateFreq(y) < aSalvateFreq(y + 1) Then
bScambia = True
End If
End If
End If
If bScambia Then
tempDiff = aSalvateDiff(y)
aSalvateDiff(y) = aSalvateDiff(y + 1)
aSalvateDiff(y + 1) = tempDiff
tempRA = aSalvateRA(y)
aSalvateRA(y) = aSalvateRA(y + 1)
aSalvateRA(y + 1) = tempRA
tempRS = aSalvateRS(y)
aSalvateRS(y) = aSalvateRS(y + 1)
aSalvateRS(y + 1) = tempRS
tempFreq = aSalvateFreq(y)
aSalvateFreq(y) = aSalvateFreq(y + 1)
aSalvateFreq(y + 1) = tempFreq
tempComboStr = aSalvateComboStr(y)
aSalvateComboStr(y) = aSalvateComboStr(y + 1)
aSalvateComboStr(y + 1) = tempComboStr
tempFissiStr = aSalvateFissiStr(y)
aSalvateFissiStr(y) = aSalvateFissiStr(y + 1)
aSalvateFissiStr(y + 1) = tempFissiStr
tempDinamiciStr = aSalvateDinamiciStr(y)
aSalvateDinamiciStr(y) = aSalvateDinamiciStr(y + 1)
aSalvateDinamiciStr(y + 1) = tempDinamiciStr
For colNum = 1 To(nFissi + nDinamici)
tempNum = aSalvateNumeri(y,colNum)
aSalvateNumeri(y,colNum) = aSalvateNumeri(y + 1,colNum)
aSalvateNumeri(y + 1,colNum) = tempNum
Next
bScambiato = True
End If
Next
If Not bScambiato Then Exit For
Next
ReDim aMiglioreComboDiOggi(nFissi + nDinamici)
For k = 1 To(nFissi + nDinamici)
aMiglioreComboDiOggi(k) = aSalvateNumeri(1,k)
Next
bMiglioreTrovata = True
nTopPrint = 20
If nTopPrint > nSalvateCount Then nTopPrint = nSalvateCount
Call Scrivi("?? CLASSIFICA TOP " & nTopPrint & " COMBINAZIONI MIGLIORI DI OGGI (Ord. Diff Crescente | RA Decrescente | Freq Decrescente):",True)
Call Scrivi("Rank" & vbTab & "Diff" & vbTab & "RA" & vbTab & "RS" & vbTab & "Freq" & vbTab & "Combinazione Completa")
Call Scrivi("---------------------------------------------------------------------------------------------------------")
For idxP = 1 To nTopPrint
Call Scrivi("#" & idxP & vbTab & aSalvateDiff(idxP) & vbTab & aSalvateRA(idxP) & vbTab & aSalvateRS(idxP) & vbTab & aSalvateFreq(idxP) & vbTab & aSalvateComboStr(idxP))
Next
Call Scrivi("---------------------------------------------------------------------------------------------------------")
If nTrovate > nTopPrint Then
Call Scrivi("... e altre " &(nTrovate - nTopPrint) & " combinazioni idonee salvate in memoria.")
End If
Call Scrivi("")
Call Scrivi("==========================================================================================",True)
Call Scrivi("?? COMBINAZIONE BASE ELETTA PER GLI SVILUPPI SUCCESSIVI (RANK #1):",True)
Call Scrivi(" " & StringaNumeri(aMiglioreComboDiOggi,"."),True)
Call Scrivi(" [Scelta deterministicamente per: Scarto min -> Ritardo max -> Frequenza max]")
Call Scrivi(" Questa combinazione (" & UBound(aMiglioreComboDiOggi) & "ina) sarà l'unico bacino di numeri")
Call Scrivi(" utilizzato per estrarre i Super Favoriti (Fase 3) e sviluppare i filtri di Fase 4.")
Call Scrivi("==========================================================================================")
Call Scrivi("")
Else
Call Scrivi("Nessuna combinazione ha soddisfatto i criteri per l'estrazione odierna.")
End If
' ==================================================================
' --- FASE 3: SVILUPPO FILTRO DINAMICO ED ESTRAZIONE SUPER FAVORITI ---
' ==================================================================
If bEseguiBacktest And bMiglioreTrovata And nTotalWNums > 0 Then
Call Scrivi("==========================================================================================")
Call Scrivi(" FASE 3: GENERAZIONE FILTRO DINAMICO E RIDUZIONE PER LA PROSSIMA GIOCATA",True)
Call Scrivi("==========================================================================================")
Call Scrivi("In base al profilo statistico emerso dal backtest, identifichiamo le fasce ideali.")
sFasceFav = ""
If(nFascia1 / nTotalWNums) >= 0.20 Then bFasciaFav(1) = True : sFasceFav = sFasceFav & "Fascia 1 (RA 0-9) | "
If(nFascia2 / nTotalWNums) >= 0.20 Then bFasciaFav(2) = True : sFasceFav = sFasceFav & "Fascia 2 (RA 10-18) | "
If(nFascia3 / nTotalWNums) >= 0.20 Then bFasciaFav(3) = True : sFasceFav = sFasceFav & "Fascia 3 (RA 19-36) | "
If(nFascia4 / nTotalWNums) >= 0.20 Then bFasciaFav(4) = True : sFasceFav = sFasceFav & "Fascia 4 (RA > 36) | "
anyFasciaActive = False
For k = 1 To 4
If bFasciaFav(k) Then anyFasciaActive = True
Next
If Not anyFasciaActive Then
maxCount = 0
maxFascia = 1
If nFascia1 > maxCount Then maxCount = nFascia1 : maxFascia = 1
If nFascia2 > maxCount Then maxCount = nFascia2 : maxFascia = 2
If nFascia3 > maxCount Then maxCount = nFascia3 : maxFascia = 3
If nFascia4 > maxCount Then maxCount = nFascia4 : maxFascia = 4
bFasciaFav(maxFascia) = True
If maxFascia = 1 Then sFasceFav = "Fascia 1 (RA 0-9) | "
If maxFascia = 2 Then sFasceFav = "Fascia 2 (RA 10-18) | "
If maxFascia = 3 Then sFasceFav = "Fascia 3 (RA 19-36) | "
If maxFascia = 4 Then sFasceFav = "Fascia 4 (RA > 36) | "
End If
Call Scrivi("-> Filtro dinamico attivo su fasce vincenti (Incidenza >= 20%): " & Left(sFasceFav,Len(sFasceFav) - 3))
Call Scrivi("-> Applicazione filtro sui " & UBound(aMiglioreComboDiOggi) & " numeri della migliore formazione di oggi (Rank 1)...")
Call Scrivi("")
nFavoritiCount = 0
ReDim aFavoriti(90)
For k = 1 To UBound(aMiglioreComboDiOggi)
numCurrent = aMiglioreComboDiOggi(k)
aNumSingle(1) = numCurrent
RA_current = SerieRitardoTurbo(nInizio,nFine,aNumSingle,aRuote,1)
If RA_current <= 9 Then
fasciaCurrent = 1
ElseIf RA_current <= 18 Then
fasciaCurrent = 2
ElseIf RA_current <= 36 Then
fasciaCurrent = 3
Else
fasciaCurrent = 4
End If
If bFasciaFav(fasciaCurrent) Then
nFavoritiCount = nFavoritiCount + 1
aFavoriti(nFavoritiCount) = numCurrent
End If
Next
ReDim Preserve aFavoriti(nFavoritiCount)
Call OrdinaMatrice(aFavoriti,1)
Call Scrivi("? LUNGHETTA SUPER FAVORITI FILTRATA DINAMICAMENTE ?",True)
Call Scrivi(" -> Quantità originaria della combinazione: " & UBound(aMiglioreComboDiOggi) & " numeri")
Call Scrivi(" -> Quantità rimasta dopo il filtro d'incidenza: " & nFavoritiCount & " numeri")
Call Scrivi(" -> Percentuale di abbattimento della massa numerica: " & Round((1 -(nFavoritiCount / UBound(aMiglioreComboDiOggi))) * 100,1) & "%")
Call Scrivi("")
Call Scrivi(" -> Sotto-gruppo Consigliato (Giocabile per Ambo/Terno):",True)
Call Scrivi(" " & StringaNumeri(aFavoriti,"."),True)
Call Scrivi("==========================================================================================")
Call Scrivi("")
End If
' ==================================================================
' --- FASE 4: FILTRAZIONE SELETTIVA FINALE (DUAL FILTER SYSTEM) ---
' ==================================================================
If bMiglioreTrovata Then
Call Scrivi("==========================================================================================")
Call Scrivi(" FASE 4: SVILUPPO MOTORE DI RIDUZIONE SELETTIVA FINALE",True)
Call Scrivi("==========================================================================================")
' -----------------------------------------------------------
' OPZIONE 1: FILTRO DINAMICO DI MULTI-CONVERGENZA SU TERZINE
' -----------------------------------------------------------
If nTipoFiltroFinale = 1 Then
Call Scrivi("FILTRO ATTIVO: [1] MULTI-CONVERGENZA SULLE TERZINE (RA PER AMBO >= " & nMinRATerzina & ")")
Call Scrivi("I singoli elementi vengono trattenuti solo se presenti in almeno " & nMinPresenze & " terzine iper-ritardate.")
Call Scrivi("Sviluppo di tutte le terzine possibili della combinazione Rank 1...")
Call Scrivi("")
ReDim aTerzina(3)
ReDim aUnionFreq(90)
For k = 1 To 90
aUnionFreq(k) = 0
Next
nCombTotaliTerz = 0
For i1 = 1 To UBound(aMiglioreComboDiOggi) - 2
For i2 = i1 + 1 To UBound(aMiglioreComboDiOggi) - 1
For i3 = i2 + 1 To UBound(aMiglioreComboDiOggi)
nCombTotaliTerz = nCombTotaliTerz + 1
aTerzina(1) = aMiglioreComboDiOggi(i1)
aTerzina(2) = aMiglioreComboDiOggi(i2)
aTerzina(3) = aMiglioreComboDiOggi(i3)
nRA_terz = SerieRitardoTurbo(nInizio,nFine,aTerzina,aRuote,2)
If nRA_terz >= nMinRATerzina Then
aUnionFreq(aTerzina(1)) = aUnionFreq(aTerzina(1)) + 1
aUnionFreq(aTerzina(2)) = aUnionFreq(aTerzina(2)) + 1
aUnionFreq(aTerzina(3)) = aUnionFreq(aTerzina(3)) + 1
End If
Next
Next
Next
nUnionCount = 0
For k = 1 To 90
If aUnionFreq(k) >= nMinPresenze Then
nUnionCount = nUnionCount + 1
End If
Next
If nUnionCount > 0 Then
ReDim aUnionNumeri(nUnionCount)
c = 0
For k = 1 To 90
If aUnionFreq(k) >= nMinPresenze Then
c = c + 1
aUnionNumeri(c) = k
End If
Next
Call OrdinaMatrice(aUnionNumeri,1)
Call Scrivi("? GRUPPO FINALE PER MULTI-CONVERGENZA SU TERZINE ?",True)
Call Scrivi(" -> Terzine totali sviluppate e testate: " & nCombTotaliTerz)
Call Scrivi(" -> Soglia minima convergenza impostata: comparsa in >= " & nMinPresenze & " terzine iper-ritardate.")
Call Scrivi(" -> Quantità elementi finali risultanti: " & nUnionCount & " numeri")
If nUnionCount <= nMaxElementiUnione Then
Call Scrivi(" -> CONDIZIONE DI VALIDITA' (<= " & nMaxElementiUnione & " elementi): COPERTA! (PRONTA AL GIOCO)",True)
Else
Call Scrivi(" -> CONDIZIONE DI VALIDITA' (<= " & nMaxElementiUnione & " elementi): SUPERATA (Troppi elementi: " & nUnionCount & " n.)")
End If
Call Scrivi("")
Call Scrivi(" -> Sotto-gruppo Ristretto Consigliato (Giocabile per Ambo a Colpo):",True)
Call Scrivi(" " & StringaNumeri(aUnionNumeri,"."),True)
Else
Call Scrivi("Nessun numero della migliore combinazione odierna partecipa ad almeno " & nMinPresenze & " terzine con RA >= " & nMinRATerzina & ".")
End If
' -----------------------------------------------------------
' OPZIONE 2: RIDUZIONE SEQUENZIALE IN QUARTINE (DOPPIO LIVELLO DI RITARDO X7)
' -----------------------------------------------------------
ElseIf nTipoFiltroFinale = 2 Then
Call Scrivi("FILTRO ATTIVO: [2] RIDUZIONE SEQUENZIALE IN QUARTINE (DOPPIO LIVELLO X7)")
Call Scrivi("Livello 1: Isola i numeri tramite unione di terzine iper-ritardate (RA >= " & nMinRATerzina & ")...")
ReDim aTerzina(3)
ReDim aUnionMap(90)
nUnionCount = 0
For k = 1 To 90
aUnionMap(k) = False
Next
nCombTotaliTerz = 0
For i1 = 1 To UBound(aMiglioreComboDiOggi) - 2
For i2 = i1 + 1 To UBound(aMiglioreComboDiOggi) - 1
For i3 = i2 + 1 To UBound(aMiglioreComboDiOggi)
nCombTotaliTerz = nCombTotaliTerz + 1
aTerzina(1) = aMiglioreComboDiOggi(i1)
aTerzina(2) = aMiglioreComboDiOggi(i2)
aTerzina(3) = aMiglioreComboDiOggi(i3)
nRA_terz = SerieRitardoTurbo(nInizio,nFine,aTerzina,aRuote,2)
If nRA_terz >= nMinRATerzina Then
If Not aUnionMap(aTerzina(1)) Then aUnionMap(aTerzina(1)) = True : nUnionCount = nUnionCount + 1
If Not aUnionMap(aTerzina(2)) Then aUnionMap(aTerzina(2)) = True : nUnionCount = nUnionCount + 1
If Not aUnionMap(aTerzina(3)) Then aUnionMap(aTerzina(3)) = True : nUnionCount = nUnionCount + 1
End If
Next
Next
Next
If nUnionCount >= 4 Then
ReDim aUnionNumeri(nUnionCount)
c = 0
For k = 1 To 90
If aUnionMap(k) Then
c = c + 1
aUnionNumeri(c) = k
End If
Next
Call OrdinaMatrice(aUnionNumeri,1)
Call Scrivi(" -> Gruppo Intermedio Rilevato (Passaggio 1): " & nUnionCount & " numeri")
Call Scrivi(" [" & StringaNumeri(aUnionNumeri,".") & "]")
Call Scrivi("Livello 2: Sviluppo in quartine dei " & nUnionCount & " numeri intermedi...")
Call Scrivi("Filtro di ritardo quartine abilitato su RA per Ambo >= " & nMinRAQuartina & " (Ciclo x7 per Quartina)...")
Call Scrivi("")
ReDim aQuartina(4)
ReDim aQuartUnionMap(90)
nQuartUnionCount = 0
For k = 1 To 90
aQuartUnionMap(k) = False
Next
nCombTotaliQuart = 0
For q1 = 1 To nUnionCount - 3
For q2 = q1 + 1 To nUnionCount - 2
For q3 = q2 + 1 To nUnionCount - 1
For q4 = q3 + 1 To nUnionCount
nCombTotaliQuart = nCombTotaliQuart + 1
aQuartina(1) = aUnionNumeri(q1)
aQuartina(2) = aUnionNumeri(q2)
aQuartina(3) = aUnionNumeri(q3)
aQuartina(4) = aUnionNumeri(q4)
nRA_quart = SerieRitardoTurbo(nInizio,nFine,aQuartina,aRuote,2)
If nRA_quart >= nMinRAQuartina Then
If Not aQuartUnionMap(aQuartina(1)) Then aQuartUnionMap(aQuartina(1)) = True : nQuartUnionCount = nQuartUnionCount + 1
If Not aQuartUnionMap(aQuartina(2)) Then aQuartUnionMap(aQuartina(2)) = True : nQuartUnionCount = nQuartUnionCount + 1
If Not aQuartUnionMap(aQuartina(3)) Then aQuartUnionMap(aQuartina(3)) = True : nQuartUnionCount = nQuartUnionCount + 1
If Not aQuartUnionMap(aQuartina(4)) Then aQuartUnionMap(aQuartina(4)) = True : nQuartUnionCount = nQuartUnionCount + 1
End If
Next
Next
Next
Next
If nQuartUnionCount > 0 Then
ReDim aQuartUnionNumeri(nQuartUnionCount)
c = 0
For k = 1 To 90
If aQuartUnionMap(k) Then
c = c + 1
aQuartUnionNumeri(c) = k
End If
Next
Call OrdinaMatrice(aQuartUnionNumeri,1)
Call Scrivi("? UNIONE SEQUENZIALE DELLE QUARTINE (RITARDO X7 SU CLASSE 4) ?",True)
Call Scrivi(" -> Quartine totali sviluppate dal gruppo intermedio: " & nCombTotaliQuart)
Call Scrivi(" -> Soglia minima ritardo per Ambo in Quartina: " & nMinRAQuartina & " estrazioni")
Call Scrivi(" -> Quantità elementi finali ristretti: " & nQuartUnionCount & " numeri")
If nQuartUnionCount <= nMaxElementiUnione Then
Call Scrivi(" -> CONDIZIONE DI VALIDITA' (<= " & nMaxElementiUnione & " elementi): COPERTA! (PRONTA AL GIOCO)",True)
Else
Call Scrivi(" -> CONDIZIONE DI VALIDITA' (<= " & nMaxElementiUnione & " elementi): SUPERATA (Troppi elementi: " & nQuartUnionCount & " n.)")
End If
Call Scrivi("")
Call Scrivi(" -> Sotto-gruppo Ristretto Consigliato (Giocabile per Ambo a Colpo):",True)
Call Scrivi(" " & StringaNumeri(aQuartUnionNumeri,"."),True)
Else
Call Scrivi("Nessuna quartina formata dai " & nUnionCount & " numeri intermedi ha un ritardo per Ambo >= " & nMinRAQuartina & ".")
End If
ElseIf nUnionCount > 0 Then
ReDim aUnionNumeri(nUnionCount)
c = 0
For k = 1 To 90
If aUnionMap(k) Then
c = c + 1
aUnionNumeri(c) = k
End If
Next
Call OrdinaMatrice(aUnionNumeri,1)
Call Scrivi(" -> Il gruppo intermedio generato dal primo livello ha solo " & nUnionCount & " numeri (minore di 4).")
Call Scrivi(" -> Impossibile procedere con lo sviluppo in quartine. Viene restituito il gruppo senza il secondo filtro:")
Call Scrivi(" " & StringaNumeri(aUnionNumeri,"."),True)
Else
Call Scrivi("Nessuna terzina della migliore 41ina di oggi ha un ritardo per Ambo >= " & nMinRATerzina)
End If
End If
Call Scrivi("==========================================================================================")
Call Scrivi("")
End If
' Riepilogo finale
Call Scrivi("--- ELABORAZIONE TERMINATA ---")
Call Scrivi("Combinazioni totali testate per oggi: " & FormatNumber(i - 1,0))
Call Scrivi("Combinazioni totali idonee oggi: " & FormatNumber(nTrovate,0))
End Sub
Sub Titolazione()
Call Scrivi("==========================================================================================",True)
Call Scrivi(" ANALIZZATORE DI COMBINAZIONI CASUALI CON ROLLING BACKTEST & FILTRO DINAMICO v2.3",True)
Call Scrivi("==========================================================================================",True)
Call Scrivi("")
End Sub
' Funzione matematica per calcolare le combinazioni teoriche senza ripetizione (Fissata con ByVal!)
Function CombinazioniSenzaRipetizione(ByVal n,ByVal k)
Dim i,p
p = 1
If k > n Then
CombinazioniSenzaRipetizione = 0
Exit Function
End If
If k > n / 2 Then k = n - k
For i = 1 To k
p = p *(n - i + 1) / i
Next
CombinazioniSenzaRipetizione = p
End FunctionOption Explicit
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
Dim 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
Dim K
Dim nPuntatore
nPuntatore = nClasse
nTmp = aPuntatore(nPuntatore) + 1
Do While nTmp > nQNumPerRiga
nPuntatore = nPuntatore - 1
If nPuntatore <= 0 Then
Exit Do
End If
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
Dim q
q = 0
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
Dim k
Dim 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
Dim j
Dim s
For k = 1 To nClasse
s = ""
For j = 1 To nQNumPerRiga
s = s & Format2(aRighe(k,j)) & "."
Next
Next
End Sub
End Class
Dim nGlobSorte
Dim nGlobStepRiduzione
Dim nGlobClasseMinima
Dim sGlobRuoteModalita
Dim aGlobRuote
Dim nGlobInizio
Dim nGlobFine
Dim nGlobCasiOttimali
Dim nGlobFormazioniFinali
Dim aGlobElencoFinali
Dim aGlobFinaliNum
Sub Main
Dim databellaodafile
Dim ruoteuniteoseparate
Dim aNumDaSvil
Dim aNumDaSvilIniziale
nGlobCasiOttimali = 0
nGlobFormazioniFinali = 0
ReDim aGlobElencoFinali(0)
ReDim aGlobFinaliNum(0)
ReDim aGlobRuote(0)
nGlobFine = EstrazioneFin
nGlobInizio = EstrazioneIni
nGlobSorte = CInt(InputBox("Inserisci la sorte",,2))
nGlobStepRiduzione = CInt(InputBox("Inserisci il passo di riduzione (es. 1)",,1))
nGlobClasseMinima = CInt(InputBox("Inserisci la classe minima finale di arrivo",,5)) 'consigliata 5 che produce un gucfinale di livello 2 da 10 a 15 elementi ca.
databellaodafile = InputBox("Numeri da tabella (t) o da file (f)",,"t")
ruoteuniteoseparate = InputBox("Ruote unite (u) o separate (s)",,"u")
sGlobRuoteModalita = ruoteuniteoseparate
If databellaodafile = "t" Then
If sGlobRuoteModalita = "s" Then
Call ScegliRuote(aGlobRuote)
Else
Dim aruotesel
ReDim aruotesel(0)
Call ScegliRuote(aruotesel)
ReDim aGlobRuote(UBound(aruotesel))
Dim w
For w = 0 To UBound(aruotesel)
aGlobRuote(w) = aruotesel(w)
Next
End If
Call ScegliNumeri(aNumDaSvil)
Else
Dim filenumeribase
filenumeribase = ScegliFile(".\",".txt")
If sGlobRuoteModalita = "s" Then
Call ScegliRuote(aGlobRuote)
Else
ReDim aruotesel(0)
Call ScegliRuote(aruotesel)
ReDim aGlobRuote(UBound(aruotesel))
For w = 0 To UBound(aruotesel)
aGlobRuote(w) = aruotesel(w)
Next
End If
Dim aRigheFile
ReDim aRigheFile(0)
Call LeggiRigheFileDiTesto(filenumeribase,aRigheFile)
Dim aNumLetto
Dim indR
For indR = 0 To UBound(aRigheFile)
If Trim(aRigheFile(indR)) <> "" Then
Call SplitByChar(aRigheFile(indR),".",aNumLetto)
Exit For
End If
Next
ReDim aNumDaSvil(UBound(aNumLetto))
Dim indN
For indN = 0 To UBound(aNumLetto)
aNumDaSvil(indN) = Int(aNumLetto(indN))
Next
End If
ReDim aNumDaSvilIniziale(UBound(aNumDaSvil))
Dim idxIniz
For idxIniz = 0 To UBound(aNumDaSvil)
aNumDaSvilIniziale(idxIniz) = aNumDaSvil(idxIniz)
Next
Scrivi "========================================================================================"
Scrivi "AVVIO SISTEMA RIDUZIONALE AD ALBERO MULTI-RAMO (INCMAX III)",True,,,vbBlue,4
Scrivi "Range Temporale: " & GetInfoEstrazione(nGlobInizio) & " - " & GetInfoEstrazione(nGlobFine)
Scrivi "Sorte Analizzata: " & nGlobSorte & " | Passo Riduzione: " & nGlobStepRiduzione & " | Classe Minima Target: " & nGlobClasseMinima
Scrivi "Ruote: " & StringaRuote(aGlobRuote) & " (" & sGlobRuoteModalita & ")"
Scrivi "Gruppo Base Iniziale: " & StringaNumeri(aNumDaSvilIniziale) & " (classe " & UBound(aNumDaSvilIniziale) & ")"
Scrivi "========================================================================================"
Scrivi
Call ElaboraRamoRicorsivo(aNumDaSvil,"Ramo_1")
Scrivi
Scrivi "========================================================================================"
Scrivi "REPORT FINALE DELL'ALBERO RIDUZIONALE",True,,,vbBlue,4
Scrivi "Tempo Totale Impiegato: " & TempoTrascorso
Scrivi "Totale Casi Teoricamente Ottimali (Diff 0 e DiffIncMax 0): " & nGlobCasiOttimali
Scrivi "Totale Formazioni Giunte al Target Minimo (Classe " & nGlobClasseMinima & "): " & nGlobFormazioniFinali
Scrivi "----------------------------------------------------------------------------------------"
Dim ef
For ef = 1 To UBound(aGlobElencoFinali)
Scrivi "[" & ef & "] " & aGlobElencoFinali(ef)
Next
Scrivi "----------------------------------------------------------------------------------------"
If nGlobFormazioniFinali > 0 Then
Dim aPresenzeNum
ReDim aPresenzeNum(90)
Dim fNum
For fNum = 1 To 90
aPresenzeNum(fNum) = 0
Next
Dim iForm
Dim iPos
Dim aVettNumTemp
For iForm = 1 To nGlobFormazioniFinali
aVettNumTemp = aGlobFinaliNum(iForm)
For iPos = 1 To UBound(aVettNumTemp)
Dim nEstratto
nEstratto = aVettNumTemp(iPos)
If nEstratto >= 1 And nEstratto <= 90 Then
aPresenzeNum(nEstratto) = aPresenzeNum(nEstratto) + 1
End If
Next
Next
Dim sCollimantiFull
sCollimantiFull = ""
Dim qCollimantiFull
qCollimantiFull = 0
Dim sUnione
sUnione = ""
Dim qUnione
qUnione = 0
For fNum = 1 To 90
If aPresenzeNum(fNum) = nGlobFormazioniFinali Then
qCollimantiFull = qCollimantiFull + 1
sCollimantiFull = sCollimantiFull & Format2(fNum) & "."
End If
If aPresenzeNum(fNum) > 0 Then
qUnione = qUnione + 1
sUnione = sUnione & Format2(fNum) & "."
End If
Next
If qCollimantiFull > 0 Then
sCollimantiFull = RimuoviLastChr(sCollimantiFull,".")
End If
If qUnione > 0 Then
sUnione = RimuoviLastChr(sUnione,".")
End If
Dim aBoolBaseIniziale
aBoolBaseIniziale = ArrayNumeriToBool(aNumDaSvilIniziale)
Dim sDifferenziali
sDifferenziali = ""
Dim qDifferenziali
qDifferenziali = 0
For fNum = 1 To 90
If aBoolBaseIniziale(fNum) Then
If aPresenzeNum(fNum) = 0 Then
qDifferenziali = qDifferenziali + 1
sDifferenziali = sDifferenziali & Format2(fNum) & "."
End If
End If
Next
If qDifferenziali > 0 Then
sDifferenziali = RimuoviLastChr(sDifferenziali,".")
End If
Scrivi "ANALISI INSIEMISTICA FORMAZIONI TERMINALI:",True,,,vbBlack,3
Scrivi
Scrivi "1) NUMERI COLLIMANTI FULL (presenti in TUTTE le " & nGlobFormazioniFinali & " formazioni) [Classe " & qCollimantiFull & "]:",True,,,vbGreen,3
If qCollimantiFull > 0 Then
Scrivi sCollimantiFull
Else
Scrivi "Nessun numero presente all'unanimita in tutte le formazioni."
End If
Scrivi
Scrivi "2) GRUPPO UNIONE (tutti i numeri distinti emersi) [Classe " & qUnione & "]:",True,,,vbBlue,3
If qUnione > 0 Then
Scrivi sUnione
End If
Scrivi
Scrivi "3) GRUPPO DIFFERENZIALI (Numeri Base Iniziale NON presenti nell'Unione) [Classe " & qDifferenziali & "]:",True,,,vbRed,3
If qDifferenziali > 0 Then
Scrivi sDifferenziali
Else
Scrivi "Nessun differenziale: tutti i numeri della base iniziale sono stati preservati nell'unione."
End If
End If
Scrivi "========================================================================================"
Scrivi
Scrivi "Tt : " & TempoTrascorso
Scrivi
End Sub
Sub ElaboraRamoRicorsivo(aNumeriAttuali,sIdRamo)
If ScriptInterrotto Then
Exit Sub
End If
Dim cSvil
Dim nQNumeriAttuali
Dim nClasseSuccessiva
Dim nCombInt
Dim aColonna
Dim RetRit1
Dim RetRitMax
Dim RetIncrRitMax
Dim RetFreq
Dim diff
Dim stringaelencoincrementi
Dim vettoreincrementi
Dim vettoreincrementiinteri
Dim vettoreritardi
Dim vettoreidestrazioni
Dim cvr
Dim cvixim
Dim Diffincmax
Dim Stringaoutput
Dim freqmassima
Dim numFqMax
Dim aVincitoriNumeri
Dim aVincitoriStringhe
Dim contacomb
nQNumeriAttuali = UBound(aNumeriAttuali)
nClasseSuccessiva = nQNumeriAttuali - nGlobStepRiduzione
If nClasseSuccessiva < nGlobClasseMinima Or nClasseSuccessiva < nGlobSorte Then
nGlobFormazioniFinali = nGlobFormazioniFinali + 1
ReDim Preserve aGlobElencoFinali(nGlobFormazioniFinali)
aGlobElencoFinali(nGlobFormazioniFinali) = sIdRamo & " | Classe " & nQNumeriAttuali & " -> " & StringaNumeri(aNumeriAttuali)
ReDim Preserve aGlobFinaliNum(nGlobFormazioniFinali)
Dim aFormCopia
ReDim aFormCopia(UBound(aNumeriAttuali))
Dim cpy
For cpy = 1 To UBound(aNumeriAttuali)
aFormCopia(cpy) = aNumeriAttuali(cpy)
Next
aGlobFinaliNum(nGlobFormazioniFinali) = aFormCopia
Scrivi ">>> TRAGUARDO TARGET RAGGIUNTO DA " & sIdRamo & " [Classe " & nQNumeriAttuali & "] <<<",True,,,vbGreen,3
Scrivi "Formazione Finale: " & StringaNumeri(aNumeriAttuali)
Scrivi "----------------------------------------------------------------------------------------"
Exit Sub
End If
Set cSvil = New clsSviluppo
nCombInt = cSvil.InitSviluppo(aNumeriAttuali,nClasseSuccessiva)
If nCombInt <= 0 Then
Exit Sub
End If
Scrivi "----------------------------------------------------------------------------------------"
Scrivi "[" & sIdRamo & "] -> Sviluppo in Classe " & nClasseSuccessiva & " (da base " & nQNumeriAttuali & " num.) - Comb: " & nCombInt
Scrivi "Gruppo Base: " & cSvil.GetStringaNumDaSvil & " [Classe " & nQNumeriAttuali & "]"
Scrivi
freqmassima = - 1
numFqMax = 0
contacomb = 0
ReDim aVincitoriNumeri(0)
ReDim aVincitoriStringhe(0)
Do While cSvil.GetComb(aColonna)
If sGlobRuoteModalita = "s" Then
Dim r
Dim aruotetmp
ReDim aruotetmp(1)
For r = 1 To UBound(aGlobRuote)
aruotetmp(1) = aGlobRuote(r)
Call StatisticaFormazioneTurbo(aColonna,aruotetmp,nGlobSorte,RetRit1,RetRitMax,RetIncrRitMax,RetFreq,nGlobInizio,nGlobFine)
diff = RetRitMax - RetRit1
Call ElencoRitardi(aColonna,aruotetmp,nGlobSorte,nGlobInizio,nGlobFine,vettoreritardi,vettoreidestrazioni)
contacomb = contacomb + 1
Stringaoutput = StringaNumeri(aColonna) & " - " & StringaRuote(aruotetmp) & " -s " & nGlobSorte & " -ra " & RetRit1 & " -rs " & RetRitMax & " -incmax " & RetIncrRitMax & " -freq " & RetFreq & " [Classe " & nClasseSuccessiva & "]"
stringaelencoincrementi = ""
For cvr = 1 To UBound(vettoreritardi) - 1
stringaelencoincrementi = stringaelencoincrementi & "." & vettoreritardi(cvr + 1) - vettoreritardi(cvr)
Next
Call SplitByChar(stringaelencoincrementi,".",vettoreincrementi)
ReDim vettoreincrementiinteri(UBound(vettoreincrementi) + 1)
For cvixim = 1 To UBound(vettoreincrementi) - 1
vettoreincrementiinteri(cvixim) = Int(vettoreincrementi(cvixim))
Next
If UBound(vettoreincrementi) > 0 Then
Diffincmax = Int(vettoreincrementi(UBound(vettoreincrementi))) - Int(MassimoV(vettoreincrementiinteri,0,UBound(vettoreincrementiinteri) - 1))
If diff = 0 And Diffincmax = 0 Then
Scrivi "----------------------------------------------------------------------------------------"
Scrivi "RILEVATO CASO TEORICAMENTE OTTIMALE! [" & sIdRamo & " - Classe " & nClasseSuccessiva & "]",True,,,vbRed,4
nGlobCasiOttimali = nGlobCasiOttimali + 1
Scrivi Stringaoutput
Scrivi "INCMAX ATTUALE by incrementi " & vettoreincrementi(UBound(vettoreincrementi))
Scrivi "INCMAX MASSIMO STORICO by incrementi interi " & MassimoV(vettoreincrementiinteri,0,UBound(vettoreincrementiinteri) - 1)
Scrivi "DIFF INCMAX ATT-STO " & Diffincmax
Scrivi "----------------------------------------------------------------------------------------"
End If
End If
If RetFreq > freqmassima Then
freqmassima = RetFreq
numFqMax = 1
ReDim aVincitoriNumeri(1)
ReDim aVincitoriStringhe(1)
aVincitoriStringhe(1) = Stringaoutput
Dim aTempCol
ReDim aTempCol(UBound(aColonna))
Dim cp
For cp = 1 To UBound(aColonna)
aTempCol(cp) = aColonna(cp)
Next
aVincitoriNumeri(1) = aTempCol
Else
If RetFreq = freqmassima Then
numFqMax = numFqMax + 1
ReDim Preserve aVincitoriNumeri(numFqMax)
ReDim Preserve aVincitoriStringhe(numFqMax)
aVincitoriStringhe(numFqMax) = Stringaoutput
ReDim aTempCol(UBound(aColonna))
For cp = 1 To UBound(aColonna)
aTempCol(cp) = aColonna(cp)
Next
aVincitoriNumeri(numFqMax) = aTempCol
End If
End If
Messaggio sIdRamo & " | Classe: " & nClasseSuccessiva & " | Svil: " & cSvil.GetQuantitaSviluppate
If ScriptInterrotto Then
Exit Do
End If
Call AvanzamentoElab(1,nCombInt,contacomb)
If ScriptInterrotto Then
Exit For
End If
Next
Else
Call StatisticaFormazioneTurbo(aColonna,aGlobRuote,nGlobSorte,RetRit1,RetRitMax,RetIncrRitMax,RetFreq,nGlobInizio,nGlobFine)
diff = RetRitMax - RetRit1
Call ElencoRitardi(aColonna,aGlobRuote,nGlobSorte,nGlobInizio,nGlobFine,vettoreritardi,vettoreidestrazioni)
contacomb = contacomb + 1
Stringaoutput = StringaNumeri(aColonna) & " - " & StringaRuote(aGlobRuote) & " -s " & nGlobSorte & " -ra " & RetRit1 & " -rs " & RetRitMax & " -incmax " & RetIncrRitMax & " -freq " & RetFreq & " [Classe " & nClasseSuccessiva & "]"
stringaelencoincrementi = ""
For cvr = 1 To UBound(vettoreritardi) - 1
stringaelencoincrementi = stringaelencoincrementi & "." & vettoreritardi(cvr + 1) - vettoreritardi(cvr)
Next
Call SplitByChar(stringaelencoincrementi,".",vettoreincrementi)
ReDim vettoreincrementiinteri(UBound(vettoreincrementi) + 1)
For cvixim = 1 To UBound(vettoreincrementi) - 1
vettoreincrementiinteri(cvixim) = Int(vettoreincrementi(cvixim))
Next
If UBound(vettoreincrementi) > 0 Then
Diffincmax = Int(vettoreincrementi(UBound(vettoreincrementi))) - Int(MassimoV(vettoreincrementiinteri,0,UBound(vettoreincrementiinteri) - 1))
If diff = 0 And Diffincmax = 0 Then
Scrivi "----------------------------------------------------------------------------------------"
Scrivi "RILEVATO CASO TEORICAMENTE OTTIMALE! [" & sIdRamo & " - Classe " & nClasseSuccessiva & "]",True,,,vbRed,4
nGlobCasiOttimali = nGlobCasiOttimali + 1
Scrivi Stringaoutput
Scrivi "INCMAX ATTUALE by incrementi " & vettoreincrementi(UBound(vettoreincrementi))
Scrivi "INCMAX MASSIMO STORICO by incrementi interi " & MassimoV(vettoreincrementiinteri,0,UBound(vettoreincrementiinteri) - 1)
Scrivi "DIFF INCMAX ATT-STO " & Diffincmax
Scrivi "----------------------------------------------------------------------------------------"
End If
End If
If RetFreq > freqmassima Then
freqmassima = RetFreq
numFqMax = 1
ReDim aVincitoriNumeri(1)
ReDim aVincitoriStringhe(1)
aVincitoriStringhe(1) = Stringaoutput
ReDim aTempCol(UBound(aColonna))
For cp = 1 To UBound(aColonna)
aTempCol(cp) = aColonna(cp)
Next
aVincitoriNumeri(1) = aTempCol
Else
If RetFreq = freqmassima Then
numFqMax = numFqMax + 1
ReDim Preserve aVincitoriNumeri(numFqMax)
ReDim Preserve aVincitoriStringhe(numFqMax)
aVincitoriStringhe(numFqMax) = Stringaoutput
ReDim aTempCol(UBound(aColonna))
For cp = 1 To UBound(aColonna)
aTempCol(cp) = aColonna(cp)
Next
aVincitoriNumeri(numFqMax) = aTempCol
End If
End If
Messaggio sIdRamo & " | Classe: " & nClasseSuccessiva & " | Svil: " & cSvil.GetQuantitaSviluppate
If ScriptInterrotto Then
Exit Do
End If
Call AvanzamentoElab(1,nCombInt,contacomb)
End If
If ScriptInterrotto Then
Exit Do
End If
Loop
If numFqMax = 1 Then
Scrivi "=> [" & sIdRamo & "] FQ Massima UNICA in Classe " & nClasseSuccessiva & " (Freq " & freqmassima & "):",True,,,vbGreen,3
Scrivi aVincitoriStringhe(1)
Scrivi
Dim aNuovoGruppo
aNuovoGruppo = aVincitoriNumeri(1)
Call ElaboraRamoRicorsivo(aNuovoGruppo,sIdRamo)
Else
If numFqMax > 1 Then
Scrivi "=> BIVIO / RAMIFICAZIONE in [" & sIdRamo & "] a Classe " & nClasseSuccessiva & " (Trovate " & numFqMax & " formazioni con Freq Max comune " & freqmassima & "):",True,,,vbBlue,3
Dim idx
For idx = 1 To numFqMax
Scrivi " -> Sotto-Ramo " & sIdRamo & "." & idx & " : " & aVincitoriStringhe(idx)
Next
Scrivi
For idx = 1 To numFqMax
If ScriptInterrotto Then
Exit For
End If
Dim aSottoGruppo
aSottoGruppo = aVincitoriNumeri(idx)
Call ElaboraRamoRicorsivo(aSottoGruppo,sIdRamo & "." & idx)
Next
End If
End If
End Sub'====================================================================================================
' SCRIPT SPAZIOSCRIPT PER SPAZIOMETRIA VERSIONE TOTALMENTE ESPANSA
' RIDUZIONE AUTOMATICA CON 4° LIVELLO DI SPAREGGIO SU RS MINIMO UNICO
'====================================================================================================
Class clsParStat
Dim idestr
Dim ritmax
Dim incrritmax
End Class
Class clsSviluppo
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(aNumeri)
Call InitArrayPuntatore
End If
InitSviluppo = nCombInt
End Function
Function GetQuantitaNumeriDaSvil
GetQuantitaNumeriDaSvil = nQNumeri
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
Dim K
Dim nPuntatore
nPuntatore = nClasse
nTmp = aPuntatore(nPuntatore) + 1
Do While nTmp > nQNumPerRiga
nPuntatore = nPuntatore - 1
If nPuntatore <= 0 Then
Exit Do
End If
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
Dim q
q = 0
For k = 1 To UBound(aNumeri)
If aNumeri(k) > 0 Then
q = q + 1
End If
Next
AlimentArrayNumDaSvil = q
End Function
Private Sub AlimentaArrayRighe(aNumeri)
Dim nRiga
Dim k
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
End Class
Class clsLunghetta
Private anumeri
Private aposizione
Private minizio
Private mfine
Private aruote
Private msorte
Private mclasse
Private aelencorit
Private aidestrelencorit
Private aelencoincrritmax
Private aidestrincrritmax
Private aritardiallincremento
Private mritardo
Private mritardomax
Private mincrritmax
Private mfrequenza
Private mincrritardomaxsto
Private mstrincritsto
Public Property Get inumincrementi
inumincrementi = UBound(aelencoincrritmax)
End Property
Public Property Get incrritmaxsto
incrritmaxsto = mincrritardomaxsto
End Property
Public Property Get strincritmaxsto
strincritmaxsto = mstrincritsto
End Property
Public Property Get ritardo
ritardo = mritardo
End Property
Public Property Get ritardomax
ritardomax = mritardomax
End Property
Public Property Get incrritmax
incrritmax = mincrritmax
End Property
Public Property Get frequenza
frequenza = mfrequenza
End Property
Public Property Get lunghettastring
lunghettastring = StringaNumeri(anumeri)
End Property
Sub init(slunghetta,schrsep,rangeinizio,rangefine,vetruote,sorteingioco,apos)
minizio = rangeinizio
mfine = rangefine
aruote = vetruote
msorte = sorteingioco
aposizione = apos
Call alimentavettorelunghetta(slunghetta,schrsep)
Call ElencoRitardi(anumeri,aruote,msorte,minizio,mfine,aelencorit,aidestrelencorit)
Call alimentavettoreincrritmax
End Sub
Sub eseguistatistica(apos)
Call StatisticaFormazioneTurbo(anumeri,aruote,msorte,mritardo,mritardomax,mincrritmax,mfrequenza,minizio,mfine,,apos)
End Sub
Private Sub alimentavettorelunghetta(slunghetta,schrsep)
Dim k
If IsArray(slunghetta) Then
ReDim anumeri(UBound(slunghetta))
For k = 1 To UBound(slunghetta)
anumeri(k) = slunghetta(k)
Next
Else
Call SplitByChar((schrsep & slunghetta),schrsep,anumeri)
End If
mclasse = UBound(anumeri)
End Sub
Private Sub alimentavettoreincrritmax
Dim nritmax
Dim nincr
Dim nid
Dim k
Dim nupper
nid = 0
nritmax = 0
ReDim aelencoincrritmax(0)
ReDim aidestrincrritmax(0)
ReDim aritardiallincremento(0)
If UBound(aelencorit) >= 1 Then
aelencoincrritmax(0) = aelencorit(1)
End If
For k = 1 To UBound(aelencorit)
If aelencorit(k) > nritmax Then
If nritmax > 0 Then
nincr = aelencorit(k) - nritmax
nid = nid + 1
ReDim Preserve aelencoincrritmax(nid)
aelencoincrritmax(nid) = nincr
ReDim Preserve aidestrincrritmax(nid)
aidestrincrritmax(nid) = aidestrelencorit(k)
ReDim Preserve aritardiallincremento(nid)
aritardiallincremento(nid) = aelencorit(k)
End If
nritmax = aelencorit(k)
End If
Next
mstrincritsto = ""
For k = 1 To UBound(aelencoincrritmax)
If k = 1 Then
mstrincritsto = CStr(aelencoincrritmax(k))
Else
mstrincritsto = mstrincritsto & "." & aelencoincrritmax(k)
End If
Next
nupper = UBound(aelencoincrritmax)
If nupper >= 2 Then
mincrritardomaxsto = MassimoV(aelencoincrritmax,1,nupper - 1)
ElseIf nupper = 1 Then
mincrritardomaxsto = aelencoincrritmax(1)
Else
mincrritardomaxsto = 0
End If
End Sub
End Class
Dim filesolonumeridoc
Dim filesolonumeridocdaestrapolarefacilmente
Dim filereport
Dim filereportformazioniposizionali
Dim filesolonumeridocbyanalisitxt
Dim colpomassimo
Dim colpirimanentirispettocolpidiverifica
Dim colpirimanentirispettocolpomassimo
Dim casipositivi
Dim casinegativi
Dim casiattuali
Dim casitotali
Dim colpirimanentiminimi
Dim alcolponumero
Dim verificaestratti
Dim esitoverifica
Dim contadiffincmaxposizionalenegative
Dim casidiffincmaxp
Dim contacasitotali
Dim ultimorestocasiincorso
Sub Main
Dim sDirAppData
sDirAppData = GetDirectoryAppData
filereportformazioniposizionali = sDirAppData & "filereportformazioniposizionali.txt"
filereport = sDirAppData & "filereport.txt"
filesolonumeridoc = sDirAppData & "filesolonumeridoc.txt"
filesolonumeridocdaestrapolarefacilmente = sDirAppData & "filesolonumeridocdastrapolarefacilmente.txt"
filesolonumeridocbyanalisitxt = sDirAppData & "filesolonumeridocbyanalisitxt.txt"
If FileEsistente(filereportformazioniposizionali) Then
Call EliminaFile(filereportformazioniposizionali)
End If
If FileEsistente(filereport) Then
Call EliminaFile(filereport)
End If
If FileEsistente(filesolonumeridoc) Then
Call EliminaFile(filesolonumeridoc)
End If
If FileEsistente(filesolonumeridocdaestrapolarefacilmente) Then
Call EliminaFile(filesolonumeridocdaestrapolarefacilmente)
End If
If FileEsistente(filesolonumeridocbyanalisitxt) Then
Call EliminaFile(filesolonumeridocbyanalisitxt)
End If
Dim Inizio
Dim fine
Dim sorte
Dim rit
Dim ritmax
Dim Incmax
Dim freq
Dim quanteruoteuniteminimo
Dim quanteruoteunite
Dim quanteposizioniuniteminimo
Dim quanteposizioniunitemassimo
Dim vuoiapplicarefiltro
Dim filtroattivato
Dim diffpvolutaminima
Dim diffpvolutamassima
Dim diffincmaxposizionaleminima
Dim diffincmaxposizionalemassima
Dim Incmaxposizionalevolutominimo
Dim Incmaxposizionalevolutomassimo
Dim diffposizionale
Dim estrazioneprogressiva
Dim contaestrazioni
Dim coltotok
Dim Classeposizionale
Dim numeroruoteunite
Dim ruotescelte
Dim qualiruote
Dim aposizioni
Dim numeri
Dim anumeriok
Dim conta
Dim h
Dim w
Dim y
ReDim numeri(0)
sorte = 1
Call ScegliNumeri(numeri)
If UBound(numeri) < 1 Then
Exit Sub
End If
Dim ClasseFinaleVoluta
Dim StepRiduzione
ClasseFinaleVoluta = CInt(InputBox("Classe Finale Voluta",,5))
StepRiduzione = CInt(InputBox("Step di Riduzione (es. 1 o 2)",,2))
If StepRiduzione <= 0 Then
StepRiduzione = 1
End If
quanteruoteuniteminimo = CInt(InputBox("Quante ruote unite minimo",,1))
quanteruoteunite = CInt(InputBox("Quante ruote unite massimo",,quanteruoteuniteminimo))
quanteposizioniuniteminimo = CInt(InputBox("Quante posizioni unite minimo",,4))
quanteposizioniunitemassimo = CInt(InputBox("Quante posizioni unite massimo",,quanteposizioniuniteminimo))
vuoiapplicarefiltro = InputBox("Vuoi applicare filtro di selezione output e report file? (s/n)",,"s")
If LCase(vuoiapplicarefiltro) = "s" Or LCase(vuoiapplicarefiltro) = "si" Then
diffpvolutaminima = CInt(InputBox("Diff posizionale voluta minima",,0))
diffpvolutamassima = CInt(InputBox("Diff posizionale voluta massima",,0))
diffincmaxposizionaleminima = CInt(InputBox("Diff incmax posizionale voluta minima",,0))
diffincmaxposizionalemassima = CInt(InputBox("Diff incmax posizionale voluta massima",,0))
Incmaxposizionalevolutominimo = CInt(InputBox("Incmax posizionale voluto minimo",,0))
Incmaxposizionalevolutomassimo = CInt(InputBox("Incmax posizionale voluto massimo",,360))
filtroattivato = "si"
Else
filtroattivato = "no"
End If
Inizio = EstrazioneIni
fine = EstrazioneFin
Dim sortediverifica
Dim colpidiverifica
Dim percentualepositiva
Dim inizioverifica
Dim fineverifica
Dim verificarerisultatisiono
colpomassimo = 0
casipositivi = 0
casinegativi = 0
casiattuali = 0
casitotali = 0
contacasitotali = 0
casidiffincmaxp = 0
contadiffincmaxposizionalenegative = 0
colpirimanentiminimi = EstrazioneFin
verificarerisultatisiono = InputBox("Verificare risultati? (s/n)",,"s")
qualiruote = ScegliRuote(ruotescelte)
aposizioni = Array(0,1,2,3,4,5)
If LCase(verificarerisultatisiono) = "s" Or LCase(verificarerisultatisiono) = "si" Then
inizioverifica = CInt(InputBox("Quante ultime estrazioni verificare",,100))
sortediverifica = CInt(InputBox("Sorte di verifica",,2))
colpidiverifica = CInt(InputBox("Colpi di verifica",,inizioverifica - 2))
If colpidiverifica <= 0 Then
colpidiverifica = 18
End If
Else
inizioverifica = 0
sortediverifica = 2
colpidiverifica = 18
End If
fineverifica = EstrazioneFin
Dim sortediricerca
sortediricerca = CInt(InputBox("Sorte di ricerca",,2))
contaestrazioni = 0
Dim aCombPosizioni()
Dim nTotCombPos
Dim aCombRuote()
Dim nTotCombRuote
Dim aColTmp
nTotCombPos = 0
ReDim aCombPosizioni(0)
For Classeposizionale = quanteposizioniuniteminimo To quanteposizioniunitemassimo
If InitSviluppoIntegrale(aposizioni,Classeposizionale) > 0 Then
Do While GetCombSviluppo(aColTmp)
nTotCombPos = nTotCombPos + 1
ReDim Preserve aCombPosizioni(nTotCombPos)
aCombPosizioni(nTotCombPos) = aColTmp
Loop
End If
Next
nTotCombRuote = 0
ReDim aCombRuote(0)
For numeroruoteunite = quanteruoteuniteminimo To quanteruoteunite
If InitSviluppoIntegrale(ruotescelte,numeroruoteunite) > 0 Then
Do While GetCombSviluppo(aColTmp)
nTotCombRuote = nTotCombRuote + 1
ReDim Preserve aCombRuote(nTotCombRuote)
aCombRuote(nTotCombRuote) = aColTmp
Loop
End If
Next
Scrivi
Scrivi "=========================================================================="
Scrivi " AVVIO PROCESSO DI RIDUZIONE AUTOMATICA AD ALGORITMO MIN COLPI "
Scrivi "=========================================================================="
Scrivi "Gruppo Base Iniziale : " & StringaNumeri(numeri) & " (Classe " & UBound(numeri) & ")"
Scrivi "Classe Target Finale : " & ClasseFinaleVoluta
Scrivi "Step di Riduzione : -" & StepRiduzione
Scrivi "Sorte di Ricerca : " & sortediricerca
Scrivi "Sorte di Verifica : " & sortediverifica
Scrivi "Ruote Selezionate : " & StringaRuote(ruotescelte)
Scrivi "Criterio Primario : Min Colpi Rimanenti rispetto Colpo Max"
Scrivi "Criterio Riserva : 1° Min Diff (RS-RA) -> 2° Max RA -> 3° Max Freq -> 4° Min RS"
Scrivi "=========================================================================="
Scrivi
Dim nStartEstr
If inizioverifica > 0 Then
nStartEstr = fineverifica - inizioverifica
Else
nStartEstr = fineverifica
End If
Dim ClasseCorrente
Dim BestLunghetta()
Dim BestLunghettaRiserva()
Dim MinColpiRimStep
Dim BestRitStep
Dim BestRitMaxStep
Dim BestFreqStep
Dim sCriterioElezionePrimario
Dim MinDiffPosRiserva
Dim BestRitRiserva
Dim BestRitMaxRiserva
Dim BestFreqRiserva
Dim sCriterioElezioneRiserva
Dim BestTrovataInStep
Dim TrovataRiserva
Dim nEsitoTipo
Dim csvil
Dim nCicloStep
Dim bMigliore
nCicloStep = 0
ClasseCorrente = UBound(numeri)
Do While ClasseCorrente > ClasseFinaleVoluta
nCicloStep = nCicloStep + 1
Dim ProssimaClasse
ProssimaClasse = ClasseCorrente - StepRiduzione
If ProssimaClasse < ClasseFinaleVoluta Then
ProssimaClasse = ClasseFinaleVoluta
End If
Scrivi "--------------------------------------------------------------------------"
Scrivi "STEP " & nCicloStep & ": Riduzione da Classe " & ClasseCorrente & " a Classe " & ProssimaClasse
Scrivi "Gruppo Base di Partenza: " & StringaNumeri(numeri)
Scrivi "--------------------------------------------------------------------------"
MinColpiRimStep = 999999
BestRitStep = - 1
BestRitMaxStep = 999999
BestFreqStep = - 1
sCriterioElezionePrimario = ""
MinDiffPosRiserva = 999999
BestRitRiserva = - 1
BestRitMaxRiserva = 999999
BestFreqRiserva = - 1
sCriterioElezioneRiserva = ""
BestTrovataInStep = False
TrovataRiserva = False
' 1. SCANSIONE STORICA: Verifica vincite passate (C+), aggiornamento Colpo Max e ricerca Casi in Corso (Ca)
For estrazioneprogressiva = nStartEstr To fineverifica
Set csvil = New clsSviluppo
coltotok = csvil.InitSviluppo(numeri,ProssimaClasse)
If coltotok > 0 Then
Do While csvil.GetComb(anumeriok)
For y = 1 To nTotCombPos
For w = 1 To nTotCombRuote
conta = conta + 1
Call StatisticaFormazioneTurbo(anumeriok,aCombRuote(w),sortediricerca,rit,ritmax,Incmax,freq,Inizio,estrazioneprogressiva,,aCombPosizioni(y))
If conta Mod 1000 = 0 Then
Dim sMsgRim
If BestTrovataInStep Then
sMsgRim = CStr(MinColpiRimStep)
Else
sMsgRim = "-"
End If
Call Messaggio("Step " & nCicloStep & " (Cl " & ProssimaClasse & ") | C+: " & casipositivi & " | C-: " & casinegativi & " | Ca: " & casiattuali & " | Clp Max: " & colpomassimo & " | Min Rim: " & sMsgRim)
End If
diffposizionale = Int(ritmax - rit)
Dim passaFiltro
passaFiltro = True
If filtroattivato = "si" Then
If diffposizionale < diffpvolutaminima Or diffposizionale > diffpvolutamassima Or Incmax < Incmaxposizionalevolutominimo Or Incmax > Incmaxposizionalevolutomassimo Then
passaFiltro = False
End If
End If
If passaFiltro Then
nEsitoTipo = disegnagraficoincmaxposizionale(anumeriok,aCombPosizioni(y),aCombRuote(w),diffposizionale,estrazioneprogressiva,sortediverifica,colpidiverifica,diffincmaxposizionaleminima,diffincmaxposizionalemassima,inizioverifica,fineverifica,sortediricerca,filtroattivato)
' nEsitoTipo = 2 indica CASO IN CORSO (Ca)
If nEsitoTipo = 2 Then
bMigliore = False
Dim sMotivoPrimario
sMotivoPrimario = ""
If ultimorestocasiincorso < MinColpiRimStep Then
bMigliore = True
sMotivoPrimario = "1° Criterio Primario: Minimo Colpi Rimanenti (" & ultimorestocasiincorso & ")"
ElseIf ultimorestocasiincorso = MinColpiRimStep Then
If rit > BestRitStep Then
bMigliore = True
sMotivoPrimario = "Pari Colpi Rim (" & ultimorestocasiincorso & ") -> Spareggio 1: Maggior RA (" & rit & ")"
ElseIf rit = BestRitStep Then
If freq > BestFreqStep Then
bMigliore = True
sMotivoPrimario = "Pari Colpi Rim e Pari RA -> Spareggio 2: Massima Frequenza (" & freq & ")"
ElseIf freq = BestFreqStep Then
If ritmax < BestRitMaxStep Then
bMigliore = True
sMotivoPrimario = "Pari Colpi Rim, RA e Freq -> Spareggio 3: Minimo RS (" & ritmax & ")"
End If
End If
End If
End If
If bMigliore Then
MinColpiRimStep = ultimorestocasiincorso
BestRitStep = rit
BestRitMaxStep = ritmax
BestFreqStep = freq
sCriterioElezionePrimario = sMotivoPrimario
ReDim BestLunghetta(UBound(anumeriok))
For h = 1 To UBound(anumeriok)
BestLunghetta(h) = anumeriok(h)
Next
BestTrovataInStep = True
End If
End If
End If
If ScriptInterrotto Then
Exit For
End If
Next
If ScriptInterrotto Then
Exit For
End If
Next
If ScriptInterrotto Then
Exit Do
End If
Loop
End If
Call AvanzamentoElab(nStartEstr,fineverifica,estrazioneprogressiva)
If ScriptInterrotto Then
Exit For
End If
Next
' 2. PIANO DI RISERVA: SE NON CI SONO CASI ATTUALMENTE IN CORSO (Ca),
' RILEVAZIONE MATURITA' ATTUALE ALL'ESTRAZIONE FINALE (fineverifica)
If Not BestTrovataInStep Then
Set csvil = New clsSviluppo
coltotok = csvil.InitSviluppo(numeri,ProssimaClasse)
If coltotok > 0 Then
Do While csvil.GetComb(anumeriok)
For y = 1 To nTotCombPos
For w = 1 To nTotCombRuote
Call StatisticaFormazioneTurbo(anumeriok,aCombRuote(w),sortediricerca,rit,ritmax,Incmax,freq,Inizio,fineverifica,,aCombPosizioni(y))
diffposizionale = Int(ritmax - rit)
bMigliore = False
Dim sMotivoRiserva
sMotivoRiserva = ""
If diffposizionale < MinDiffPosRiserva Then
bMigliore = True
sMotivoRiserva = "Filtro 1: Minima Diff RS-RA (" & diffposizionale & ")"
ElseIf diffposizionale = MinDiffPosRiserva Then
If rit > BestRitRiserva Then
bMigliore = True
sMotivoRiserva = "Pari Diff (" & diffposizionale & ") -> Filtro 2: Maggior RA (" & rit & ")"
ElseIf rit = BestRitRiserva Then
If freq > BestFreqRiserva Then
bMigliore = True
sMotivoRiserva = "Pari Diff (" & diffposizionale & ") e Pari RA (" & rit & ") -> Filtro 3: Massima Frequenza (" & freq & ")"
ElseIf freq = BestFreqRiserva Then
If ritmax < BestRitMaxRiserva Then
bMigliore = True
sMotivoRiserva = "Pari Diff, RA e Freq -> Filtro 4: Minimo RS (" & ritmax & ")"
End If
End If
End If
End If
If bMigliore Then
MinDiffPosRiserva = diffposizionale
BestRitRiserva = rit
BestRitMaxRiserva = ritmax
BestFreqRiserva = freq
sCriterioElezioneRiserva = sMotivoRiserva
ReDim BestLunghettaRiserva(UBound(anumeriok))
For h = 1 To UBound(anumeriok)
BestLunghettaRiserva(h) = anumeriok(h)
Next
TrovataRiserva = True
End If
Next
Next
Loop
End If
End If
If BestTrovataInStep Then
ReDim numeri(UBound(BestLunghetta))
For h = 1 To UBound(BestLunghetta)
numeri(h) = BestLunghetta(h)
Next
ClasseCorrente = ProssimaClasse
Scrivi "<font color=red><strong>>> ELETTA MIGLIORE COMBINAZIONE STEP " & nCicloStep & " (Classe " & ClasseCorrente & "): " & StringaNumeri(numeri) & "</strong></font>"
Scrivi "<font color=purple><strong> [Criterio Applicato: " & sCriterioElezionePrimario & "]</strong></font>"
Scrivi " Parametri: Colpi Rim risp. ClpMax: " & MinColpiRimStep & " | RA: " & BestRitStep & " | RS: " & BestRitMaxStep & " | Diff (RS-RA): " & (BestRitMaxStep - BestRitStep) & " | Freq: " & BestFreqStep
Scrivi
ElseIf TrovataRiserva Then
ReDim numeri(UBound(BestLunghettaRiserva))
For h = 1 To UBound(BestLunghettaRiserva)
numeri(h) = BestLunghettaRiserva(h)
Next
ClasseCorrente = ProssimaClasse
Scrivi "<font color=blue><strong>>> ELETTA PER MATURITA' ATTUALE STEP " & nCicloStep & " (Classe " & ClasseCorrente & "): " & StringaNumeri(numeri) & "</strong></font>"
Scrivi "<font color=purple><strong> [Criterio Applicato: " & sCriterioElezioneRiserva & "]</strong></font>"
Scrivi " Parametri: RA: " & BestRitRiserva & " | RS: " & BestRitMaxRiserva & " | Diff (RS-RA): " & MinDiffPosRiserva & " | Freq: " & BestFreqRiserva
Scrivi
Else
Scrivi "<font color=red>Nessuna combinazione rilevata in questo step. Interruzione del ciclo.</font>"
Exit Do
End If
If ScriptInterrotto Then
Exit Do
End If
Loop
Dim nTotCasiRilevati
Dim percPositiviConclusi
Dim percPositiviTotali
nTotCasiRilevati = casipositivi + casinegativi + casiattuali
If(casipositivi + casinegativi) > 0 Then
percPositiviConclusi = Round((casipositivi /(casipositivi + casinegativi)) * 100,2)
Else
percPositiviConclusi = 0
End If
If nTotCasiRilevati > 0 Then
percPositiviTotali = Round((casipositivi / nTotCasiRilevati) * 100,2)
Else
percPositiviTotali = 0
End If
Scrivi
Scrivi "=========================================================================="
Scrivi " RIEPILOGO FINALE ANALISI "
Scrivi "=========================================================================="
Scrivi "Base finale ottenuta : " & StringaNumeri(numeri) & " di classe " & UBound(numeri)
If inizioverifica > 0 Then
Scrivi "Ultime estrazioni verificate : " & inizioverifica
End If
Scrivi "Range analizzato : " & GetInfoEstrazione(Inizio) & " - " & GetInfoEstrazione(fine)
Scrivi "Sorte di ricerca : " & sortediricerca
Scrivi "Sorte di verifica : " & sortediverifica
Scrivi "Colpi di verifica impostati : " & colpidiverifica
Scrivi "Numero ruote unite minimo : " & quanteruoteuniteminimo & " e massimo " & quanteruoteunite
Scrivi "Numero posizioni unite minimo : " & quanteposizioniuniteminimo & " e massimo " & quanteposizioniunitemassimo
Scrivi "--------------------------------------------------------------------------"
Scrivi "Casi Positivi (C+) : " & casipositivi
Scrivi "Casi Negativi (C-) : " & casinegativi
Scrivi "Casi Attuali In Corso (Ca) : " & casiattuali
Scrivi "Totale Casi Analizzati/Rilevati : " & nTotCasiRilevati
Scrivi "--------------------------------------------------------------------------"
Scrivi "% Positiva sui casi conclusi [C+ / (C+ + C-)] : " & percPositiviConclusi & " %"
Scrivi "% POSITIVA REALE GLOBALE (compresi casi in corso) : " & percPositiviTotali & " %"
Scrivi "--------------------------------------------------------------------------"
Scrivi "Colpo Max Generale Rilevato : " & colpomassimo
Scrivi "Tempo trascorso : " & TempoTrascorso
Scrivi "=========================================================================="
End Sub
Function disegnagraficoincmaxposizionale(anum,apos,aruo,diffposizionale,estrazioneprogressiva,sortediverifica,colpidiverifica,diffincmaxposizionaleminima,diffincmaxposizionalemassima,inizioverifica,fineverifica,sortediricerca,filtroattivato)
Dim clsl
Dim schrsep
Dim inizio
Dim fine
Dim sorte
Dim aposizione
Dim aruote
aposizione = apos
aruote = aruo
schrsep = "."
inizio = EstrazioneIni
fine = estrazioneprogressiva
Set clsl = New clsLunghetta
sorte = sortediricerca
Call clsl.init(anum,schrsep,inizio,fine,aruote,sorte,aposizione)
Call clsl.eseguistatistica(aposizione)
contacasitotali = contacasitotali + 1
Dim stringaxallincmax
Dim vettorexallincmax
Dim incmaxstoricoeffettivo
Dim diffincmaxposizionale
stringaxallincmax = clsl.strincritmaxsto
Call SplitByChar(stringaxallincmax,".",vettorexallincmax)
If UBound(vettorexallincmax) >= 1 Then
incmaxstoricoeffettivo = MassimoV(vettorexallincmax,1,UBound(vettorexallincmax))
ElseIf UBound(vettorexallincmax) = 0 Then
incmaxstoricoeffettivo = Int(vettorexallincmax(0))
Else
incmaxstoricoeffettivo = 0
End If
diffincmaxposizionale = Int(incmaxstoricoeffettivo) - Int(clsl.incrritmax)
If diffincmaxposizionale < 0 Then
contadiffincmaxposizionalenegative = contadiffincmaxposizionalenegative + 1
End If
Dim bCondizioneValida
bCondizioneValida = False
If filtroattivato = "si" Then
If Int(incmaxstoricoeffettivo) = Int(clsl.incrritmax) Or(diffincmaxposizionale >= diffincmaxposizionaleminima And diffincmaxposizionale <= diffincmaxposizionalemassima) Then
bCondizioneValida = True
End If
Else
bCondizioneValida = True
End If
If bCondizioneValida Then
If clsl.ritardomax = clsl.ritardo Then
casidiffincmaxp = casidiffincmaxp + 1
Dim sInfoEstrRilevamento
sInfoEstrRilevamento = GetInfoEstrazione(estrazioneprogressiva)
Call Scrivi("Analisi Incremento Ritardo Massimo Posizionale",True,,vbRed,vbWhite,4)
Call Scrivi("Ruota/e: " & StringaRuote(aruote) & " | Posizione/i: " & StringaNumeri(aposizione),True,,vbBlue,vbWhite,3)
Call Scrivi("<font color=purple><strong>Data Rilevamento Condizione: " & sInfoEstrRilevamento & "</strong></font>",True)
Call Scrivi("Formazione: " & clsl.lunghettastring,True,,,,2)
Call Scrivi("Ritardo Attuale: " & clsl.ritardo & " | Ritardo Max: " & clsl.ritardomax & " | Frequenza: " & clsl.frequenza,True)
Call Scrivi("IncMax Attuale: " & clsl.incrritmax & " | IncMax Storico: " & incmaxstoricoeffettivo,True)
Call Scrivi("Diff IncMax Posizionale: " & diffincmaxposizionale)
Scrivi
Call VerificaEsitoTurbo(anum,aruote,estrazioneprogressiva + 1,sortediverifica,colpidiverifica,,esitoverifica,alcolponumero,verificaestratti)
Dim idEstrazioneSfaldamento
Dim sInfoEstrSfaldamento
If esitoverifica <> "" Then
casipositivi = casipositivi + 1
idEstrazioneSfaldamento = estrazioneprogressiva + alcolponumero
sInfoEstrSfaldamento = GetInfoEstrazione(idEstrazioneSfaldamento)
If alcolponumero > colpomassimo Then
colpomassimo = alcolponumero
End If
Scrivi "<font color=green size=3><strong>ESITO POSITIVO: " & verificaestratti & " al colpo " & alcolponumero & " (Colpo Max Storico Rilevato: " & colpomassimo & ")</strong></font>"
Scrivi "<font color=green>Data Sfaldamento: " & sInfoEstrSfaldamento & "</font>"
Scrivi
Call ScriviFile(filesolonumeridoc,sInfoEstrRilevamento & " | " & clsl.lunghettastring & " r: " & StringaRuote(aruote) & " p: " & StringaNumeri(aposizione) & " | Esito: " & sInfoEstrSfaldamento & " al colpo " & alcolponumero & ";")
Call CloseFileHandle(filesolonumeridoc)
disegnagraficoincmaxposizionale = 1
Exit Function
Else
colpirimanentirispettocolpidiverifica = colpidiverifica -(fineverifica - estrazioneprogressiva)
If colpirimanentirispettocolpidiverifica < 0 Then
casinegativi = casinegativi + 1
Scrivi "<font color=red size=3><strong>ESITO NEGATIVO</strong></font>"
Scrivi
disegnagraficoincmaxposizionale = 0
Exit Function
Else
casiattuali = casiattuali + 1
Scrivi "<font color=orange size=3><strong>IN CORSO (Ca)</strong></font>"
Scrivi "Colpi rimanenti teorici rispetto colpi di verifica: " & colpirimanentirispettocolpidiverifica
If colpomassimo > 0 Then
colpirimanentirispettocolpomassimo = colpomassimo -(fineverifica - estrazioneprogressiva)
ultimorestocasiincorso = colpirimanentirispettocolpomassimo
Scrivi "Colpi rimanenti teorici rispetto colpo massimo: " & colpirimanentirispettocolpomassimo
Else
colpirimanentirispettocolpomassimo = colpidiverifica -(fineverifica - estrazioneprogressiva)
ultimorestocasiincorso = colpirimanentirispettocolpomassimo
Scrivi "Colpi rimanenti teorici (in attesa di primo colpo max storico): " & colpirimanentirispettocolpomassimo
End If
Scrivi
disegnagraficoincmaxposizionale = 2
Exit Function
End If
End If
End If
End If
disegnagraficoincmaxposizionale = 0
End Function
(firmato: uno dei tanti nerd fan di cose come il canale yt omega click ecc...) 
