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'SpazioScript - Analizzatore Combinazioni con Rolling Backtest, Analisi Ipergeometrica, Riduzione & Quadranti Dinamici
'Versione v2.4 (Modulo Quadranti Frequenza/Ritardo & Convergenze Automatiche)
Sub Main()
' Dichiarazione delle variabili principali
Dim aFissi
Dim aPool
Dim aComboCompleta
Dim aSfissi
Dim nFissi
Dim nDinamici
Dim nRuota
Dim nSorte
Dim max_diff
Dim i
Dim r
Dim temp
Dim k
Dim c
Dim RetRit
Dim RetRitMax
Dim RetIncrRitMax
Dim RetFreq
Dim nInizio
Dim nFine
Dim sFissi
Dim sDinamici
Dim sCompleta
Dim nDiff
Dim nTrovate
Dim sFissiTemp
Dim aFissiString
Dim aRuote(1)
' Variabili per il calcolo dello spazio combinatorio e probabilita
Dim nIntegrali
Dim nCoperturaPerc
Dim nClasseIbrida
Dim nAmbiInClasse
Dim nCoverageAmbiPerc
Dim nComb90_5
Dim nComb90MinusC_5
Dim nComb90MinusC_4
Dim p0
Dim p1
Dim pAtLeast2
Dim pAtLeast2Perc
' Variabili per il Backtest Rolling
Dim bEseguiBacktest
Dim nRangeBacktest
Dim nCombinazioniBT
Dim nColpi
Dim nStartBT
Dim nEndBT
Dim t
Dim iBT
Dim nCasiTotali
Dim nCasiVincenti
Dim nTrovateInQuestoT
Dim FreqEsito
Dim sPercent
' Variabili per la Mappatura di Pre-Sfaldamento dei Singoli Estratti
Dim nTotalWNums
Dim nSumRA
Dim nSumRS
Dim nSumFreq
Dim nFascia1
Dim nFascia2
Dim nFascia3
Dim nFascia4
Dim tEsito
Dim colpo
Dim aInCombo
Dim nVal
Dim Pos
Dim Estr
Dim matchesCount
Dim aMatches
Dim idxM
Dim WNum
Dim aNumSingle
Dim RA_single
Dim RS_single
Dim Freq_single
' Variabili per il Salvataggio e l'Ordinamento in Memoria
Dim nMaxSalvate
Dim nSalvateCount
Dim aSalvateComboStr
Dim aSalvateFissiStr
Dim aSalvateDinamiciStr
Dim aSalvateDiff
Dim aSalvateRA
Dim aSalvateRS
Dim aSalvateFreq
Dim aSalvateNumeri
Dim x
Dim y
Dim bScambiato
Dim bScambia
Dim tempDiff
Dim tempRA
Dim tempRS
Dim tempFreq
Dim tempComboStr
Dim tempFissiStr
Dim tempDinamiciStr
Dim tempNum
Dim colNum
' Variabili per la Filtrazione Dinamica (Fase 3)
Dim bMiglioreTrovata
Dim aMiglioreComboDiOggi
Dim bFasciaFav(4)
Dim sFasceFav
Dim anyFasciaActive
Dim maxFascia
Dim maxCount
Dim aFavoriti
Dim nFavoritiCount
Dim numCurrent
Dim RA_current
Dim fasciaCurrent
' Variabili per i filtri finali (Fase 4)
Dim nTipoFiltroFinale
Dim nMinRATerzina
Dim nMaxElementiUnione
Dim nMinPresenze
Dim nMinRAQuartina
Dim i1
Dim i2
Dim i3
Dim nRA_terz
Dim aTerzina
Dim aUnionMap
Dim nUnionCount
Dim aUnionNumeri
Dim nCombTotaliTerz
Dim aUnionFreq
Dim q1
Dim q2
Dim q3
Dim q4
Dim aQuartina
Dim aQuartUnionMap
Dim nQuartUnionCount
Dim aQuartUnionNumeri
Dim nRA_quart
Dim nCombTotaliQuart
' Variabili per l'analisi odierna
Dim nCombinazioniOggi
Dim nTopPrint
Dim idxP
Dim nPoolSize
Dim aDinamiciOrdinati
' Variabili per FASE 5: Quadranti Frequenza/Ritardo e Convergenze
Dim nTotR1
Dim aR1_Num
Dim aR1_FQ
Dim aR1_RA
Dim aR1_RS
Dim aR1_IncMax
Dim aR1_Diff
Dim aR1_Ratio
Dim aR1_Single
Dim retSingRit
Dim retSingRitMax
Dim retSingIncr
Dim retSingFreq
Dim nMetaR1
' Vettori per ordinamento FQ
Dim aFQ_Num
Dim aFQ_Val
Dim aFQ_RA
Dim aFQ_RS
Dim aFQ_IncMax
Dim aFQ_Diff
Dim aFQ_Ratio
' Vettori per ordinamento RA
Dim aRA_Num
Dim aRA_Val
Dim aRA_RS
Dim aRA_FQ
Dim aRA_IncMax
Dim aRA_Diff
Dim aRA_Ratio
' Mappe booleane dei 4 quadranti
Dim bQFM(90)
Dim bQfm_min(90)
Dim bQRM(90)
Dim bQrm_min(90)
' Vettori d'appoggio per stampe stringhe quadranti
Dim aListQFM
Dim aListQfm_min
Dim aListQRM
Dim aListQrm_min
Dim cQFM
Dim cQfm_min
Dim cQRM
Dim cQrm_min
' Vettori per le 4 convergenze
Dim aConv1
Dim aConv2
Dim aConv3
Dim aConv4
Dim cConv1
Dim cConv2
Dim cConv3
Dim cConv4
Dim sRatioFormatted
Dim tNum
Dim tFQ
Dim tRA
Dim tRS
Dim tInc
Dim tDiff
Dim tRatio
' Inizializzazione del generatore casuale nativo di VBScript
Randomize
' ==================================================================
' --- CONFIGURAZIONE PARAMETRI ---
nRuota = ScegliRuota()
nSorte = CInt(InputBox("Sorte di ricerca","sorte",2))
max_diff = CInt(InputBox("Max diff","max diff",1))
nDinamici = CInt(InputBox("Num. dinamici","num dinamici",33))
' PARAMETRI PER L'ANALISI CORRENTE (OGGI)
nCombinazioniOggi = 10000
' PARAMETRI PER IL ROLLING BACKTEST & MAPPATURA
bEseguiBacktest = True
nRangeBacktest = 100
nCombinazioniBT = 500
nColpi = 1
' ------------------------------------------------------------------
' --- IMPOSTAZIONE PARAMETRI DI FILTRAZIONE FINALE (FASE 4) ---
' ------------------------------------------------------------------
nTipoFiltroFinale = 2
nMinRATerzina = 900
nMaxElementiUnione = 22
nMinPresenze = 2
nMinRAQuartina = 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
End If
nEndBT = nFine - nColpi
If nEndBT < nStartBT Then
nEndBT = nStartBT
End If
' 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"
aFissiString = Split(sFissiTemp,".")
nFissi = UBound(aFissiString) + 1
ReDim aFissi(nFissi)
ReDim aSfissi(90)
For i = 1 To 90
aSfissi(i) = False
Next
For i = 1 To nFissi
aFissi(i) = CInt(aFissiString(i - 1))
aSfissi(aFissi(i)) = True
Next
' Creazione del Pool con i rimanenti numeri
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
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
End If
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
Else
If RA_single <= 18 Then
nFascia2 = nFascia2 + 1
Else
If RA_single <= 36 Then
nFascia3 = nFascia3 + 1
Else
nFascia4 = nFascia4 + 1
End If
End If
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 ---
' ==================================================================
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
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(" - Probabilita 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) e 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
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
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
Else
If aSalvateDiff(y) = aSalvateDiff(y + 1) Then
If aSalvateRA(y) < aSalvateRA(y + 1) Then
bScambia = True
Else
If aSalvateRA(y) = aSalvateRA(y + 1) Then
If aSalvateFreq(y) < aSalvateFreq(y + 1) Then
bScambia = True
End If
End If
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
End If
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
End If
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) sara l'unico bacino di numeri")
Call Scrivi(" utilizzato per estrarre i Super Favoriti (Fase 3), i filtri di Fase 4 e i Quadranti di Fase 5.")
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.")
For k = 1 To 4
bFasciaFav(k) = False
Next
sFasceFav = ""
If(nFascia1 / nTotalWNums) >= 0.20 Then
bFasciaFav(1) = True
sFasceFav = sFasceFav & "Fascia 1 (RA 0-9) | "
End If
If(nFascia2 / nTotalWNums) >= 0.20 Then
bFasciaFav(2) = True
sFasceFav = sFasceFav & "Fascia 2 (RA 10-18) | "
End If
If(nFascia3 / nTotalWNums) >= 0.20 Then
bFasciaFav(3) = True
sFasceFav = sFasceFav & "Fascia 3 (RA 19-36) | "
End If
If(nFascia4 / nTotalWNums) >= 0.20 Then
bFasciaFav(4) = True
sFasceFav = sFasceFav & "Fascia 4 (RA > 36) | "
End If
anyFasciaActive = False
For k = 1 To 4
If bFasciaFav(k) Then
anyFasciaActive = True
End If
Next
If Not anyFasciaActive Then
maxCount = 0
maxFascia = 1
If nFascia1 > maxCount Then
maxCount = nFascia1
maxFascia = 1
End If
If nFascia2 > maxCount Then
maxCount = nFascia2
maxFascia = 2
End If
If nFascia3 > maxCount Then
maxCount = nFascia3
maxFascia = 3
End If
If nFascia4 > maxCount Then
maxCount = nFascia4
maxFascia = 4
End If
bFasciaFav(maxFascia) = True
If maxFascia = 1 Then
sFasceFav = "Fascia 1 (RA 0-9) | "
End If
If maxFascia = 2 Then
sFasceFav = "Fascia 2 (RA 10-18) | "
End If
If maxFascia = 3 Then
sFasceFav = "Fascia 3 (RA 19-36) | "
End If
If maxFascia = 4 Then
sFasceFav = "Fascia 4 (RA > 36) | "
End If
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
Else
If RA_current <= 18 Then
fasciaCurrent = 2
Else
If RA_current <= 36 Then
fasciaCurrent = 3
Else
fasciaCurrent = 4
End If
End If
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(" -> Quantita originaria della combinazione: " & UBound(aMiglioreComboDiOggi) & " numeri")
Call Scrivi(" -> Quantita 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(" -> Quantita 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)
' -----------------------------------------------------------
Else
If 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
End If
If Not aUnionMap(aTerzina(2)) Then
aUnionMap(aTerzina(2)) = True
nUnionCount = nUnionCount + 1
End If
If Not aUnionMap(aTerzina(3)) Then
aUnionMap(aTerzina(3)) = True
nUnionCount = nUnionCount + 1
End If
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
End If
If Not aQuartUnionMap(aQuartina(2)) Then
aQuartUnionMap(aQuartina(2)) = True
nQuartUnionCount = nQuartUnionCount + 1
End If
If Not aQuartUnionMap(aQuartina(3)) Then
aQuartUnionMap(aQuartina(3)) = True
nQuartUnionCount = nQuartUnionCount + 1
End If
If Not aQuartUnionMap(aQuartina(4)) Then
aQuartUnionMap(aQuartina(4)) = True
nQuartUnionCount = nQuartUnionCount + 1
End If
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(" -> Quantita 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
Else
If 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 combinazione di oggi ha un ritardo per Ambo >= " & nMinRATerzina)
End If
End If
End If
End If
Call Scrivi("==========================================================================================")
Call Scrivi("")
End If
' ==================================================================
' --- FASE 5: QUADRANTI DI FREQUENZA/RITARDO E CONVERGENZE (RANK #1) ---
' ==================================================================
If bMiglioreTrovata Then
nTotR1 = UBound(aMiglioreComboDiOggi)
nMetaR1 = Int(nTotR1 / 2)
ReDim aR1_Num(nTotR1)
ReDim aR1_FQ(nTotR1)
ReDim aR1_RA(nTotR1)
ReDim aR1_RS(nTotR1)
ReDim aR1_IncMax(nTotR1)
ReDim aR1_Diff(nTotR1)
ReDim aR1_Ratio(nTotR1)
ReDim aR1_Single(1)
For k = 1 To nTotR1
aR1_Num(k) = aMiglioreComboDiOggi(k)
aR1_Single(1) = aR1_Num(k)
Call StatisticaFormazioneTurbo(aR1_Single,aRuote,1,retSingRit,retSingRitMax,retSingIncr,retSingFreq,nInizio,nFine)
aR1_FQ(k) = retSingFreq
aR1_RA(k) = retSingRit
aR1_RS(k) = retSingRitMax
aR1_IncMax(k) = retSingIncr
aR1_Diff(k) = retSingRitMax - retSingRit
If retSingRitMax > 0 Then
aR1_Ratio(k) = retSingRit / retSingRitMax
Else
aR1_Ratio(k) = 0
End If
Next
' --- 5.1 ORDINAMENTO PER FREQUENZA DECRESCENTE ---
ReDim aFQ_Num(nTotR1)
ReDim aFQ_Val(nTotR1)
ReDim aFQ_RA(nTotR1)
ReDim aFQ_RS(nTotR1)
ReDim aFQ_IncMax(nTotR1)
ReDim aFQ_Diff(nTotR1)
ReDim aFQ_Ratio(nTotR1)
For k = 1 To nTotR1
aFQ_Num(k) = aR1_Num(k)
aFQ_Val(k) = aR1_FQ(k)
aFQ_RA(k) = aR1_RA(k)
aFQ_RS(k) = aR1_RS(k)
aFQ_IncMax(k) = aR1_IncMax(k)
aFQ_Diff(k) = aR1_Diff(k)
aFQ_Ratio(k) = aR1_Ratio(k)
Next
For x = 1 To nTotR1 - 1
bScambiato = False
For y = 1 To nTotR1 - x
bScambia = False
If aFQ_Val(y) < aFQ_Val(y + 1) Then
bScambia = True
Else
If aFQ_Val(y) = aFQ_Val(y + 1) Then
If aFQ_RA(y) < aFQ_RA(y + 1) Then
bScambia = True
End If
End If
End If
If bScambia Then
tNum = aFQ_Num(y)
aFQ_Num(y) = aFQ_Num(y + 1)
aFQ_Num(y + 1) = tNum
tFQ = aFQ_Val(y)
aFQ_Val(y) = aFQ_Val(y + 1)
aFQ_Val(y + 1) = tFQ
tRA = aFQ_RA(y)
aFQ_RA(y) = aFQ_RA(y + 1)
aFQ_RA(y + 1) = tRA
tRS = aFQ_RS(y)
aFQ_RS(y) = aFQ_RS(y + 1)
aFQ_RS(y + 1) = tRS
tInc = aFQ_IncMax(y)
aFQ_IncMax(y) = aFQ_IncMax(y + 1)
aFQ_IncMax(y + 1) = tInc
tDiff = aFQ_Diff(y)
aFQ_Diff(y) = aFQ_Diff(y + 1)
aFQ_Diff(y + 1) = tDiff
tRatio = aFQ_Ratio(y)
aFQ_Ratio(y) = aFQ_Ratio(y + 1)
aFQ_Ratio(y + 1) = tRatio
bScambiato = True
End If
Next
If Not bScambiato Then
Exit For
End If
Next
' Popolamento Mappe Booleane Quadranti Frequenza
For k = 1 To 90
bQFM(k) = False
bQfm_min(k) = False
Next
For k = 1 To nMetaR1
bQFM(aFQ_Num(k)) = True
Next
For k = nMetaR1 + 1 To nTotR1
bQfm_min(aFQ_Num(k)) = True
Next
' --- 5.2 ORDINAMENTO PER RITARDO ATTUALE (RA) DECRESCENTE ---
ReDim aRA_Num(nTotR1)
ReDim aRA_Val(nTotR1)
ReDim aRA_RS(nTotR1)
ReDim aRA_FQ(nTotR1)
ReDim aRA_IncMax(nTotR1)
ReDim aRA_Diff(nTotR1)
ReDim aRA_Ratio(nTotR1)
For k = 1 To nTotR1
aRA_Num(k) = aR1_Num(k)
aRA_Val(k) = aR1_RA(k)
aRA_RS(k) = aR1_RS(k)
aRA_FQ(k) = aR1_FQ(k)
aRA_IncMax(k) = aR1_IncMax(k)
aRA_Diff(k) = aR1_Diff(k)
aRA_Ratio(k) = aR1_Ratio(k)
Next
For x = 1 To nTotR1 - 1
bScambiato = False
For y = 1 To nTotR1 - x
bScambia = False
If aRA_Val(y) < aRA_Val(y + 1) Then
bScambia = True
Else
If aRA_Val(y) = aRA_Val(y + 1) Then
If aRA_FQ(y) < aRA_FQ(y + 1) Then
bScambia = True
End If
End If
End If
If bScambia Then
tNum = aRA_Num(y)
aRA_Num(y) = aRA_Num(y + 1)
aRA_Num(y + 1) = tNum
tRA = aRA_Val(y)
aRA_Val(y) = aRA_Val(y + 1)
aRA_Val(y + 1) = tRA
tRS = aRA_RS(y)
aRA_RS(y) = aRA_RS(y + 1)
aRA_RS(y + 1) = tRS
tFQ = aRA_FQ(y)
aRA_FQ(y) = aRA_FQ(y + 1)
aRA_FQ(y + 1) = tFQ
tInc = aRA_IncMax(y)
aRA_IncMax(y) = aRA_IncMax(y + 1)
aRA_IncMax(y + 1) = tInc
tDiff = aRA_Diff(y)
aRA_Diff(y) = aRA_Diff(y + 1)
aRA_Diff(y + 1) = tDiff
tRatio = aRA_Ratio(y)
aRA_Ratio(y) = aRA_Ratio(y + 1)
aRA_Ratio(y + 1) = tRatio
bScambiato = True
End If
Next
If Not bScambiato Then
Exit For
End If
Next
' Popolamento Mappe Booleane Quadranti Ritardo
For k = 1 To 90
bQRM(k) = False
bQrm_min(k) = False
Next
For k = 1 To nMetaR1
bQRM(aRA_Num(k)) = True
Next
For k = nMetaR1 + 1 To nTotR1
bQrm_min(aRA_Num(k)) = True
Next
' --- 5.3 STAMPA DETTAGLIATA ORDINAMENTO FREQUENZA ---
Call Scrivi("VEDIAMO DOVE CASCONO I 2 POINTS A COLPO tra prime " & nMetaR1 & " righe... a fq max e prime " &(nTotR1 - nMetaR1) & " righe... a fq min della RISULTANZA RANK 1",True)
Call Scrivi("")
Call Scrivi("Elaborazione con archivio lotto aggiornato al [" & nFine & "] [" & IndiceAnnuale(nFine) & "] " & DataEstrazione(nFine))
Call Scrivi("Gruppo base numerico analizzato " & StringaNumeri(aMiglioreComboDiOggi,"."))
Call Scrivi("Note extra riguardanti lo sviluppo: analisi per Estratto sulla ruota di " & SiglaRuota(nRuota))
Call Scrivi("Combinazioni di classe 1 analizzate per punti 1 sulle ruote " & SiglaRuota(nRuota))
Call Scrivi("La seguente lista mostra le prime Combinazioni In Base al valore di Frequenza")
Call Scrivi("Range analizzato [00001] [ 1 ] " & DataEstrazione(1) & " fino a [" & nFine & "] [" & IndiceAnnuale(nFine) & "] " & DataEstrazione(nFine))
Call Scrivi("Estrazioni analizzate totali : " & nFine)
Call Scrivi("")
For k = 1 To nTotR1
sRatioFormatted = Round(aFQ_Ratio(k),4)
Call Scrivi("formazione: " & aFQ_Num(k) & " - FREQUENZA (FQ) " & aFQ_Val(k) & " - RITARDO ATTUALE (RA) " & aFQ_RA(k) & " - RITARDO STORICO (RS) " & aFQ_RS(k) & " - RITARDO STORICO-RITARDO ATTUALE (DIFF) " & aFQ_Diff(k) & " " & aFQ_Diff(k) & " - INCREMENTO MASSIMO DI RITARDO (INCMAX) " & aFQ_IncMax(k) & " - contatore " & k & " ra/rs " & sRatioFormatted)
If k = nMetaR1 Then
Call Scrivi("-----------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------")
End If
Next
Call Scrivi("")
Call Scrivi("Solo tutte le formazioni di numeri generabili con la classe e il gruppo base scelti")
Call Scrivi("")
For k = 1 To nMetaR1
Call Scrivi(aFQ_Num(k))
Next
Call Scrivi("---")
For k = nMetaR1 + 1 To nTotR1
Call Scrivi(aFQ_Num(k))
Next
Call Scrivi("")
' --- 5.4 STAMPA DETTAGLIATA ORDINAMENTO RITARDO ---
Call Scrivi("E VEDIAMO ANCHE DOVE ESCONO i 2 POINTS A COLPO nelle prime " & nMetaR1 & " righe... a ra max e prime " &(nTotR1 - nMetaR1) & " righe... a ra min",True)
Call Scrivi("")
Call Scrivi("Elaborazione con archivio lotto aggiornato al [" & nFine & "] [" & IndiceAnnuale(nFine) & "] " & DataEstrazione(nFine))
Call Scrivi("Gruppo base numerico analizzato " & StringaNumeri(aMiglioreComboDiOggi,"."))
Call Scrivi("Combinazioni di classe 1 analizzate per punti 1 sulle ruote " & SiglaRuota(nRuota))
Call Scrivi("La seguente lista mostra le prime Combinazioni In Base al valore di Ritardo")
Call Scrivi("Range analizzato [00001] [ 1 ] " & DataEstrazione(1) & " fino a [" & nFine & "] [" & IndiceAnnuale(nFine) & "] " & DataEstrazione(nFine))
Call Scrivi("Estrazioni analizzate totali : " & nFine)
Call Scrivi("")
For k = 1 To nTotR1
sRatioFormatted = Round(aRA_Ratio(k),4)
Call Scrivi("formazione: " & aRA_Num(k) & " - FREQUENZA (FQ) " & aRA_FQ(k) & " - RITARDO ATTUALE (RA) " & aRA_Val(k) & " - RITARDO STORICO (RS) " & aRA_RS(k) & " - RITARDO STORICO-RITARDO ATTUALE (DIFF) " & aRA_Diff(k) & " " & aRA_Diff(k) & " - INCREMENTO MASSIMO DI RITARDO (INCMAX) " & aRA_IncMax(k) & " - contatore " & k & " ra/rs " & sRatioFormatted)
If k = nMetaR1 Then
Call Scrivi("------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------")
End If
Next
Call Scrivi("")
Call Scrivi("Solo tutte le formazioni di numeri generabili con la classe e il gruppo base scelti")
Call Scrivi("")
For k = 1 To nMetaR1
Call Scrivi(aRA_Num(k))
Next
Call Scrivi("----")
For k = nMetaR1 + 1 To nTotR1
Call Scrivi(aRA_Num(k))
Next
Call Scrivi("")
' --- 5.5 ESTRAZIONE E ORDINAMENTO DEI 4 QUADRANTI ---
ReDim aListQFM(nMetaR1)
cQFM = 0
For k = 1 To 90
If bQFM(k) Then
cQFM = cQFM + 1
aListQFM(cQFM) = k
End If
Next
Call OrdinaMatrice(aListQFM,1)
ReDim aListQfm_min(nTotR1 - nMetaR1)
cQfm_min = 0
For k = 1 To 90
If bQfm_min(k) Then
cQfm_min = cQfm_min + 1
aListQfm_min(cQfm_min) = k
End If
Next
Call OrdinaMatrice(aListQfm_min,1)
ReDim aListQRM(nMetaR1)
cQRM = 0
For k = 1 To 90
If bQRM(k) Then
cQRM = cQRM + 1
aListQRM(cQRM) = k
End If
Next
Call OrdinaMatrice(aListQRM,1)
ReDim aListQrm_min(nTotR1 - nMetaR1)
cQrm_min = 0
For k = 1 To 90
If bQrm_min(k) Then
cQrm_min = cQrm_min + 1
aListQrm_min(cQrm_min) = k
End If
Next
Call OrdinaMatrice(aListQrm_min,1)
Call Scrivi("VEDIAMO GLI EVENTUALI CONVERGENTI SECONDO I QUATTRO ""QUADRANTI"" CREATI...",True)
Call Scrivi("")
Call Scrivi("QUADRANTI FREQUENZA")
Call Scrivi("")
Call Scrivi("QFM " & StringaNumeri(aListQFM,"-"))
Call Scrivi("---")
Call Scrivi("Qfm " & StringaNumeri(aListQfm_min,"-"))
Call Scrivi("")
Call Scrivi("----")
Call Scrivi("----")
Call Scrivi("")
Call Scrivi("QUADRANTI RITARDO")
Call Scrivi("")
Call Scrivi("QRM " & StringaNumeri(aListQRM,"-"))
Call Scrivi("----")
Call Scrivi("Qrm " & StringaNumeri(aListQrm_min,"-"))
Call Scrivi("")
Call Scrivi("")
' --- 5.6 CALCOLO E STAMPA DELLE 4 INTERSEZIONI / CONVERGENZE ---
' Convergenza 1: QFM @ QRM
ReDim aConv1(90)
cConv1 = 0
For k = 1 To 90
If bQFM(k) And bQRM(k) Then
cConv1 = cConv1 + 1
aConv1(cConv1) = k
End If
Next
ReDim Preserve aConv1(cConv1)
Call OrdinaMatrice(aConv1,1)
' Convergenza 2: QFM @ Qrm
ReDim aConv2(90)
cConv2 = 0
For k = 1 To 90
If bQFM(k) And bQrm_min(k) Then
cConv2 = cConv2 + 1
aConv2(cConv2) = k
End If
Next
ReDim Preserve aConv2(cConv2)
Call OrdinaMatrice(aConv2,1)
' Convergenza 3: Qfm @ QRM
ReDim aConv3(90)
cConv3 = 0
For k = 1 To 90
If bQfm_min(k) And bQRM(k) Then
cConv3 = cConv3 + 1
aConv3(cConv3) = k
End If
Next
ReDim Preserve aConv3(cConv3)
Call OrdinaMatrice(aConv3,1)
' Convergenza 4: Qfm @ Qrm
ReDim aConv4(90)
cConv4 = 0
For k = 1 To 90
If bQfm_min(k) And bQrm_min(k) Then
cConv4 = cConv4 + 1
aConv4(cConv4) = k
End If
Next
ReDim Preserve aConv4(cConv4)
Call OrdinaMatrice(aConv4,1)
Call Scrivi("CONVERGENTI QFM @ QRM",True)
If cConv1 > 0 Then
Call Scrivi(StringaNumeri(aConv1,"-"))
Else
Call Scrivi("Nessun elemento convergente")
End If
Call Scrivi("")
Call Scrivi("CONVERGENTI QFM @ Qrm",True)
If cConv2 > 0 Then
Call Scrivi(StringaNumeri(aConv2,"-"))
Else
Call Scrivi("Nessun elemento convergente")
End If
Call Scrivi("")
Call Scrivi("CONVERGENTI Qfm @ QRM",True)
If cConv3 > 0 Then
Call Scrivi(StringaNumeri(aConv3,"-"))
Else
Call Scrivi("Nessun elemento convergente")
End If
Call Scrivi("")
Call Scrivi("CONVERGENTI Qfm @ Qrm",True)
If cConv4 > 0 Then
Call Scrivi(StringaNumeri(aConv4,"-"))
Else
Call Scrivi("Nessun elemento convergente")
End If
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.4",True)
Call Scrivi("==========================================================================================",True)
Call Scrivi("")
End Sub
Function CombinazioniSenzaRipetizione(ByVal n,ByVal k)
Dim i
Dim p
p = 1
If k > n Then
CombinazioniSenzaRipetizione = 0
Exit Function
End If
If k > n / 2 Then
k = n - k
End If
For i = 1 To k
p = p *(n - i + 1) / i
Next
CombinazioniSenzaRipetizione = p
End Function
(firmato: uno dei tanti nerd fan di cose come il canale yt omega click ecc...) 
