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'SpazioScript - Analizzatore Combinazioni con Rolling Backtest, Analisi Ipergeometrica, Riduzione, Quadranti Dinamici & Matrici GDP2
'Versione v2.6 (Export 5 File TXT Puliti sul Desktop & Sintassi Espansa Anti-1012)
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
' Variabili per le 8 righe export con nomi distinti
Dim sExp_QFM
Dim sExp_Qfm_min
Dim sExp_QRM
Dim sExp_Qrm_min
Dim sExp_Conv1
Dim sExp_Conv2
Dim sExp_Conv3
Dim sExp_Conv4
' Variabili per i file TXT
Dim fso
Dim fFile
Dim sNomeFile
Dim sPercorsoDesktop
Dim WshShell
' 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"
'Caricamento dei 29 fissi
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 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("")
' ==================================================================
' --- 1) BLOCCO EXPORT 8 RIGHE (SOLO NUMERI SEPARATI DA PUNTO) ---
' ==================================================================
sExp_QFM = StringaNumeri(aListQFM,".")
sExp_Qfm_min = StringaNumeri(aListQfm_min,".")
sExp_QRM = StringaNumeri(aListQRM,".")
sExp_Qrm_min = StringaNumeri(aListQrm_min,".")
sExp_Conv1 = StringaNumeri(aConv1,".")
sExp_Conv2 = StringaNumeri(aConv2,".")
sExp_Conv3 = StringaNumeri(aConv3,".")
sExp_Conv4 = StringaNumeri(aConv4,".")
Call Scrivi("==========================================================================================",True)
Call Scrivi(" BLOCCO EXPORT 8 RIGHE (SOLO NUMERI SEPARATI DA PUNTO - FACILE DA COPIARE)",True)
Call Scrivi("==========================================================================================",True)
Call Scrivi(sExp_QFM)
Call Scrivi(sExp_Qfm_min)
Call Scrivi(sExp_QRM)
Call Scrivi(sExp_Qrm_min)
Call Scrivi(sExp_Conv1)
Call Scrivi(sExp_Conv2)
Call Scrivi(sExp_Conv3)
Call Scrivi(sExp_Conv4)
Call Scrivi("==========================================================================================")
Call Scrivi("")
' ==================================================================
' --- ESPORTAZIONE FILE TXT SEPARATI (PULITI SOLO NUMERI) SUL DESKTOP ---
' ==================================================================
Set WshShell = CreateObject("WScript.Shell")
sPercorsoDesktop = WshShell.SpecialFolders("Desktop") & "\"
Set WshShell = Nothing
' 1. FILE QUADRANTI E CONVERGENZE (8 RIGHE)
sNomeFile = sPercorsoDesktop & "01_Quadranti_8Righe_" & SiglaRuota(nRuota) & "_Estr_" & nFine & ".txt"
On Error Resume Next
Set fso = CreateObject("Scripting.FileSystemObject")
Set fFile = fso.CreateTextFile(sNomeFile,True)
If Err.Number = 0 Then
fFile.WriteLine(sExp_QFM)
fFile.WriteLine(sExp_Qfm_min)
fFile.WriteLine(sExp_QRM)
fFile.WriteLine(sExp_Qrm_min)
fFile.WriteLine(sExp_Conv1)
fFile.WriteLine(sExp_Conv2)
fFile.WriteLine(sExp_Conv3)
fFile.WriteLine(sExp_Conv4)
fFile.Close
Call Scrivi(" -> File 8 Righe salvato: " & sNomeFile,True)
End If
On Error GoTo 0
' 2. SISTEMIZZAZIONE E SALVATAGGIO DEI 4 FILE MATRICI GDP2
If nTotR1 = 66 Then
Call Scrivi("==========================================================================================",True)
Call Scrivi(" FASE 6: GENERAZIONE E SALVATAGGIO DEI 4 FILE MATRICI GDP2 SUL DESKTOP",True)
Call Scrivi("==========================================================================================",True)
' MATRICE 22 (13 colonne)
sNomeFile = sPercorsoDesktop & "02_Matrice_C66_22_13colonne_" & SiglaRuota(nRuota) & "_Estr_" & nFine & ".txt"
Call SviluppaMatrice22(aMiglioreComboDiOggi,sNomeFile)
' MATRICE 11 (48 colonne)
sNomeFile = sPercorsoDesktop & "03_Matrice_C66_11_48colonne_" & SiglaRuota(nRuota) & "_Estr_" & nFine & ".txt"
Call SviluppaMatrice11(aMiglioreComboDiOggi,sNomeFile)
' MATRICE 6 (143 colonne)
sNomeFile = sPercorsoDesktop & "04_Matrice_C66_6_143colonne_" & SiglaRuota(nRuota) & "_Estr_" & nFine & ".txt"
Call SviluppaMatrice6(aMiglioreComboDiOggi,sNomeFile)
' MATRICE 3 (726 terzine)
sNomeFile = sPercorsoDesktop & "05_Matrice_C66_3_726terzine_" & SiglaRuota(nRuota) & "_Estr_" & nFine & ".txt"
Call SviluppaMatrice3(aMiglioreComboDiOggi,sNomeFile)
Call Scrivi("")
Call Scrivi("? TUTTI E 5 I FILE TXT PULITI SONO STATI GENERATI SUL DESKTOP!",True)
Call Scrivi("==========================================================================================",True)
Call Scrivi("")
Else
Call Scrivi("Attenzione: La combinazione Rank 1 contiene " & nTotR1 & " numeri (necessari 66 per le matrici).")
End If
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.6",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
' ==================================================================
' SUB AUSILIARIE DI GENERAZIONE FILE TXT PULITI (SOLO NUMERI)
' ==================================================================
Sub SostituisciEStampa(sBloccoRighe,aNumeriBase,sTitolo,sFileDestinazione)
Dim aRighe
Dim aIndici
Dim aComboRisultante
Dim rigaIdx
Dim elemIdx
Dim sRigaOut
Dim nIndicePos
Dim fsoSub
Dim fFileSub
Dim bSubFileOk
bSubFileOk = False
On Error Resume Next
Set fsoSub = CreateObject("Scripting.FileSystemObject")
Set fFileSub = fsoSub.CreateTextFile(sFileDestinazione,True)
If Err.Number = 0 Then
bSubFileOk = True
End If
On Error GoTo 0
Call Scrivi("--- " & sTitolo & " ---",True)
aRighe = Split(sBloccoRighe,"|")
For rigaIdx = 0 To UBound(aRighe)
If Trim(aRighe(rigaIdx)) <> "" Then
aIndici = Split(Trim(aRighe(rigaIdx))," ")
ReDim aComboRisultante(UBound(aIndici) + 1)
For elemIdx = 0 To UBound(aIndici)
nIndicePos = CInt(aIndici(elemIdx))
aComboRisultante(elemIdx + 1) = aNumeriBase(nIndicePos)
Next
Call OrdinaMatrice(aComboRisultante,1)
sRigaOut = StringaNumeri(aComboRisultante,".")
Call Scrivi(sRigaOut)
If bSubFileOk Then
fFileSub.WriteLine(sRigaOut)
End If
End If
Next
If bSubFileOk Then
fFileSub.Close
Set fFileSub = Nothing
Set fsoSub = Nothing
Call Scrivi(" -> File salvato: " & sFileDestinazione,True)
End If
Call Scrivi("")
End Sub
Sub SviluppaMatrice22(aNumeriBase,sFileDestinazione)
Dim sM22
sM22 = ""
sM22 = sM22 & "1 2 3 4 10 15 17 18 19 21 32 34 35 36 37 43 48 50 51 52 54 65|"
sM22 = sM22 & "1 4 5 11 12 15 18 20 23 24 33 34 37 38 44 45 48 51 53 56 57 66|"
sM22 = sM22 & "1 4 6 16 18 22 25 26 29 30 31 34 37 39 49 51 55 58 59 62 63 64|"
sM22 = sM22 & "1 4 7 8 9 13 14 18 19 27 28 34 37 40 41 42 46 47 51 52 60 61|"
sM22 = sM22 & "2 3 6 8 10 17 20 21 25 28 30 35 36 39 41 43 50 53 54 58 61 63|"
sM22 = sM22 & "2 5 9 13 14 17 21 24 26 29 33 35 38 42 46 47 50 54 57 59 62 66|"
sM22 = sM22 & "2 7 11 12 16 17 21 22 23 27 31 35 40 44 45 49 50 54 55 56 60 64|"
sM22 = sM22 & "3 5 8 10 16 19 22 24 28 31 33 36 38 41 43 49 52 55 57 61 64 66|"
sM22 = sM22 & "3 7 10 14 19 20 25 26 27 29 30 36 40 43 47 52 53 58 59 60 62 63|"
sM22 = sM22 & "3 9 10 11 12 13 14 15 23 25 30 36 42 43 44 45 46 47 48 56 58 63|"
sM22 = sM22 & "5 6 7 13 15 24 25 27 30 32 33 38 39 40 46 48 57 58 60 63 65 66|"
sM22 = sM22 & "6 8 11 12 15 19 23 26 28 29 32 39 41 44 45 48 52 56 59 61 62 65|"
sM22 = sM22 & "6 9 10 13 14 15 16 20 22 31 32 39 42 43 46 47 48 49 53 55 64 65|"
Call SostituisciEStampa(sM22,aNumeriBase,"SISTEMA GDP2: C(66,22,2) = 13 COMBINAZIONI DA 22 NUMERI",sFileDestinazione)
End Sub
Sub SviluppaMatrice11(aNumeriBase,sFileDestinazione)
Dim sM11
sM11 = ""
sM11 = sM11 & "1 2 13 17 23 35 40 41 47 54 63|"
sM11 = sM11 & "1 3 11 12 30 32 33 34 48 50 54|"
sM11 = sM11 & "1 4 6 22 24 37 45 53 54 57 65|"
sM11 = sM11 & "1 5 14 19 28 33 35 54 59 60 61|"
sM11 = sM11 & "1 7 16 21 27 43 49 54 56 62 66|"
sM11 = sM11 & "1 8 18 20 25 31 36 46 54 59 64|"
sM11 = sM11 & "1 9 10 14 26 38 39 42 52 54 58|"
sM11 = sM11 & "1 15 17 23 29 35 44 51 54 55 62|"
sM11 = sM11 & "2 3 7 14 22 32 37 41 42 49 63|"
sM11 = sM11 & "2 4 11 18 26 41 45 46 50 52 63|"
sM11 = sM11 & "2 5 15 19 28 29 41 44 51 55 63|"
sM11 = sM11 & "2 6 21 25 33 36 41 43 48 53 63|"
sM11 = sM11 & "2 8 9 12 16 27 31 34 39 41 63|"
sM11 = sM11 & "2 10 20 24 38 41 56 63 64 65 66|"
sM11 = sM11 & "2 17 30 41 57 58 59 60 61 62 63|"
sM11 = sM11 & "3 4 16 20 23 27 32 40 45 60 64|"
sM11 = sM11 & "3 5 13 19 24 28 40 45 48 50 62|"
sM11 = sM11 & "3 6 8 31 32 44 53 55 56 58 66|"
sM11 = sM11 & "3 8 13 15 26 31 32 47 51 52 57|"
sM11 = sM11 & "3 9 24 25 29 32 36 39 61 62 65|"
sM11 = sM11 & "3 10 17 18 21 32 35 38 43 46 59|"
sM11 = sM11 & "4 5 11 18 19 26 28 46 47 52 62|"
sM11 = sM11 & "4 7 12 15 29 34 45 49 51 58 59|"
sM11 = sM11 & "4 8 14 21 23 31 40 42 43 45 61|"
sM11 = sM11 & "4 9 17 33 35 39 45 48 56 57 66|"
sM11 = sM11 & "4 10 13 25 30 36 38 44 45 47 55|"
sM11 = sM11 & "5 6 19 27 28 36 42 53 56 58 64|"
sM11 = sM11 & "5 7 12 19 23 28 30 34 37 43 66|"
sM11 = sM11 & "5 8 10 16 19 21 22 28 31 32 57|"
sM11 = sM11 & "5 9 17 19 20 25 28 38 39 49 65|"
sM11 = sM11 & "6 7 9 13 18 39 46 47 49 53 60|"
sM11 = sM11 & "6 10 11 15 16 27 38 50 51 53 61|"
sM11 = sM11 & "6 12 14 17 20 34 35 42 53 62 64|"
sM11 = sM11 & "6 23 26 29 30 40 52 53 56 59 66|"
sM11 = sM11 & "7 8 11 17 24 30 31 35 49 50 65|"
sM11 = sM11 & "7 10 12 23 25 34 36 38 40 49 57|"
sM11 = sM11 & "7 20 26 33 44 48 49 52 55 61 64|"
sM11 = sM11 & "8 10 22 29 31 33 37 38 48 60 62|"
sM11 = sM11 & "9 11 22 23 37 39 40 44 50 55 59|"
sM11 = sM11 & "9 15 20 21 22 30 37 39 43 51 64|"
sM11 = sM11 & "11 13 20 21 29 43 47 50 57 58 64|"
sM11 = sM11 & "11 14 15 25 36 42 50 51 56 60 66|"
sM11 = sM11 & "12 13 18 22 34 37 46 47 56 61 66|"
sM11 = sM11 & "12 21 24 26 34 43 44 52 55 60 65|"
sM11 = sM11 & "13 14 16 24 27 33 42 47 48 59 65|"
sM11 = sM11 & "14 16 18 27 29 30 42 44 46 55 57|"
sM11 = sM11 & "15 18 23 24 33 40 46 48 51 58 65|"
sM11 = sM11 & "16 17 22 25 26 27 35 36 37 52 58|"
Call SostituisciEStampa(sM11,aNumeriBase,"SISTEMA GDP2: C(66,11,2) = 48 COMBINAZIONI DA 11 NUMERI",sFileDestinazione)
End Sub
Sub SviluppaMatrice6(aNumeriBase,sFileDestinazione)
Dim sM6
sM6 = ""
sM6 = sM6 & "1 2 3 4 5 66|1 6 25 26 40 58|1 7 28 39 45 56|1 8 27 34 50 57|1 9 22 44 51 62|1 10 30 32 42 47|"
sM6 = sM6 & "1 11 17 38 49 55|1 12 16 24 37 59|1 13 18 36 54 64|1 14 23 52 60 63|1 15 33 41 46 65|1 19 29 31 43 48|"
sM6 = sM6 & "1 20 21 35 53 61|2 6 14 27 49 56|2 7 26 35 55 57|2 8 15 20 28 58|2 9 25 32 41 48|2 10 13 16 29 38|"
sM6 = sM6 & "2 11 18 37 44 60|2 12 17 36 45 65|2 19 22 53 59 63|2 21 30 50 52 62|2 23 34 40 51 61|2 24 31 42 46 54|"
sM6 = sM6 & "2 33 39 43 47 64|3 6 19 28 57 65|3 7 24 27 58 64|3 8 26 44 54 56|3 9 13 17 34 37|3 10 15 23 53 62|"
sM6 = sM6 & "3 11 16 35 36 50|3 12 18 25 30 38|3 14 20 31 41 47|3 21 39 49 51 63|3 22 29 45 52 61|3 32 40 43 46 59|"
sM6 = sM6 & "3 33 42 48 55 60|4 6 18 23 41 59|4 7 38 44 48 52|4 8 12 29 32 63|4 9 30 40 54 65|4 10 21 31 37 58|"
sM6 = sM6 & "4 11 22 26 34 47|4 13 42 50 53 56|4 14 16 28 33 51|4 15 19 24 45 55|4 17 39 46 57 61|4 20 27 36 43 62|"
sM6 = sM6 & "4 25 35 49 60 64|5 6 20 38 46 51|5 7 17 22 41 50|5 8 11 24 33 62|5 9 14 35 45 59|5 10 18 48 57 63|"
sM6 = sM6 & "5 12 21 28 47 54|5 13 43 52 58 65|5 15 29 40 44 49|5 16 26 32 53 64|5 19 30 34 39 60|5 23 31 36 55 56|"
sM6 = sM6 & "5 25 27 37 42 61|6 7 8 9 10 66|6 11 30 31 45 63|6 12 33 44 50 61|6 13 32 39 55 62|6 15 35 37 47 52|"
sM6 = sM6 & "6 16 22 43 54 60|6 17 21 29 42 64|6 24 34 36 48 53|7 11 19 32 54 61|7 12 31 40 60 62|7 13 20 25 33 63|"
sM6 = sM6 & "7 14 30 37 46 53|7 15 18 21 34 43|7 16 23 42 49 65|7 29 36 47 51 59|8 13 31 49 59 61|8 14 18 22 39 42|"
sM6 = sM6 & "8 16 21 40 41 55|8 17 23 30 35 43|8 19 25 36 46 52|8 37 45 48 51 64|8 38 47 53 60 65|9 11 23 28 46 64|"
sM6 = sM6 & "9 12 43 49 53 57|9 15 26 36 42 63|9 16 27 31 39 52|9 18 47 55 58 61|9 19 21 33 38 56|9 20 24 29 50 60|"
sM6 = sM6 & "10 11 25 43 51 56|10 12 22 27 46 55|10 14 19 40 50 64|10 17 26 33 52 59|10 20 34 45 49 54|10 24 35 39 44 65|"
sM6 = sM6 & "10 28 36 41 60 61|11 12 13 14 15 66|11 20 40 42 52 57|11 21 27 48 59 65|11 29 39 41 53 58|12 19 35 42 51 58|"
sM6 = sM6 & "12 20 23 26 39 48|12 34 41 52 56 64|13 19 23 27 44 47|13 21 26 45 46 60|13 22 28 35 40 48|13 24 30 41 51 57|"
sM6 = sM6 & "14 17 48 54 58 62|14 21 32 36 44 57|14 24 26 38 43 61|14 25 29 34 55 65|15 16 30 48 56 61|15 17 27 32 51 60|"
sM6 = sM6 & "15 22 31 38 57 64|15 25 39 50 54 59|16 17 18 19 20 66|16 25 45 47 57 62|16 34 44 46 58 63|17 24 40 47 56 63|"
sM6 = sM6 & "17 25 28 31 44 53|18 24 28 32 49 52|18 26 31 50 51 65|18 27 33 40 45 53|18 29 35 46 56 62|19 26 37 41 49 62|"
sM6 = sM6 & "20 22 32 37 56 65|20 30 44 55 59 64|21 22 23 24 25 66|22 30 33 36 49 58|23 29 33 37 54 57|23 32 38 45 50 58|"
sM6 = sM6 & "26 27 28 29 30 66|27 35 38 41 54 63|28 34 38 42 59 62|28 37 43 50 55 63|31 32 33 34 35 66|36 37 38 39 40 66|"
sM6 = sM6 & "41 42 43 44 45 66|46 47 48 49 50 66|51 52 53 54 55 66|56 57 58 59 60 66|61 62 63 64 65 66|"
Call SostituisciEStampa(sM6,aNumeriBase,"SISTEMA GDP2: C(66,6,2) = 143 COMBINAZIONI DA 6 NUMERI",sFileDestinazione)
End Sub
Sub SviluppaMatrice3(aNumeriBase,sFileDestinazione)
Dim sM3
sM3 = ""
sM3 = sM3 & "1 2 3|1 4 8|1 5 33|1 6 13|1 7 29|1 9 21|1 10 53|1 11 64|1 12 16|1 14 62|1 15 58|1 17 42|1 18 35|1 19 60|1 20 49|1 22 46|1 23 44|1 24 54|1 25 59|1 26 61|1 27 45|1 28 39|1 30 60|1 31 41|1 32 56|1 34 47|1 36 40|1 37 63|1 38 65|1 43 57|1 48 55|1 50 52|1 51 66|"
sM3 = sM3 & "2 4 46|2 5 12|2 6 7|2 8 27|2 9 15|2 10 11|2 13 43|2 14 39|2 16 41|2 17 24|2 18 57|2 19 48|2 20 28|2 21 42|2 22 56|2 23 59|2 24 38|2 25 63|2 26 33|2 29 62|2 30 31|2 32 53|2 34 37|2 35 60|2 36 44|2 40 61|2 45 66|2 47 58|2 49 52|2 50 51|2 54 65|2 55 64|"
sM3 = sM3 & "3 4 33|3 5 42|3 6 50|3 7 39|3 8 37|3 9 63|3 10 13|3 11 22|3 11 53|3 12 54|3 14 34|3 15 23|3 16 64|3 17 21|3 18 26|3 19 59|3 20 24|3 25 43|3 27 55|3 28 30|3 29 32|3 31 65|3 35 52|3 36 58|3 38 40|3 41 62|3 44 66|3 45 51|3 46 60|3 47 48|3 49 57|3 56 61|"
sM3 = sM3 & "4 5 34|4 6 20|4 7 55|4 9 14|4 10 57|4 11 52|4 12 20|4 13 45|4 15 28|4 16 54|4 17 29|4 18 37|4 19 27|4 21 24|4 22 43|4 23 30|4 25 26|4 31 47|4 32 59|4 35 40|4 36 51|4 38 44|4 39 62|4 41 61|4 42 64|4 48 60|4 49 53|4 50 66|4 56 58|4 63 65|"
sM3 = sM3 & "5 6 46|5 7 41|5 8 47|5 9 43|5 10 51|5 11 29|5 13 53|5 14 44|5 15 21|5 16 26|5 17 30|5 18 62|5 19 35|5 20 61|5 22 52|5 23 39|5 24 40|5 25 48|5 27 36|5 28 38|5 31 50|5 32 58|5 37 60|5 45 57|5 49 64|5 54 55|5 56 65|5 59 63|5 63 66|"
sM3 = sM3 & "6 8 27|6 9 18|6 10 35|6 11 12|6 14 21|6 15 47|6 16 66|6 17 33|6 19 39|6 22 53|6 23 54|6 24 48|6 25 50|6 26 64|6 28 58|6 29 65|6 30 44|6 31 42|6 32 63|6 34 52|6 36 59|6 37 49|6 38 60|6 40 57|6 41 51|6 43 56|6 45 55|6 61 62|"
sM3 = sM3 & "7 8 65|7 9 22|7 10 56|7 11 66|7 12 64|7 13 50|7 14 38|7 15 33|7 16 25|7 17 45|7 18 54|7 19 24|7 20 44|7 21 43|7 23 40|7 26 32|7 27 47|7 28 31|7 30 62|7 34 36|7 35 48|7 35 49|7 37 52|7 42 59|7 46 63|7 51 60|7 53 58|7 57 61|"
sM3 = sM3 & "8 9 36|8 10 54|8 11 14|8 12 57|8 13 28|8 15 42|8 16 46|8 17 51|8 18 43|8 19 66|8 20 31|8 21 56|8 22 60|8 23 25|8 24 30|8 26 35|8 29 53|8 32 34|8 33 58|8 38 55|8 39 40|8 41 44|8 45 63|8 48 61|8 49 62|8 50 64|8 52 59|"
sM3 = sM3 & "9 10 16|9 11 31|9 12 33|9 13 19|9 13 39|9 17 53|9 20 60|9 23 32|9 24 50|9 25 57|9 26 42|9 27 41|9 28 49|9 29 37|9 30 46|9 34 35|9 38 59|9 40 44|9 45 61|9 47 66|9 48 58|9 51 56|9 52 54|9 55 62|9 64 65|"
sM3 = sM3 & "10 12 17|10 14 63|10 15 49|10 18 22|10 19 62|10 20 39|10 21 58|10 23 37|10 23 41|10 24 45|10 25 42|10 26 31|10 27 44|10 28 40|10 29 30|10 32 55|10 33 50|10 34 46|10 36 47|10 38 52|10 43 48|10 59 60|10 61 64|10 65 66|"
sM3 = sM3 & "11 13 55|11 15 59|11 16 24|11 17 43|11 18 38|11 19 41|11 20 63|11 21 26|11 23 56|11 25 30|11 27 62|11 28 54|11 32 44|11 33 45|11 34 42|11 35 37|11 36 50|11 39 65|11 40 47|11 46 61|11 48 51|11 49 58|11 57 60|"
sM3 = sM3 & "12 13 48|12 14 53|12 15 56|12 18 25|12 19 21|12 22 38|12 23 50|12 24 28|12 26 43|12 27 59|12 29 66|12 30 49|12 31 32|12 32 41|12 34 45|12 35 39|12 36 60|12 37 65|12 40 42|12 44 46|12 47 62|12 51 63|12 52 55|12 58 61|"
sM3 = sM3 & "13 14 51|13 15 61|13 16 63|13 17 62|13 18 41|13 20 57|13 21 59|13 22 40|13 23 49|13 24 66|13 25 34|13 26 60|13 27 33|13 29 58|13 30 52|13 31 35|13 32 65|13 36 38|13 37 64|13 42 54|13 44 56|13 46 47|"
sM3 = sM3 & "14 15 37|14 16 58|14 17 29|14 18 47|14 19 64|14 20 25|14 22 45|14 22 61|14 23 33|14 24 36|14 26 66|14 27 30|14 28 43|14 31 59|14 32 52|14 35 41|14 40 48|14 42 46|14 49 54|14 50 55|14 56 57|14 60 65|"
sM3 = sM3 & "15 16 27|15 17 26|15 18 51|15 19 29|15 20 43|15 22 44|15 24 31|15 25 35|15 30 40|15 31 63|15 32 62|15 34 55|15 36 46|15 38 66|15 39 53|15 41 57|15 45 48|15 50 54|15 52 65|15 60 64|"
sM3 = sM3 & "16 17 60|16 18 31|16 19 38|16 20 34|16 21 62|16 22 23|16 28 29|16 30 51|16 32 39|16 33 57|16 35 55|16 36 61|16 37 40|16 42 65|16 43 52|16 44 47|16 45 50|16 48 62|16 49 56|16 53 59|"
sM3 = sM3 & "17 18 32|17 19 47|17 20 59|17 22 58|17 23 48|17 25 27|17 28 34|17 31 54|17 35 56|17 36 55|17 37 57|17 38 63|17 39 49|17 40 66|17 41 52|17 44 65|17 46 64|17 50 61|"
sM3 = sM3 & "18 19 50|18 20 48|18 21 52|18 23 27|18 24 46|18 28 61|18 29 45|18 30 34|18 33 42|18 36 56|18 39 61|18 40 60|18 44 59|18 49 66|18 53 64|18 55 63|18 58 65|"
sM3 = sM3 & "19 20 54|19 22 49|19 23 58|19 25 28|19 26 36|19 30 46|19 31 52|19 32 43|19 33 59|19 34 65|19 37 61|19 40 53|19 42 57|19 44 63|19 45 56|19 51 55|"
sM3 = sM3 & "20 21 50|20 22 65|20 23 66|20 26 45|20 27 37|20 29 40|20 30 38|20 32 35|20 33 46|20 36 62|20 41 58|20 42 47|20 51 52|20 53 55|20 56 64|"
sM3 = sM3 & "21 22 57|21 23 36|21 25 29|21 26 53|21 27 65|21 28 47|21 30 63|21 31 45|21 32 46|21 33 55|21 34 38|21 35 51|21 37 39|21 40 49|21 41 64|21 44 60|21 48 66|21 54 61|"
sM3 = sM3 & "22 24 29|22 25 55|22 26 30|22 27 31|22 28 62|22 32 37|22 33 48|22 34 66|22 35 63|22 36 42|22 39 51|22 41 54|22 47 64|22 50 59|"
sM3 = sM3 & "23 24 43|23 26 62|23 28 55|23 29 42|23 31 60|23 34 64|23 35 46|23 38 47|23 45 52|23 51 61|23 53 65|23 57 63|"
sM3 = sM3 & "24 25 64|24 26 41|24 27 53|24 32 49|24 33 51|24 34 56|24 35 57|24 37 42|24 39 52|24 44 55|24 47 59|24 58 60|24 61 63|24 62 65|"
sM3 = sM3 & "25 31 49|25 32 47|25 33 39|25 36 52|25 37 44|25 38 62|25 40 65|25 41 66|25 45 58|25 46 53|25 51 54|25 55 61|25 56 60|"
sM3 = sM3 & "26 27 46|26 28 65|26 29 52|26 34 54|26 37 48|26 38 58|26 39 44|26 40 63|26 47 55|26 49 59|26 50 57|26 51 56|"
sM3 = sM3 & "27 28 56|27 29 63|27 32 60|27 34 57|27 35 38|27 39 64|27 40 54|27 42 48|27 43 66|27 49 50|27 51 58|27 52 61|"
sM3 = sM3 & "28 32 45|28 33 41|28 35 66|28 36 63|28 37 66|28 42 44|28 46 51|28 48 53|28 50 60|28 52 57|28 59 64|"
sM3 = sM3 & "29 31 56|29 33 60|29 34 41|29 35 47|29 36 38|29 39 50|29 43 61|29 44 48|29 46 55|29 49 54|29 51 64|29 57 59|"
sM3 = sM3 & "30 32 61|30 33 35|30 36 53|30 37 45|30 39 42|30 41 48|30 43 65|30 47 57|30 50 56|30 54 59|30 55 66|30 58 64|"
sM3 = sM3 & "31 33 34|31 36 64|31 37 55|31 38 57|31 39 48|31 40 46|31 43 51|31 44 61|31 53 62|31 58 66|"
sM3 = sM3 & "32 33 54|32 36 66|32 38 64|32 40 50|32 42 51|32 48 57|"
sM3 = sM3 & "33 36 49|33 37 38|33 40 52|33 43 44|33 47 56|33 53 63|33 53 66|33 61 65|33 62 64|"
sM3 = sM3 & "34 39 60|34 40 58|34 43 58|34 44 51|34 48 49|34 50 63|34 53 61|34 59 62|"
sM3 = sM3 & "35 36 43|35 42 58|35 44 53|35 45 64|35 50 65|35 54 62|35 59 61|"
sM3 = sM3 & "36 37 41|36 39 45|36 48 54|36 57 65|"
sM3 = sM3 & "37 43 62|37 46 57|37 47 50|37 51 59|37 53 56|37 54 58|"
sM3 = sM3 & "38 39 46|38 41 56|38 42 61|38 43 54|38 45 53|38 48 50|38 49 51|"
sM3 = sM3 & "39 40 56|39 41 47|39 43 55|39 54 57|39 58 63|39 59 66|"
sM3 = sM3 & "40 41 55|40 43 64|40 45 59|40 51 62|"
sM3 = sM3 & "41 42 60|41 43 59|41 45 65|41 46 49|41 48 63|41 50 53|"
sM3 = sM3 & "42 43 53|42 45 47|42 49 63|42 50 62|42 52 66|42 55 56|"
sM3 = sM3 & "43 45 49|43 46 50|43 47 60|43 63 64|"
sM3 = sM3 & "44 45 52|44 49 65|44 50 58|44 54 64|44 57 62|"
sM3 = sM3 & "45 46 54|45 60 62|"
sM3 = sM3 & "46 48 65|46 52 56|46 58 59|46 62 66|"
sM3 = sM3 & "47 49 61|47 51 65|47 52 63|47 53 54|"
sM3 = sM3 & "48 52 64|48 56 59|"
sM3 = sM3 & "49 55 60|"
sM3 = sM3 & "51 53 57|"
sM3 = sM3 & "52 53 60|52 58 62|"
sM3 = sM3 & "54 56 66|54 60 63|"
sM3 = sM3 & "55 57 58|55 59 65|"
sM3 = sM3 & "56 62 63|"
sM3 = sM3 & "57 64 66|"
sM3 = sM3 & "60 61 66|"
Call SostituisciEStampa(sM3,aNumeriBase,"SISTEMA GDP2: C(66,3,2) = 726 COMBINAZIONI DA 3 NUMERI (TERZINE)",sFileDestinazione)
End Sub'====================================================================================================
' SCRIPT SPAZIOSCRIPT PER SPAZIOMETRIA - VERSIONE TOTALMENTE ESPANSA
' RIDUZIONE AUTOMATICA A STEP CON INPUT IBRIDO: TABELLA O FILE TXT UNIVERSALE (N RIGHE)
' + SALVATAGGIO AUTOMATICO FORMAZIONI IN CORSO CON FILTRO COLPI RIMANENTI E RANGE CLASSI
' CON INDICAZIONE DELLA CLASSE SVILUPPATA SU OGNI RIGA DI OUTPUT
'====================================================================================================
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 fileformazioniincorsofiltrate
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
Dim nColpiRimMaxFiltro
Dim nClasseExportMin
Dim nClasseExportMax
Dim nTotFormazioniSalvate
Dim aMemoriaFormazioniSalvate()
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"
fileformazioniincorsofiltrate = sDirAppData & "formazioni_in_corso_filtrate.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
If FileEsistente(fileformazioniincorsofiltrate) Then
Call EliminaFile(fileformazioniincorsofiltrate)
End If
nTotFormazioniSalvate = 0
ReDim aMemoriaFormazioniSalvate(0)
Dim tabellaofile
tabellaofile = InputBox("Elaborazione da Tabella (t) o da File TXT (f)?",,"t")
Dim aElencoGruppi()
Dim nTotGruppi
nTotGruppi = 0
ReDim aElencoGruppi(0)
If LCase(tabellaofile) = "t" Then
Dim numeriSel
ReDim numeriSel(0)
Call ScegliNumeri(numeriSel)
If UBound(numeriSel) < 1 Then
Exit Sub
End If
nTotGruppi = 1
ReDim aElencoGruppi(1)
aElencoGruppi(1) = numeriSel
Else
Dim sFileTXT,aRigheTXT,r,aNumEstratti,nQNumRilevati
sFileTXT = ScegliFile(GetDirectoryAppData,"txt","Seleziona File Matrice TXT Formazioni")
If sFileTXT = "" Or Not FileEsistente(sFileTXT) Then
Call MsgBox("Nessun file selezionato o file non valido.")
Exit Sub
End If
Call LeggiRigheFileDiTesto(sFileTXT,aRigheTXT)
For r = 0 To UBound(aRigheTXT)
If Trim(aRigheTXT(r)) <> "" Then
nQNumRilevati = EstraiNumeriDaStringa(aRigheTXT(r),aNumEstratti)
If nQNumRilevati > 0 Then
nTotGruppi = nTotGruppi + 1
ReDim Preserve aElencoGruppi(nTotGruppi)
aElencoGruppi(nTotGruppi) = aNumEstratti
End If
End If
Next
If nTotGruppi = 0 Then
Call MsgBox("Nessuna formazione numerica valida rilevata nel file TXT.")
Exit Sub
End If
Scrivi "Caricate " & nTotGruppi & " formazioni numeriche dal file TXT: " & sFileTXT
Scrivi
End If
Dim ClasseFinaleVoluta,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
' SOGLIA COLPI RIMANENTI PER ESPORTARE LE FORMAZIONI IN CORSO
nColpiRimMaxFiltro = CInt(InputBox("Filtro Casi In Corso: Salva su TXT le formazioni con Colpi Rimanenti <= a:",,1))
' FILTRO CLASSI DA SALVARE NEL FILE TXT
Dim nClInput1,nClInput2
nClInput1 = CInt(InputBox("Filtro Export TXT: Salva formazioni con Classe da (es. 69):",,ClasseFinaleVoluta))
nClInput2 = CInt(InputBox("Filtro Export TXT: Salva formazioni con Classe a (es. 69):",,nClInput1))
If nClInput1 <= nClInput2 Then
nClasseExportMin = nClInput1
nClasseExportMax = nClInput2
Else
nClasseExportMin = nClInput2
nClasseExportMax = nClInput1
End If
Dim quanteruoteuniteminimo,quanteruoteunite,quanteposizioniuniteminimo,quanteposizioniunitemassimo
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))
Dim vuoiapplicarefiltro,filtroattivato
Dim diffpvolutaminima,diffpvolutamassima,diffincmaxposizionaleminima,diffincmaxposizionalemassima
Dim Incmaxposizionalevolutominimo,Incmaxposizionalevolutomassimo
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
Dim Inizio,fine
Inizio = EstrazioneIni
fine = EstrazioneFin
Dim sortediverifica,colpidiverifica,percentualepositiva,inizioverifica,fineverifica,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")
Dim ruotescelte,qualiruote,aposizioni
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))
Dim aCombPosizioni(),nTotCombPos,aCombRuote(),nTotCombRuote,aColTmp,Classeposizionale,numeroruoteunite
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
Dim nStartEstr
If inizioverifica > 0 Then
nStartEstr = fineverifica - inizioverifica
Else
nStartEstr = fineverifica
End If
Dim idGruppo,numeri,rit,ritmax,Incmax,freq,diffposizionale,estrazioneprogressiva,coltotok,conta,h,w,y,anumeriok
For idGruppo = 1 To nTotGruppi
numeri = aElencoGruppi(idGruppo)
Scrivi
Scrivi "=========================================================================="
Scrivi " AVVIO RIDUZIONE GRUPPO " & idGruppo & " DI " & nTotGruppi & " (Origine: " & UCase(tabellaofile) & ")"
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 "Filtro Export TXT : Formazioni In Corso con Colpi Rim <= " & nColpiRimMaxFiltro & " e Classe da " & nClasseExportMin & " a " & nClasseExportMax
Scrivi "=========================================================================="
Scrivi
If UBound(numeri) <= ClasseFinaleVoluta Then
Scrivi "<font color=red>La formazione iniziale ha già classe <= desiderata. Passaggio al successivo.</font>"
Else
Dim ClasseCorrente,BestLunghetta,BestLunghettaRiserva,MinColpiRimStep
Dim BestRitStep,BestRitMaxStep,BestFreqStep,BestRuoteStep,BestPosStep,sCriterioElezionePrimario
Dim MinDiffPosRiserva,BestRitRiserva,BestRitMaxRiserva,BestFreqRiserva,BestRuoteRiserva,BestPosRiserva,sCriterioElezioneRiserva
Dim RuoteFinaliRilevate,PosizioniFinaliRilevate,BestTrovataInStep,TrovataRiserva,nEsitoTipo,csvil,nCicloStep,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 "GRUPPO " & idGruppo & "/" & nTotGruppi & " | STEP " & nCicloStep & ": Riduzione da Classe " & ClasseCorrente & " a Classe " & ProssimaClasse
Scrivi "Gruppo Base di Partenza: " & StringaNumeri(numeri) & " (Classe " & ClasseCorrente & ")"
Scrivi "--------------------------------------------------------------------------"
MinColpiRimStep = 999999
BestRitStep = - 1
BestRitMaxStep = 999999
BestFreqStep = - 1
BestRuoteStep = ""
BestPosStep = ""
sCriterioElezionePrimario = ""
MinDiffPosRiserva = 999999
BestRitRiserva = - 1
BestRitMaxRiserva = 999999
BestFreqRiserva = - 1
BestRuoteRiserva = ""
BestPosRiserva = ""
sCriterioElezioneRiserva = ""
BestTrovataInStep = False
TrovataRiserva = False
' 1. Scansione storica
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("Grp " & idGruppo & "/" & nTotGruppi & " | 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)
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
BestRuoteStep = StringaRuote(aCombRuote(w))
BestPosStep = StringaNumeri(aCombPosizioni(y))
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
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
BestRuoteRiserva = StringaRuote(aCombRuote(w))
BestPosRiserva = StringaNumeri(aCombPosizioni(y))
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
RuoteFinaliRilevate = BestRuoteStep
PosizioniFinaliRilevate = BestPosStep
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 " Ruota/e: " & BestRuoteStep & " | Posizione/i: " & BestPosStep
Scrivi " Parametri: Classe: " & ClasseCorrente & " | 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
RuoteFinaliRilevate = BestRuoteRiserva
PosizioniFinaliRilevate = BestPosRiserva
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 " Ruota/e: " & BestRuoteRiserva & " | Posizione/i: " & BestPosRiserva
Scrivi " Parametri: Classe: " & ClasseCorrente & " | RA: " & BestRitRiserva & " | RS: " & BestRitMaxRiserva & " | Diff (RS-RA): " & MinDiffPosRiserva & " | Freq: " & BestFreqRiserva
Scrivi
Else
Scrivi "<font color=red>Nessuna combinazione rilevata in questo step per il Gruppo " & idGruppo & ". Interruzione del ciclo.</font>"
Exit Do
End If
If ScriptInterrotto Then
Exit Do
End If
Loop
Scrivi "--------------------------------------------------------------------------"
Scrivi "<font color=green size=3><strong>ESITO FINALE GRUPPO " & idGruppo & ": " & StringaNumeri(numeri) & " (Classe " & UBound(numeri) & ")</strong></font>"
Scrivi "<font color=blue>Ruota/e di caduta: " & RuoteFinaliRilevate & " | Posizione/i di caduta: " & PosizioniFinaliRilevate & " | Classe Finale: " & UBound(numeri) & "</font>"
Scrivi "--------------------------------------------------------------------------"
Scrivi
End If
If ScriptInterrotto Then
Exit For
End If
Next
Dim nTotCasiRilevati,percPositiviConclusi,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 GLOBALE "
Scrivi "=========================================================================="
Scrivi "Totale Formazioni/Righe Elaborate : " & nTotGruppi
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 "--------------------------------------------------------------------------"
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 "--------------------------------------------------------------------------"
Scrivi "Filtro Export TXT Classi Rimanenti salvate : da Classe " & nClasseExportMin & " a Classe " & nClasseExportMax
Scrivi "Formazioni In Corso salvate con Colpi Rim <= " & nColpiRimMaxFiltro & " : " & nTotFormazioniSalvate
Scrivi "File TXT Generato : " & fileformazioniincorsofiltrate
Scrivi "=========================================================================="
End Sub
Function disegnagraficoincmaxposizionale(anum,apos,aruo,diffposizionale,estrazioneprogressiva,sortediverifica,colpidiverifica,diffincmaxposizionaleminima,diffincmaxposizionalemassima,inizioverifica,fineverifica,sortediricerca,filtroattivato)
Dim clsl,schrsep,inizio,fine,sorte,aposizione,aruote,nClFormazione
aposizione = apos
aruote = aruo
schrsep = "."
inizio = EstrazioneIni
fine = estrazioneprogressiva
nClFormazione = UBound(anum)
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,vettorexallincmax,incmaxstoricoeffettivo,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 (Classe " & nClFormazione & ")",True,,vbRed,vbWhite,4)
Call Scrivi("Ruota/e: " & StringaRuote(aruote) & " | Posizione/i: " & StringaNumeri(aposizione) & " | Classe: " & nClFormazione,True,,vbBlue,vbWhite,3)
Call Scrivi("<font color=purple><strong>Data Rilevamento Condizione: " & sInfoEstrRilevamento & " | Formazione di Classe " & nClFormazione & "</strong></font>",True)
Call Scrivi("Formazione: " & clsl.lunghettastring & " (Classe " & nClFormazione & ")",True,,,,2)
Call Scrivi("Ritardo Attuale: " & clsl.ritardo & " | Ritardo Max: " & clsl.ritardomax & " | Frequenza: " & clsl.frequenza & " | Classe: " & nClFormazione,True)
Call Scrivi("IncMax Attuale: " & clsl.incrritmax & " | IncMax Storico: " & incmaxstoricoeffettivo,True)
Call Scrivi("Diff IncMax Posizionale: " & diffincmaxposizionale & " | Classe Formazione: " & nClFormazione)
Scrivi
Call VerificaEsitoTurbo(anum,aruote,estrazioneprogressiva + 1,sortediverifica,colpidiverifica,,esitoverifica,alcolponumero,verificaestratti)
Dim idEstrazioneSfaldamento,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 (Classe " & nClFormazione & "): " & verificaestratti & " al colpo " & alcolponumero & " (Colpo Max Storico Rilevato: " & colpomassimo & ")</strong></font>"
Scrivi "<font color=green>Data Sfaldamento: " & sInfoEstrSfaldamento & " | Classe: " & nClFormazione & "</font>"
Scrivi
Call ScriviFile(filesolonumeridoc,sInfoEstrRilevamento & " | (Classe " & nClFormazione & ") " & 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 (Classe " & nClFormazione & ")</strong></font>"
Scrivi
disegnagraficoincmaxposizionale = 0
Exit Function
Else
casiattuali = casiattuali + 1
Scrivi "<font color=orange size=3><strong>IN CORSO (Ca) - (Classe " & nClFormazione & ")</strong></font>"
Scrivi "Colpi rimanenti teorici rispetto colpi di verifica: " & colpirimanentirispettocolpidiverifica & " (Classe " & nClFormazione & ")"
If colpomassimo > 0 Then
colpirimanentirispettocolpomassimo = colpomassimo -(fineverifica - estrazioneprogressiva)
ultimorestocasiincorso = colpirimanentirispettocolpomassimo
Scrivi "Colpi rimanenti teorici rispetto colpo massimo: " & colpirimanentirispettocolpomassimo & " (Classe " & nClFormazione & ")"
Else
colpirimanentirispettocolpomassimo = colpidiverifica -(fineverifica - estrazioneprogressiva)
ultimorestocasiincorso = colpirimanentirispettocolpomassimo
Scrivi "Colpi rimanenti teorici (in attesa di primo colpo max storico): " & colpirimanentirispettocolpomassimo & " (Classe " & nClFormazione & ")"
End If
Scrivi
' =======================================================================
' SALVATAGGIO IN FILE TXT SE COLPI RIMANENTI <= SOGLIA IMPOSTATA E CLASSE NEL RANGE
' =======================================================================
If ultimorestocasiincorso <= nColpiRimMaxFiltro Then
If nClFormazione >= nClasseExportMin And nClFormazione <= nClasseExportMax Then
Call SalvaFormazioneSola(fileformazioniincorsofiltrate,clsl.lunghettastring)
End If
End If
' =======================================================================
disegnagraficoincmaxposizionale = 2
Exit Function
End If
End If
End If
End If
disegnagraficoincmaxposizionale = 0
End Function
Sub SalvaFormazioneSola(sFile,sLunghettaNumeri)
Dim k,bPresente
bPresente = False
For k = 1 To nTotFormazioniSalvate
If aMemoriaFormazioniSalvate(k) = sLunghettaNumeri Then
bPresente = True
Exit For
End If
Next
If Not bPresente Then
nTotFormazioniSalvate = nTotFormazioniSalvate + 1
ReDim Preserve aMemoriaFormazioniSalvate(nTotFormazioniSalvate)
aMemoriaFormazioniSalvate(nTotFormazioniSalvate) = sLunghettaNumeri
Call ScriviFile(sFile,sLunghettaNumeri)
Call CloseFileHandle(sFile)
End If
End Sub
Function EstraiNumeriDaStringa(sRiga,aNumOut)
Dim sCar,sNum,k,nVal,q
sNum = ""
q = 0
Dim aPresenze(90)
For k = 1 To 90
aPresenze(k) = 0
Next
Dim aTutti()
ReDim aTutti(0)
For k = 1 To Len(sRiga)
sCar = Mid(sRiga,k,1)
If IsNumeric(sCar) Then
sNum = sNum & sCar
Else
If Len(sNum) > 0 Then
nVal = CInt(sNum)
If nVal >= 1 And nVal <= 90 Then
If aPresenze(nVal) = 0 Then
aPresenze(nVal) = 1
q = q + 1
ReDim Preserve aTutti(q)
aTutti(q) = nVal
End If
End If
sNum = ""
End If
End If
Next
If Len(sNum) > 0 Then
nVal = CInt(sNum)
If nVal >= 1 And nVal <= 90 Then
If aPresenze(nVal) = 0 Then
aPresenze(nVal) = 1
q = q + 1
ReDim Preserve aTutti(q)
aTutti(q) = nVal
End If
End If
End If
aNumOut = aTutti
EstraiNumeriDaStringa = q
End Function'SpazioScript - Analizzatore Combinazioni con Rolling Backtest, Analisi Ipergeometrica, Riduzione, Quadranti Dinamici & Matrici GDP2
'Versione v2.7 (Export 12 File TXT Puliti sul Desktop & Sintassi Espansa Anti-1012)
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
' Variabili per le 8 righe export con nomi distinti
Dim sExp_QFM
Dim sExp_Qfm_min
Dim sExp_QRM
Dim sExp_Qrm_min
Dim sExp_Conv1
Dim sExp_Conv2
Dim sExp_Conv3
Dim sExp_Conv4
' Variabili per i file TXT
Dim fso
Dim fFile
Dim sNomeFile
Dim sPercorsoDesktop
Dim WshShell
' 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"
'Caricamento dei 29 fissi
'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"
' --- 1. SELEZIONE INTERATTIVA BLOCCO NUMERI FISSI ---
Dim aVociFissi(2)
Dim nSceltaFissi
aVociFissi(0) = "Blocco 1: 33 Fissi Standard"
aVociFissi(1) = "Blocco 2: 29 Fissi Ridotti (absc29)"
aVociFissi(2) = "Blocco 3: Inserimento Manuale a Video"
nSceltaFissi = ScegliOpzioneMenu(aVociFissi,0,"SCEGLI IL BLOCCO DI NUMERI FISSI:")
If nSceltaFissi = 0 Then
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"
Else
If nSceltaFissi = 1 Then
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"
Else
sFissiTemp = InputBox("Inserisci i numeri fissi separati da punto:","Numeri Fissi Manuali","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")
End If
End If
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
' --- 2. RICHIESTA DINAMICI (Propone in automatico i numeri per completare la 66ina!) ---
Dim nDinamiciDefault
nDinamiciDefault = 66 - nFissi
If nDinamiciDefault < 1 Then
nDinamiciDefault = 33
End If
nDinamici = CInt(InputBox("Quanti numeri DINAMICI vuoi aggiungere ai " & nFissi & " fissi? (Default per fare 66: " & nDinamiciDefault & ")","Num Dinamici",nDinamiciDefault))
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
' --- SELEZIONE INTERATTIVA BACINO POOL DINAMICI ---
Dim aVociPool(1)
Dim nSceltaPool
Dim sPoolCustom
Dim aPoolCustomString
Dim nTotBacino
aVociPool(0) = "Tutti i 90 numeri (Standard)"
aVociPool(1) = "Bacino Personalizzato (Lunghetta da stringa)"
nSceltaPool = ScegliOpzioneMenu(aVociPool,0,"DA QUALE BACINO PESCARE I DINAMICI?")
c = 0
If nSceltaPool = 0 Then
nPoolSize = 90 - nFissi
ReDim aPool(nPoolSize)
For i = 1 To 90
If Not aSfissi(i) Then
c = c + 1
aPool(c) = i
End If
Next
Else
sPoolCustom = InputBox("Inserisci la lunghetta dei numeri da cui pescare i dinamici:","Bacino Personalizzato","1.2.3.4.5.6.7.8.9.10.11.12.13.14.15.16.17.18.19.20.21.22.23.24.25.26.27.28.29.30")
aPoolCustomString = Split(sPoolCustom,".")
nTotBacino = UBound(aPoolCustomString) + 1
ReDim aPool(nTotBacino)
For i = 1 To nTotBacino
If Not aSfissi(CInt(aPoolCustomString(i - 1))) Then
c = c + 1
aPool(c) = CInt(aPoolCustomString(i - 1))
End If
Next
nPoolSize = c
ReDim Preserve aPool(nPoolSize)
End If
' 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("")
' ==================================================================
' --- 1) BLOCCO EXPORT 8 RIGHE (SOLO NUMERI SEPARATI DA PUNTO) ---
' ==================================================================
sExp_QFM = StringaNumeri(aListQFM,".")
sExp_Qfm_min = StringaNumeri(aListQfm_min,".")
sExp_QRM = StringaNumeri(aListQRM,".")
sExp_Qrm_min = StringaNumeri(aListQrm_min,".")
sExp_Conv1 = StringaNumeri(aConv1,".")
sExp_Conv2 = StringaNumeri(aConv2,".")
sExp_Conv3 = StringaNumeri(aConv3,".")
sExp_Conv4 = StringaNumeri(aConv4,".")
Call Scrivi("==========================================================================================",True)
Call Scrivi(" BLOCCO EXPORT 8 RIGHE (SOLO NUMERI SEPARATI DA PUNTO - FACILE DA COPIARE)",True)
Call Scrivi("==========================================================================================",True)
Call Scrivi(sExp_QFM)
Call Scrivi(sExp_Qfm_min)
Call Scrivi(sExp_QRM)
Call Scrivi(sExp_Qrm_min)
Call Scrivi(sExp_Conv1)
Call Scrivi(sExp_Conv2)
Call Scrivi(sExp_Conv3)
Call Scrivi(sExp_Conv4)
Call Scrivi("==========================================================================================")
Call Scrivi("")
' ==================================================================
' --- ESPORTAZIONE DEI 12 FILE TXT PULITI (SOLO NUMERI) SUL DESKTOP ---
' ==================================================================
Set WshShell = CreateObject("WScript.Shell")
sPercorsoDesktop = WshShell.SpecialFolders("Desktop") & "\"
Set WshShell = Nothing
Set fso = CreateObject("Scripting.FileSystemObject")
' --- FILE 1: 8 RIGHE (4 QUADRANTI + 4 CONVERGENTI) ---
sNomeFile = sPercorsoDesktop & "01_Quadranti_8Righe_" & SiglaRuota(nRuota) & "_Estr_" & nFine & ".txt"
On Error Resume Next
Set fFile = fso.CreateTextFile(sNomeFile,True)
If Err.Number = 0 Then
fFile.WriteLine(sExp_QFM)
fFile.WriteLine(sExp_Qfm_min)
fFile.WriteLine(sExp_QRM)
fFile.WriteLine(sExp_Qrm_min)
fFile.WriteLine(sExp_Conv1)
fFile.WriteLine(sExp_Conv2)
fFile.WriteLine(sExp_Conv3)
fFile.WriteLine(sExp_Conv4)
fFile.Close
Call Scrivi(" -> [01] File 8 Righe salvato: " & sNomeFile,True)
End If
On Error GoTo 0
' --- FILE 6: TUTTI I 4 QUADRANTI INSIEME (4 RIGHE DA 33 NUMERI) ---
sNomeFile = sPercorsoDesktop & "06_Quadranti_Tutti4_" & SiglaRuota(nRuota) & "_Estr_" & nFine & ".txt"
On Error Resume Next
Set fFile = fso.CreateTextFile(sNomeFile,True)
If Err.Number = 0 Then
fFile.WriteLine(sExp_QFM)
fFile.WriteLine(sExp_Qfm_min)
fFile.WriteLine(sExp_QRM)
fFile.WriteLine(sExp_Qrm_min)
fFile.Close
Call Scrivi(" -> [06] File 4 Quadranti Insieme salvato: " & sNomeFile,True)
End If
On Error GoTo 0
' --- FILE 7: COPPIA QUADRANTI FREQUENZA (2 RIGHE: QFM e Qfm) ---
sNomeFile = sPercorsoDesktop & "07_Quadranti_Frequenza_QFM_Qfm_" & SiglaRuota(nRuota) & "_Estr_" & nFine & ".txt"
On Error Resume Next
Set fFile = fso.CreateTextFile(sNomeFile,True)
If Err.Number = 0 Then
fFile.WriteLine(sExp_QFM)
fFile.WriteLine(sExp_Qfm_min)
fFile.Close
Call Scrivi(" -> [07] File Quadranti Frequenza (2 righe) salvato: " & sNomeFile,True)
End If
On Error GoTo 0
' --- FILE 8: COPPIA QUADRANTI RITARDO (2 RIGHE: QRM e Qrm) ---
sNomeFile = sPercorsoDesktop & "08_Quadranti_Ritardo_QRM_Qrm_" & SiglaRuota(nRuota) & "_Estr_" & nFine & ".txt"
On Error Resume Next
Set fFile = fso.CreateTextFile(sNomeFile,True)
If Err.Number = 0 Then
fFile.WriteLine(sExp_QRM)
fFile.WriteLine(sExp_Qrm_min)
fFile.Close
Call Scrivi(" -> [08] File Quadranti Ritardo (2 righe) salvato: " & sNomeFile,True)
End If
On Error GoTo 0
' --- FILE 9: QUADRANTE SINGOLO QFM (1 RIGA DA 33 NUMERI) ---
sNomeFile = sPercorsoDesktop & "09_Quadrante_Singolo_QFM_" & SiglaRuota(nRuota) & "_Estr_" & nFine & ".txt"
On Error Resume Next
Set fFile = fso.CreateTextFile(sNomeFile,True)
If Err.Number = 0 Then
fFile.WriteLine(sExp_QFM)
fFile.Close
Call Scrivi(" -> [09] File Quadrante Singolo QFM salvato: " & sNomeFile,True)
End If
On Error GoTo 0
' --- FILE 10: QUADRANTE SINGOLO Qfm (1 RIGA DA 33 NUMERI) ---
sNomeFile = sPercorsoDesktop & "10_Quadrante_Singolo_Qfm_" & SiglaRuota(nRuota) & "_Estr_" & nFine & ".txt"
On Error Resume Next
Set fFile = fso.CreateTextFile(sNomeFile,True)
If Err.Number = 0 Then
fFile.WriteLine(sExp_Qfm_min)
fFile.Close
Call Scrivi(" -> [10] File Quadrante Singolo Qfm salvato: " & sNomeFile,True)
End If
On Error GoTo 0
' --- FILE 11: QUADRANTE SINGOLO QRM (1 RIGA DA 33 NUMERI) ---
sNomeFile = sPercorsoDesktop & "11_Quadrante_Singolo_QRM_" & SiglaRuota(nRuota) & "_Estr_" & nFine & ".txt"
On Error Resume Next
Set fFile = fso.CreateTextFile(sNomeFile,True)
If Err.Number = 0 Then
fFile.WriteLine(sExp_QRM)
fFile.Close
Call Scrivi(" -> [11] File Quadrante Singolo QRM salvato: " & sNomeFile,True)
End If
On Error GoTo 0
' --- FILE 12: QUADRANTE SINGOLO Qrm (1 RIGA DA 33 NUMERI) ---
sNomeFile = sPercorsoDesktop & "12_Quadrante_Singolo_Qrm_" & SiglaRuota(nRuota) & "_Estr_" & nFine & ".txt"
On Error Resume Next
Set fFile = fso.CreateTextFile(sNomeFile,True)
If Err.Number = 0 Then
fFile.WriteLine(sExp_Qrm_min)
fFile.Close
Call Scrivi(" -> [12] File Quadrante Singolo Qrm salvato: " & sNomeFile,True)
End If
On Error GoTo 0
' --- SISTEMIZZAZIONE E SALVATAGGIO DEI 4 FILE MATRICI GDP2 (FILES 02..05) ---
If nTotR1 = 66 Then
Call Scrivi("==========================================================================================",True)
Call Scrivi(" FASE 6: GENERAZIONE E SALVATAGGIO DEI 4 FILE MATRICI GDP2 SUL DESKTOP",True)
Call Scrivi("==========================================================================================",True)
' MATRICE 22 (13 colonne)
sNomeFile = sPercorsoDesktop & "02_Matrice_C66_22_13colonne_" & SiglaRuota(nRuota) & "_Estr_" & nFine & ".txt"
Call SviluppaMatrice22(aMiglioreComboDiOggi,sNomeFile)
' MATRICE 11 (48 colonne)
sNomeFile = sPercorsoDesktop & "03_Matrice_C66_11_48colonne_" & SiglaRuota(nRuota) & "_Estr_" & nFine & ".txt"
Call SviluppaMatrice11(aMiglioreComboDiOggi,sNomeFile)
' MATRICE 6 (143 colonne)
sNomeFile = sPercorsoDesktop & "04_Matrice_C66_6_143colonne_" & SiglaRuota(nRuota) & "_Estr_" & nFine & ".txt"
Call SviluppaMatrice6(aMiglioreComboDiOggi,sNomeFile)
' MATRICE 3 (726 terzine)
sNomeFile = sPercorsoDesktop & "05_Matrice_C66_3_726terzine_" & SiglaRuota(nRuota) & "_Estr_" & nFine & ".txt"
Call SviluppaMatrice3(aMiglioreComboDiOggi,sNomeFile)
Call Scrivi("")
Call Scrivi("? TUTTI I 12 FILE TXT PULITI SONO STATI GENERATI SUL DESKTOP!",True)
Call Scrivi("==========================================================================================",True)
Call Scrivi("")
Else
Call Scrivi("Attenzione: La combinazione Rank 1 contiene " & nTotR1 & " numeri (necessari 66 per le matrici).")
End If
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.7",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
' ==================================================================
' SUB AUSILIARIE DI GENERAZIONE FILE TXT PULITI (SOLO NUMERI)
' ==================================================================
Sub SostituisciEStampa(sBloccoRighe,aNumeriBase,sTitolo,sFileDestinazione)
Dim aRighe
Dim aIndici
Dim aComboRisultante
Dim rigaIdx
Dim elemIdx
Dim sRigaOut
Dim nIndicePos
Dim fsoSub
Dim fFileSub
Dim bSubFileOk
bSubFileOk = False
On Error Resume Next
Set fsoSub = CreateObject("Scripting.FileSystemObject")
Set fFileSub = fsoSub.CreateTextFile(sFileDestinazione,True)
If Err.Number = 0 Then
bSubFileOk = True
End If
On Error GoTo 0
Call Scrivi("--- " & sTitolo & " ---",True)
aRighe = Split(sBloccoRighe,"|")
For rigaIdx = 0 To UBound(aRighe)
If Trim(aRighe(rigaIdx)) <> "" Then
aIndici = Split(Trim(aRighe(rigaIdx))," ")
ReDim aComboRisultante(UBound(aIndici) + 1)
For elemIdx = 0 To UBound(aIndici)
nIndicePos = CInt(aIndici(elemIdx))
aComboRisultante(elemIdx + 1) = aNumeriBase(nIndicePos)
Next
Call OrdinaMatrice(aComboRisultante,1)
sRigaOut = StringaNumeri(aComboRisultante,".")
Call Scrivi(sRigaOut)
If bSubFileOk Then
fFileSub.WriteLine(sRigaOut)
End If
End If
Next
If bSubFileOk Then
fFileSub.Close
Set fFileSub = Nothing
Set fsoSub = Nothing
Call Scrivi(" -> File salvato: " & sFileDestinazione,True)
End If
Call Scrivi("")
End Sub
Sub SviluppaMatrice22(aNumeriBase,sFileDestinazione)
Dim sM22
sM22 = ""
sM22 = sM22 & "1 2 3 4 10 15 17 18 19 21 32 34 35 36 37 43 48 50 51 52 54 65|"
sM22 = sM22 & "1 4 5 11 12 15 18 20 23 24 33 34 37 38 44 45 48 51 53 56 57 66|"
sM22 = sM22 & "1 4 6 16 18 22 25 26 29 30 31 34 37 39 49 51 55 58 59 62 63 64|"
sM22 = sM22 & "1 4 7 8 9 13 14 18 19 27 28 34 37 40 41 42 46 47 51 52 60 61|"
sM22 = sM22 & "2 3 6 8 10 17 20 21 25 28 30 35 36 39 41 43 50 53 54 58 61 63|"
sM22 = sM22 & "2 5 9 13 14 17 21 24 26 29 33 35 38 42 46 47 50 54 57 59 62 66|"
sM22 = sM22 & "2 7 11 12 16 17 21 22 23 27 31 35 40 44 45 49 50 54 55 56 60 64|"
sM22 = sM22 & "3 5 8 10 16 19 22 24 28 31 33 36 38 41 43 49 52 55 57 61 64 66|"
sM22 = sM22 & "3 7 10 14 19 20 25 26 27 29 30 36 40 43 47 52 53 58 59 60 62 63|"
sM22 = sM22 & "3 9 10 11 12 13 14 15 23 25 30 36 42 43 44 45 46 47 48 56 58 63|"
sM22 = sM22 & "5 6 7 13 15 24 25 27 30 32 33 38 39 40 46 48 57 58 60 63 65 66|"
sM22 = sM22 & "6 8 11 12 15 19 23 26 28 29 32 39 41 44 45 48 52 56 59 61 62 65|"
sM22 = sM22 & "6 9 10 13 14 15 16 20 22 31 32 39 42 43 46 47 48 49 53 55 64 65|"
Call SostituisciEStampa(sM22,aNumeriBase,"SISTEMA GDP2: C(66,22,2) = 13 COMBINAZIONI DA 22 NUMERI",sFileDestinazione)
End Sub
Sub SviluppaMatrice11(aNumeriBase,sFileDestinazione)
Dim sM11
sM11 = ""
sM11 = sM11 & "1 2 13 17 23 35 40 41 47 54 63|"
sM11 = sM11 & "1 3 11 12 30 32 33 34 48 50 54|"
sM11 = sM11 & "1 4 6 22 24 37 45 53 54 57 65|"
sM11 = sM11 & "1 5 14 19 28 33 35 54 59 60 61|"
sM11 = sM11 & "1 7 16 21 27 43 49 54 56 62 66|"
sM11 = sM11 & "1 8 18 20 25 31 36 46 54 59 64|"
sM11 = sM11 & "1 9 10 14 26 38 39 42 52 54 58|"
sM11 = sM11 & "1 15 17 23 29 35 44 51 54 55 62|"
sM11 = sM11 & "2 3 7 14 22 32 37 41 42 49 63|"
sM11 = sM11 & "2 4 11 18 26 41 45 46 50 52 63|"
sM11 = sM11 & "2 5 15 19 28 29 41 44 51 55 63|"
sM11 = sM11 & "2 6 21 25 33 36 41 43 48 53 63|"
sM11 = sM11 & "2 8 9 12 16 27 31 34 39 41 63|"
sM11 = sM11 & "2 10 20 24 38 41 56 63 64 65 66|"
sM11 = sM11 & "2 17 30 41 57 58 59 60 61 62 63|"
sM11 = sM11 & "3 4 16 20 23 27 32 40 45 60 64|"
sM11 = sM11 & "3 5 13 19 24 28 40 45 48 50 62|"
sM11 = sM11 & "3 6 8 31 32 44 53 55 56 58 66|"
sM11 = sM11 & "3 8 13 15 26 31 32 47 51 52 57|"
sM11 = sM11 & "3 9 24 25 29 32 36 39 61 62 65|"
sM11 = sM11 & "3 10 17 18 21 32 35 38 43 46 59|"
sM11 = sM11 & "4 5 11 18 19 26 28 46 47 52 62|"
sM11 = sM11 & "4 7 12 15 29 34 45 49 51 58 59|"
sM11 = sM11 & "4 8 14 21 23 31 40 42 43 45 61|"
sM11 = sM11 & "4 9 17 33 35 39 45 48 56 57 66|"
sM11 = sM11 & "4 10 13 25 30 36 38 44 45 47 55|"
sM11 = sM11 & "5 6 19 27 28 36 42 53 56 58 64|"
sM11 = sM11 & "5 7 12 19 23 28 30 34 37 43 66|"
sM11 = sM11 & "5 8 10 16 19 21 22 28 31 32 57|"
sM11 = sM11 & "5 9 17 19 20 25 28 38 39 49 65|"
sM11 = sM11 & "6 7 9 13 18 39 46 47 49 53 60|"
sM11 = sM11 & "6 10 11 15 16 27 38 50 51 53 61|"
sM11 = sM11 & "6 12 14 17 20 34 35 42 53 62 64|"
sM11 = sM11 & "6 23 26 29 30 40 52 53 56 59 66|"
sM11 = sM11 & "7 8 11 17 24 30 31 35 49 50 65|"
sM11 = sM11 & "7 10 12 23 25 34 36 38 40 49 57|"
sM11 = sM11 & "7 20 26 33 44 48 49 52 55 61 64|"
sM11 = sM11 & "8 10 22 29 31 33 37 38 48 60 62|"
sM11 = sM11 & "9 11 22 23 37 39 40 44 50 55 59|"
sM11 = sM11 & "9 15 20 21 22 30 37 39 43 51 64|"
sM11 = sM11 & "11 13 20 21 29 43 47 50 57 58 64|"
sM11 = sM11 & "11 14 15 25 36 42 50 51 56 60 66|"
sM11 = sM11 & "12 13 18 22 34 37 46 47 56 61 66|"
sM11 = sM11 & "12 21 24 26 34 43 44 52 55 60 65|"
sM11 = sM11 & "13 14 16 24 27 33 42 47 48 59 65|"
sM11 = sM11 & "14 16 18 27 29 30 42 44 46 55 57|"
sM11 = sM11 & "15 18 23 24 33 40 46 48 51 58 65|"
sM11 = sM11 & "16 17 22 25 26 27 35 36 37 52 58|"
Call SostituisciEStampa(sM11,aNumeriBase,"SISTEMA GDP2: C(66,11,2) = 48 COMBINAZIONI DA 11 NUMERI",sFileDestinazione)
End Sub
Sub SviluppaMatrice6(aNumeriBase,sFileDestinazione)
Dim sM6
sM6 = ""
sM6 = sM6 & "1 2 3 4 5 66|1 6 25 26 40 58|1 7 28 39 45 56|1 8 27 34 50 57|1 9 22 44 51 62|1 10 30 32 42 47|"
sM6 = sM6 & "1 11 17 38 49 55|1 12 16 24 37 59|1 13 18 36 54 64|1 14 23 52 60 63|1 15 33 41 46 65|1 19 29 31 43 48|"
sM6 = sM6 & "1 20 21 35 53 61|2 6 14 27 49 56|2 7 26 35 55 57|2 8 15 20 28 58|2 9 25 32 41 48|2 10 13 16 29 38|"
sM6 = sM6 & "2 11 18 37 44 60|2 12 17 36 45 65|2 19 22 53 59 63|2 21 30 50 52 62|2 23 34 40 51 61|2 24 31 42 46 54|"
sM6 = sM6 & "2 33 39 43 47 64|3 6 19 28 57 65|3 7 24 27 58 64|3 8 26 44 54 56|3 9 13 17 34 37|3 10 15 23 53 62|"
sM6 = sM6 & "3 11 16 35 36 50|3 12 18 25 30 38|3 14 20 31 41 47|3 21 39 49 51 63|3 22 29 45 52 61|3 32 40 43 46 59|"
sM6 = sM6 & "3 33 42 48 55 60|4 6 18 23 41 59|4 7 38 44 48 52|4 8 12 29 32 63|4 9 30 40 54 65|4 10 21 31 37 58|"
sM6 = sM6 & "4 11 22 26 34 47|4 13 42 50 53 56|4 14 16 28 33 51|4 15 19 24 45 55|4 17 39 46 57 61|4 20 27 36 43 62|"
sM6 = sM6 & "4 25 35 49 60 64|5 6 20 38 46 51|5 7 17 22 41 50|5 8 11 24 33 62|5 9 14 35 45 59|5 10 18 48 57 63|"
sM6 = sM6 & "5 12 21 28 47 54|5 13 43 52 58 65|5 15 29 40 44 49|5 16 26 32 53 64|5 19 30 34 39 60|5 23 31 36 55 56|"
sM6 = sM6 & "5 25 27 37 42 61|6 7 8 9 10 66|6 11 30 31 45 63|6 12 33 44 50 61|6 13 32 39 55 62|6 15 35 37 47 52|"
sM6 = sM6 & "6 16 22 43 54 60|6 17 21 29 42 64|6 24 34 36 48 53|7 11 19 32 54 61|7 12 31 40 60 62|7 13 20 25 33 63|"
sM6 = sM6 & "7 14 30 37 46 53|7 15 18 21 34 43|7 16 23 42 49 65|7 29 36 47 51 59|8 13 31 49 59 61|8 14 18 22 39 42|"
sM6 = sM6 & "8 16 21 40 41 55|8 17 23 30 35 43|8 19 25 36 46 52|8 37 45 48 51 64|8 38 47 53 60 65|9 11 23 28 46 64|"
sM6 = sM6 & "9 12 43 49 53 57|9 15 26 36 42 63|9 16 27 31 39 52|9 18 47 55 58 61|9 19 21 33 38 56|9 20 24 29 50 60|"
sM6 = sM6 & "10 11 25 43 51 56|10 12 22 27 46 55|10 14 19 40 50 64|10 17 26 33 52 59|10 20 34 45 49 54|10 24 35 39 44 65|"
sM6 = sM6 & "10 28 36 41 60 61|11 12 13 14 15 66|11 20 40 42 52 57|11 21 27 48 59 65|11 29 39 41 53 58|12 19 35 42 51 58|"
sM6 = sM6 & "12 20 23 26 39 48|12 34 41 52 56 64|13 19 23 27 44 47|13 21 26 45 46 60|13 22 28 35 40 48|13 24 30 41 51 57|"
sM6 = sM6 & "14 17 48 54 58 62|14 21 32 36 44 57|14 24 26 38 43 61|14 25 29 34 55 65|15 16 30 48 56 61|15 17 27 32 51 60|"
sM6 = sM6 & "15 22 31 38 57 64|15 25 39 50 54 59|16 17 18 19 20 66|16 25 45 47 57 62|16 34 44 46 58 63|17 24 40 47 56 63|"
sM6 = sM6 & "17 25 28 31 44 53|18 24 28 32 49 52|18 26 31 50 51 65|18 27 33 40 45 53|18 29 35 46 56 62|19 26 37 41 49 62|"
sM6 = sM6 & "20 22 32 37 56 65|20 30 44 55 59 64|21 22 23 24 25 66|22 30 33 36 49 58|23 29 33 37 54 57|23 32 38 45 50 58|"
sM6 = sM6 & "26 27 28 29 30 66|27 35 38 41 54 63|28 34 38 42 59 62|28 37 43 50 55 63|31 32 33 34 35 66|36 37 38 39 40 66|"
sM6 = sM6 & "41 42 43 44 45 66|46 47 48 49 50 66|51 52 53 54 55 66|56 57 58 59 60 66|61 62 63 64 65 66|"
Call SostituisciEStampa(sM6,aNumeriBase,"SISTEMA GDP2: C(66,6,2) = 143 COMBINAZIONI DA 6 NUMERI",sFileDestinazione)
End Sub
Sub SviluppaMatrice3(aNumeriBase,sFileDestinazione)
Dim sM3
sM3 = ""
sM3 = sM3 & "1 2 3|1 4 8|1 5 33|1 6 13|1 7 29|1 9 21|1 10 53|1 11 64|1 12 16|1 14 62|1 15 58|1 17 42|1 18 35|1 19 60|1 20 49|1 22 46|1 23 44|1 24 54|1 25 59|1 26 61|1 27 45|1 28 39|1 30 60|1 31 41|1 32 56|1 34 47|1 36 40|1 37 63|1 38 65|1 43 57|1 48 55|1 50 52|1 51 66|"
sM3 = sM3 & "2 4 46|2 5 12|2 6 7|2 8 27|2 9 15|2 10 11|2 13 43|2 14 39|2 16 41|2 17 24|2 18 57|2 19 48|2 20 28|2 21 42|2 22 56|2 23 59|2 24 38|2 25 63|2 26 33|2 29 62|2 30 31|2 32 53|2 34 37|2 35 60|2 36 44|2 40 61|2 45 66|2 47 58|2 49 52|2 50 51|2 54 65|2 55 64|"
sM3 = sM3 & "3 4 33|3 5 42|3 6 50|3 7 39|3 8 37|3 9 63|3 10 13|3 11 22|3 11 53|3 12 54|3 14 34|3 15 23|3 16 64|3 17 21|3 18 26|3 19 59|3 20 24|3 25 43|3 27 55|3 28 30|3 29 32|3 31 65|3 35 52|3 36 58|3 38 40|3 41 62|3 44 66|3 45 51|3 46 60|3 47 48|3 49 57|3 56 61|"
sM3 = sM3 & "4 5 34|4 6 20|4 7 55|4 9 14|4 10 57|4 11 52|4 12 20|4 13 45|4 15 28|4 16 54|4 17 29|4 18 37|4 19 27|4 21 24|4 22 43|4 23 30|4 25 26|4 31 47|4 32 59|4 35 40|4 36 51|4 38 44|4 39 62|4 41 61|4 42 64|4 48 60|4 49 53|4 50 66|4 56 58|4 63 65|"
sM3 = sM3 & "5 6 46|5 7 41|5 8 47|5 9 43|5 10 51|5 11 29|5 13 53|5 14 44|5 15 21|5 16 26|5 17 30|5 18 62|5 19 35|5 20 61|5 22 52|5 23 39|5 24 40|5 25 48|5 27 36|5 28 38|5 31 50|5 32 58|5 37 60|5 45 57|5 49 64|5 54 55|5 56 65|5 59 63|5 63 66|"
sM3 = sM3 & "6 8 27|6 9 18|6 10 35|6 11 12|6 14 21|6 15 47|6 16 66|6 17 33|6 19 39|6 22 53|6 23 54|6 24 48|6 25 50|6 26 64|6 28 58|6 29 65|6 30 44|6 31 42|6 32 63|6 34 52|6 36 59|6 37 49|6 38 60|6 40 57|6 41 51|6 43 56|6 45 55|6 61 62|"
sM3 = sM3 & "7 8 65|7 9 22|7 10 56|7 11 66|7 12 64|7 13 50|7 14 38|7 15 33|7 16 25|7 17 45|7 18 54|7 19 24|7 20 44|7 21 43|7 23 40|7 26 32|7 27 47|7 28 31|7 30 62|7 34 36|7 35 48|7 35 49|7 37 52|7 42 59|7 46 63|7 51 60|7 53 58|7 57 61|"
sM3 = sM3 & "8 9 36|8 10 54|8 11 14|8 12 57|8 13 28|8 15 42|8 16 46|8 17 51|8 18 43|8 19 66|8 20 31|8 21 56|8 22 60|8 23 25|8 24 30|8 26 35|8 29 53|8 32 34|8 33 58|8 38 55|8 39 40|8 41 44|8 45 63|8 48 61|8 49 62|8 50 64|8 52 59|"
sM3 = sM3 & "9 10 16|9 11 31|9 12 33|9 13 19|9 13 39|9 17 53|9 20 60|9 23 32|9 24 50|9 25 57|9 26 42|9 27 41|9 28 49|9 29 37|9 30 46|9 34 35|9 38 59|9 40 44|9 45 61|9 47 66|9 48 58|9 51 56|9 52 54|9 55 62|9 64 65|"
sM3 = sM3 & "10 12 17|10 14 63|10 15 49|10 18 22|10 19 62|10 20 39|10 21 58|10 23 37|10 23 41|10 24 45|10 25 42|10 26 31|10 27 44|10 28 40|10 29 30|10 32 55|10 33 50|10 34 46|10 36 47|10 38 52|10 43 48|10 59 60|10 61 64|10 65 66|"
sM3 = sM3 & "11 13 55|11 15 59|11 16 24|11 17 43|11 18 38|11 19 41|11 20 63|11 21 26|11 23 56|11 25 30|11 27 62|11 28 54|11 32 44|11 33 45|11 34 42|11 35 37|11 36 50|11 39 65|11 40 47|11 46 61|11 48 51|11 49 58|11 57 60|"
sM3 = sM3 & "12 13 48|12 14 53|12 15 56|12 18 25|12 19 21|12 22 38|12 23 50|12 24 28|12 26 43|12 27 59|12 29 66|12 30 49|12 31 32|12 32 41|12 34 45|12 35 39|12 36 60|12 37 65|12 40 42|12 44 46|12 47 62|12 51 63|12 52 55|12 58 61|"
sM3 = sM3 & "13 14 51|13 15 61|13 16 63|13 17 62|13 18 41|13 20 57|13 21 59|13 22 40|13 23 49|13 24 66|13 25 34|13 26 60|13 27 33|13 29 58|13 30 52|13 31 35|13 32 65|13 36 38|13 37 64|13 42 54|13 44 56|13 46 47|"
sM3 = sM3 & "14 15 37|14 16 58|14 17 29|14 18 47|14 19 64|14 20 25|14 22 45|14 22 61|14 23 33|14 24 36|14 26 66|14 27 30|14 28 43|14 31 59|14 32 52|14 35 41|14 40 48|14 42 46|14 49 54|14 50 55|14 56 57|14 60 65|"
sM3 = sM3 & "15 16 27|15 17 26|15 18 51|15 19 29|15 20 43|15 22 44|15 24 31|15 25 35|15 30 40|15 31 63|15 32 62|15 34 55|15 36 46|15 38 66|15 39 53|15 41 57|15 45 48|15 50 54|15 52 65|15 60 64|"
sM3 = sM3 & "16 17 60|16 18 31|16 19 38|16 20 34|16 21 62|16 22 23|16 28 29|16 30 51|16 32 39|16 33 57|16 35 55|16 36 61|16 37 40|16 42 65|16 43 52|16 44 47|16 45 50|16 48 62|16 49 56|16 53 59|"
sM3 = sM3 & "17 18 32|17 19 47|17 20 59|17 22 58|17 23 48|17 25 27|17 28 34|17 31 54|17 35 56|17 36 55|17 37 57|17 38 63|17 39 49|17 40 66|17 41 52|17 44 65|17 46 64|17 50 61|"
sM3 = sM3 & "18 19 50|18 20 48|18 21 52|18 23 27|18 24 46|18 28 61|18 29 45|18 30 34|18 33 42|18 36 56|18 39 61|18 40 60|18 44 59|18 49 66|18 53 64|18 55 63|18 58 65|"
sM3 = sM3 & "19 20 54|19 22 49|19 23 58|19 25 28|19 26 36|19 30 46|19 31 52|19 32 43|19 33 59|19 34 65|19 37 61|19 40 53|19 42 57|19 44 63|19 45 56|19 51 55|"
sM3 = sM3 & "20 21 50|20 22 65|20 23 66|20 26 45|20 27 37|20 29 40|20 30 38|20 32 35|20 33 46|20 36 62|20 41 58|20 42 47|20 51 52|20 53 55|20 56 64|"
sM3 = sM3 & "21 22 57|21 23 36|21 25 29|21 26 53|21 27 65|21 28 47|21 30 63|21 31 45|21 32 46|21 33 55|21 34 38|21 35 51|21 37 39|21 40 49|21 41 64|21 44 60|21 48 66|21 54 61|"
sM3 = sM3 & "22 24 29|22 25 55|22 26 30|22 27 31|22 28 62|22 32 37|22 33 48|22 34 66|22 35 63|22 36 42|22 39 51|22 41 54|22 47 64|22 50 59|"
sM3 = sM3 & "23 24 43|23 26 62|23 28 55|23 29 42|23 31 60|23 34 64|23 35 46|23 38 47|23 45 52|23 51 61|23 53 65|23 57 63|"
sM3 = sM3 & "24 25 64|24 26 41|24 27 53|24 32 49|24 33 51|24 34 56|24 35 57|24 37 42|24 39 52|24 44 55|24 47 59|24 58 60|24 61 63|24 62 65|"
sM3 = sM3 & "25 31 49|25 32 47|25 33 39|25 36 52|25 37 44|25 38 62|25 40 65|25 41 66|25 45 58|25 46 53|25 51 54|25 55 61|25 56 60|"
sM3 = sM3 & "26 27 46|26 28 65|26 29 52|26 34 54|26 37 48|26 38 58|26 39 44|26 40 63|26 47 55|26 49 59|26 50 57|26 51 56|"
sM3 = sM3 & "27 28 56|27 29 63|27 32 60|27 34 57|27 35 38|27 39 64|27 40 54|27 42 48|27 43 66|27 49 50|27 51 58|27 52 61|"
sM3 = sM3 & "28 32 45|28 33 41|28 35 66|28 36 63|28 37 66|28 42 44|28 46 51|28 48 53|28 50 60|28 52 57|28 59 64|"
sM3 = sM3 & "29 31 56|29 33 60|29 34 41|29 35 47|29 36 38|29 39 50|29 43 61|29 44 48|29 46 55|29 49 54|29 51 64|29 57 59|"
sM3 = sM3 & "30 32 61|30 33 35|30 36 53|30 37 45|30 39 42|30 41 48|30 43 65|30 47 57|30 50 56|30 54 59|30 55 66|30 58 64|"
sM3 = sM3 & "31 33 34|31 36 64|31 37 55|31 38 57|31 39 48|31 40 46|31 43 51|31 44 61|31 53 62|31 58 66|"
sM3 = sM3 & "32 33 54|32 36 66|32 38 64|32 40 50|32 42 51|32 48 57|"
sM3 = sM3 & "33 36 49|33 37 38|33 40 52|33 43 44|33 47 56|33 53 63|33 53 66|33 61 65|33 62 64|"
sM3 = sM3 & "34 39 60|34 40 58|34 43 58|34 44 51|34 48 49|34 50 63|34 53 61|34 59 62|"
sM3 = sM3 & "35 36 43|35 42 58|35 44 53|35 45 64|35 50 65|35 54 62|35 59 61|"
sM3 = sM3 & "36 37 41|36 39 45|36 48 54|36 57 65|"
sM3 = sM3 & "37 43 62|37 46 57|37 47 50|37 51 59|37 53 56|37 54 58|"
sM3 = sM3 & "38 39 46|38 41 56|38 42 61|38 43 54|38 45 53|38 48 50|38 49 51|"
sM3 = sM3 & "39 40 56|39 41 47|39 43 55|39 54 57|39 58 63|39 59 66|"
sM3 = sM3 & "40 41 55|40 43 64|40 45 59|40 51 62|"
sM3 = sM3 & "41 42 60|41 43 59|41 45 65|41 46 49|41 48 63|41 50 53|"
sM3 = sM3 & "42 43 53|42 45 47|42 49 63|42 50 62|42 52 66|42 55 56|"
sM3 = sM3 & "43 45 49|43 46 50|43 47 60|43 63 64|"
sM3 = sM3 & "44 45 52|44 49 65|44 50 58|44 54 64|44 57 62|"
sM3 = sM3 & "45 46 54|45 60 62|"
sM3 = sM3 & "46 48 65|46 52 56|46 58 59|46 62 66|"
sM3 = sM3 & "47 49 61|47 51 65|47 52 63|47 53 54|"
sM3 = sM3 & "48 52 64|48 56 59|"
sM3 = sM3 & "49 55 60|"
sM3 = sM3 & "51 53 57|"
sM3 = sM3 & "52 53 60|52 58 62|"
sM3 = sM3 & "54 56 66|54 60 63|"
sM3 = sM3 & "55 57 58|55 59 65|"
sM3 = sM3 & "56 62 63|"
sM3 = sM3 & "57 64 66|"
sM3 = sM3 & "60 61 66|"
Call SostituisciEStampa(sM3,aNumeriBase,"SISTEMA GDP2: C(66,3,2) = 726 COMBINAZIONI DA 3 NUMERI (TERZINE)",sFileDestinazione)
End Sub'Ecco l'evoluzione Master Edition v3.0 di SpazioScript.
'
'🌟 Novità introdotte In questa versione:
'
'1. Motore Dinamico di Verifica a Colpo per i 4 Quadranti(C33):
' - In ogni estrazione del Rolling Backtest viene derivata la combinazione
' eletta Rank #1 e generati i relativi 4 quadranti a 33 numeri: QFM(FQ
' max),Qfm(FQ min),QRM(RA max),Qrm(RA min).
' - Viene verificata puntualmente la sortita di almeno un Ambo a colpo(t + 1)
' su ruota per ciascuno dei 4 quadranti.
'2. Tracciamento dell'Indice di Consecutività Negativa:
' - Per ciascun quadrante vengono calcolati:
' - Win - Rate a colpo(percentuale storica di ambo al colpo secco #1
' In 33ina).
' - Consecutività Negativa Attuale(numero di estrazioni consecutive
' correnti senza esito di ambo a colpo).
' - Consecutività Negativa Massima(record storico di estrazioni
' consecutive negative mai registrato nel test).
' - Indice di Saturazione/Maturità Quantistica(Attuale / Max).
'3. Elezione Automatica del Miglior Quadrante Teorico Odierno:
' - Confronto algoritmico tra i 4 quadranti generati per l'estrazione
' odierna.
' - Viene eletto e proclamato il Quadrante TOP a 33 numeri con la più
' elevata tensione statistico - quantistica di rottura(massima
' consecutività negativa e minor scarto dal limite storico).
'4. 14° File TXT Esportato sul Desktop:
' - Generazione automatica del file dedicato con i 33 numeri del Miglior
' Quadrante eletto,pronto per lo spoglio o per essere importato.
'5. Sintassi Totalmente Espansa Anti - 1012:
' - Conforme alle regole ferree di Spaziometria: ogni comando,struttura di
' controllo e blocco condizionale risiede su riga dedicata.
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 lo 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 Standard
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
Dim bTestIncMaxBT
Dim aVociIncBT(1)
Dim nSceltaIncBT
' 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 tracking dei 4 Quadranti (C33) nel Backtest (NOMENCLATURA UNIVOCA CASE-INSENSITIVE)
Dim aBT_Q_FMax(33)
Dim aBT_Q_FMin(33)
Dim aBT_Q_RMax(33)
Dim aBT_Q_RMin(33)
Dim aBT_Num(66)
Dim aBT_FQ(66)
Dim aBT_RA(66)
Dim aBT_Single(1)
Dim retSingRitBT
Dim retSingRitMaxBT
Dim retSingIncrBT
Dim retSingFreqBT
Dim aBT_SortFQ_Num(66)
Dim aBT_SortFQ_Val(66)
Dim aBT_SortRA_Num(66)
Dim aBT_SortRA_Val(66)
Dim bBT_Win_FMax
Dim bBT_Win_FMin
Dim bBT_Win_RMax
Dim bBT_Win_RMin
Dim nCasiTestatiQ_BT
Dim nWin_FMax_BT
Dim nWin_FMin_BT
Dim nWin_RMax_BT
Dim nWin_RMin_BT
Dim nCurNeg_FMax
Dim nCurNeg_FMin
Dim nCurNeg_RMax
Dim nCurNeg_RMin
Dim nMaxNeg_FMax
Dim nMaxNeg_FMin
Dim nMaxNeg_RMax
Dim nMaxNeg_RMin
Dim sBestQNome
Dim sBestQComboStr
Dim nBestQCurNeg
Dim nBestQMaxNeg
Dim nBestQWinRate
Dim nBestQSaturazione
Dim nBestQScarto
Dim nSat_FMax
Dim nSat_FMin
Dim nSat_RMax
Dim nSat_RMin
' Variabili per la simulazione Backtest dei Collimanti FULL INCMAX III
Dim bBT_Rank1Trovata
Dim aBT_BestCombo(66)
Dim nBT_BestDiff
Dim nBT_BestRA
Dim nBT_BestFreq
Dim nInizio2400_BT
Dim aColonna65_BT(65)
Dim skipIdx_BT
Dim idxFill_BT
Dim retRit65_BT
Dim retRS65_BT
Dim retInc65_BT
Dim retFreq65_BT
Dim diff65_BT
Dim aVetRitardi_BT
Dim aVetIdEstr_BT
Dim sIncrList_BT
Dim aVetIncr_BT
Dim aVetIncrInt_BT
Dim nTotIncr_BT
Dim cvr_BT
Dim cvixim_BT
Dim nIncrAttuale_BT
Dim nIncrStoricoMax_BT
Dim diffIncMax_BT
Dim aPresenzeDOC_BT(90)
Dim nCasiDOC_BT
Dim cCollimanti_BT
Dim aCollimanti_BT
Dim tPost
Dim bSfaldatoCF_BT
Dim nColpoSfaldamento_BT
Dim nMaxColpoEmpirico
Dim nTotLineeCollimantiBT
Dim nLineeVincentiCollimantiBT
Dim nLineeAttiveCollimantiBT
Dim aColpiDistribuzione(100)
Dim aAttiveEstr(200)
Dim aAttiveData(200)
Dim aAttiveCollimantiStr(200)
Dim aAttiveColpiTrascorsi(200)
Dim aAttiveLen(200)
Dim idxAtt
Dim nColpiResiduiEmpirici
' Variabili per il Salvataggio e Ordinamento in Memoria (Fase 2)
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
' Variabili per le 8 righe export
Dim sExp_QFM
Dim sExp_Qfm_min
Dim sExp_QRM
Dim sExp_Qrm_min
Dim sExp_Conv1
Dim sExp_Conv2
Dim sExp_Conv3
Dim sExp_Conv4
' Variabili per i file TXT
Dim fso
Dim fFile
Dim sNomeFile
Dim sPercorsoDesktop
Dim WshShell
' Variabili per la FASE 6: RIDUZIONE QUANTISTICA INCMAX III DOC ODIERNA
Dim nInizio2400
Dim nCasiDOC
Dim aColonna65(65)
Dim skipIdx
Dim idxFill
Dim retRit65
Dim retRS65
Dim retInc65
Dim retFreq65
Dim diff65
Dim aVetRitardi
Dim aVetIdEstr
Dim sIncrList
Dim aVetIncr
Dim aVetIncrInt
Dim nTotIncr
Dim cvr
Dim cvixim
Dim nIncrAttuale
Dim nIncrStoricoMax
Dim diffIncMax
Dim aPresenzeDOC(90)
Dim cCollimantiFull
Dim aCollimantiFull
Dim sExp_CollimantiFull
Dim retRitCF
Dim retRSCF
Dim retIncCF
Dim retFreqCF
Dim nColpiRimanentiCF
Dim aPresSortNum(90)
Dim aPresSortVal(90)
Dim px
Dim py
Dim pTempN
Dim pTempV
' Inizializzazione del generatore casuale nativo
Randomize
' ==================================================================
' --- CONFIGURAZIONE PARAMETRI ---
' ==================================================================
nRuota = ScegliRuota()
nSorte = CInt(InputBox("Sorte di ricerca","sorte",2))
max_diff = CInt(InputBox("Max diff","max diff",1))
' PARAMETRI PER L'ANALISI CORRENTE (OGGI)
nCombinazioniOggi = 10000
' PARAMETRI PER IL ROLLING BACKTEST & MAPPATURA
bEseguiBacktest = True
nRangeBacktest = 100
nCombinazioniBT = 500
nColpi = 1
' Richiesta opzionale per il test avanzato INCMAX III nel Backtest
aVociIncBT(0) = "NO: Backtest Classico + Quadranti C33"
aVociIncBT(1) = "SI: Integra Tracking Motore Collimanti INCMAX III"
nSceltaIncBT = ScegliOpzioneMenu(aVociIncBT,0,"ABILITARE IL TRACKING COLLIMANTI INCMAX III NEL BACKTEST?")
If nSceltaIncBT = 1 Then
bTestIncMaxBT = True
Else
bTestIncMaxBT = False
End If
' ------------------------------------------------------------------
' --- IMPOSTAZIONE PARAMETRI DI FILTRAZIONE FINALE (FASE 4) ---
' ------------------------------------------------------------------
nTipoFiltroFinale = 2
nMinRATerzina = 900
nMaxElementiUnione = 22
nMinPresenze = 2
nMinRAQuartina = 467
' ==================================================================
' Impostazione ruota
aRuote(1) = nRuota
' Range di archivio
nInizio = 1
nFine = EstrazioneFin
' Finestra armonica 2400 estrazioni
nInizio2400 = nFine - 2399
If nInizio2400 < 1 Then
nInizio2400 = 1
End If
' 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 mappatura pre-sfaldamento
nTotalWNums = 0
nSumRA = 0
nSumRS = 0
nSumFreq = 0
nFascia1 = 0
nFascia2 = 0
nFascia3 = 0
nFascia4 = 0
' Inizializzazione tracciamento Quadranti nel Backtest
nCasiTestatiQ_BT = 0
nWin_FMax_BT = 0
nWin_FMin_BT = 0
nWin_RMax_BT = 0
nWin_RMin_BT = 0
nCurNeg_FMax = 0
nCurNeg_FMin = 0
nCurNeg_RMax = 0
nCurNeg_RMin = 0
nMaxNeg_FMax = 0
nMaxNeg_FMin = 0
nMaxNeg_RMax = 0
nMaxNeg_RMin = 0
' Inizializzazione tracking Collimanti FULL nel Backtest
nMaxColpoEmpirico = 0
nTotLineeCollimantiBT = 0
nLineeVincentiCollimantiBT = 0
nLineeAttiveCollimantiBT = 0
For k = 1 To 100
aColpiDistribuzione(k) = 0
Next
bMiglioreTrovata = False
ReDim aNumSingle(1)
' --- 1. SELEZIONE INTERATTIVA BLOCCO NUMERI FISSI ---
Dim aVociFissi(2)
Dim nSceltaFissi
aVociFissi(0) = "Blocco 1: 33 Fissi Standard"
aVociFissi(1) = "Blocco 2: 29 Fissi Ridotti (absc29)"
aVociFissi(2) = "Blocco 3: Inserimento Manuale a Video"
nSceltaFissi = ScegliOpzioneMenu(aVociFissi,0,"SCEGLI IL BLOCCO DI NUMERI FISSI:")
If nSceltaFissi = 0 Then
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"
Else
If nSceltaFissi = 1 Then
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"
Else
sFissiTemp = InputBox("Inserisci i numeri fissi separati da punto:","Numeri Fissi Manuali","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")
End If
End If
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
' --- 2. RICHIESTA DINAMICI (Completamento a 66) ---
Dim nDinamiciDefault
nDinamiciDefault = 66 - nFissi
If nDinamiciDefault < 1 Then
nDinamiciDefault = 33
End If
nDinamici = CInt(InputBox("Quanti numeri DINAMICI vuoi aggiungere ai " & nFissi & " fissi? (Default per fare 66: " & nDinamiciDefault & ")","Num Dinamici",nDinamiciDefault))
' --- 3. SELEZIONE INTERATTIVA BACINO POOL DINAMICI ---
Dim aVociPool(1)
Dim nSceltaPool
Dim sPoolCustom
Dim aPoolCustomString
Dim nTotBacino
aVociPool(0) = "Tutti i 90 numeri (Standard)"
aVociPool(1) = "Bacino Personalizzato (Lunghetta da stringa)"
nSceltaPool = ScegliOpzioneMenu(aVociPool,0,"DA QUALE BACINO PESCARE I DINAMICI?")
c = 0
If nSceltaPool = 0 Then
nPoolSize = 90 - nFissi
ReDim aPool(nPoolSize)
For i = 1 To 90
If Not aSfissi(i) Then
c = c + 1
aPool(c) = i
End If
Next
Else
sPoolCustom = InputBox("Inserisci la lunghetta dei numeri da cui pescare i dinamici:","Bacino Personalizzato","1.2.3.4.5.6.7.8.9.10.11.12.13.14.15.16.17.18.19.20.21.22.23.24.25.26.27.28.29.30")
aPoolCustomString = Split(sPoolCustom,".")
nTotBacino = UBound(aPoolCustomString) + 1
ReDim aPool(nTotBacino)
For i = 1 To nTotBacino
If Not aSfissi(CInt(aPoolCustomString(i - 1))) Then
c = c + 1
aPool(c) = CInt(aPoolCustomString(i - 1))
End If
Next
nPoolSize = c
ReDim Preserve aPool(nPoolSize)
End If
' Inizializzazione strutture di salvataggio memoria per Fase 2
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)
Call Titolazione()
' ==================================================================
' --- FASE 1: ROLLING BACKTEST STORICO, QUADRANTI C33 & INCMAX III ---
' ==================================================================
If bEseguiBacktest Then
Call Scrivi("==========================================================================================")
Call Scrivi(" FASE 1: ROLLING BACKTEST STORICO CON TRACKING AMBO A COLPO NEI 4 QUADRANTI (C33)",True)
Call Scrivi("==========================================================================================")
Call Scrivi("Analisi passo-passo sulle ultime " & nRangeBacktest & " estrazioni storiche...")
Call Scrivi("Vengono testati ad ogni colpo i 4 quadranti (QFM, Qfm, QRM, Qrm a 33 numeri)")
Call Scrivi("e monitorati i rispettivi indici di consecutivita negativa per ambo a colpo secco.")
If bTestIncMaxBT Then
Call Scrivi("Tracking attivo anche per il Motore Collimanti FULL INCMAX III!",True)
End If
Call Scrivi("")
nCasiTotali = 0
nCasiVincenti = 0
For t = nStartBT To nEndBT
Call AvanzamentoElab(nStartBT,nEndBT,t)
Call Messaggio("Backtest Estr: " & t & " / " & nEndBT & " | Casi C66: " & nCasiTotali)
If ScriptInterrotto Then
Exit For
End If
nTrovateInQuestoT = 0
bBT_Rank1Trovata = False
nBT_BestDiff = 9999
nBT_BestRA = - 1
nBT_BestFreq = - 1
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
' Valutazione Rank #1 storica per estrazione t
If nDiff < nBT_BestDiff Then
bBT_Rank1Trovata = True
nBT_BestDiff = nDiff
nBT_BestRA = RetRit
nBT_BestFreq = RetFreq
For k = 1 To(nFissi + nDinamici)
aBT_BestCombo(k) = aComboCompleta(k)
Next
Else
If nDiff = nBT_BestDiff Then
If RetRit > nBT_BestRA Then
bBT_Rank1Trovata = True
nBT_BestDiff = nDiff
nBT_BestRA = RetRit
nBT_BestFreq = RetFreq
For k = 1 To(nFissi + nDinamici)
aBT_BestCombo(k) = aComboCompleta(k)
Next
Else
If RetRit = nBT_BestRA Then
If RetFreq > nBT_BestFreq Then
bBT_Rank1Trovata = True
nBT_BestDiff = nDiff
nBT_BestRA = RetRit
nBT_BestFreq = RetFreq
For k = 1 To(nFissi + nDinamici)
aBT_BestCombo(k) = aComboCompleta(k)
Next
End If
End If
End If
End If
End If
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
' ==============================================================
' SIMULAZIONE AMBO A COLPO NEI 4 QUADRANTI (C33) AL PASSO T
' ==============================================================
If bBT_Rank1Trovata And(nFissi + nDinamici) = 66 Then
nCasiTestatiQ_BT = nCasiTestatiQ_BT + 1
For k = 1 To 66
aBT_Num(k) = aBT_BestCombo(k)
aBT_Single(1) = aBT_Num(k)
Call StatisticaFormazioneTurbo(aBT_Single,aRuote,1,retSingRitBT,retSingRitMaxBT,retSingIncrBT,retSingFreqBT,nInizio,t)
aBT_FQ(k) = retSingFreqBT
aBT_RA(k) = retSingRitBT
aBT_SortFQ_Num(k) = aBT_Num(k)
aBT_SortFQ_Val(k) = aBT_FQ(k)
aBT_SortRA_Num(k) = aBT_Num(k)
aBT_SortRA_Val(k) = aBT_RA(k)
Next
' Ordinamento per FQ decrescente
For px = 1 To 65
For py = px + 1 To 66
If aBT_SortFQ_Val(py) > aBT_SortFQ_Val(px) Then
pTempV = aBT_SortFQ_Val(px)
aBT_SortFQ_Val(px) = aBT_SortFQ_Val(py)
aBT_SortFQ_Val(py) = pTempV
pTempN = aBT_SortFQ_Num(px)
aBT_SortFQ_Num(px) = aBT_SortFQ_Num(py)
aBT_SortFQ_Num(py) = pTempN
End If
Next
Next
' Popolamento Q_FMax (1..33) e Q_FMin (34..66)
For k = 1 To 33
aBT_Q_FMax(k) = aBT_SortFQ_Num(k)
Next
For k = 1 To 33
aBT_Q_FMin(k) = aBT_SortFQ_Num(k + 33)
Next
' Ordinamento per RA decrescente
For px = 1 To 65
For py = px + 1 To 66
If aBT_SortRA_Val(py) > aBT_SortRA_Val(px) Then
pTempV = aBT_SortRA_Val(px)
aBT_SortRA_Val(px) = aBT_SortRA_Val(py)
aBT_SortRA_Val(py) = pTempV
pTempN = aBT_SortRA_Num(px)
aBT_SortRA_Num(px) = aBT_SortRA_Num(py)
aBT_SortRA_Num(py) = pTempN
End If
Next
Next
' Popolamento Q_RMax (1..33) e Q_RMin (34..66)
For k = 1 To 33
aBT_Q_RMax(k) = aBT_SortRA_Num(k)
Next
For k = 1 To 33
aBT_Q_RMin(k) = aBT_SortRA_Num(k + 33)
Next
' Verifica Ambo a colpo t+1 per i 4 Quadranti
bBT_Win_FMax = False
bBT_Win_FMin = False
bBT_Win_RMax = False
bBT_Win_RMin = False
If SerieFreqTurbo(t + 1,t + 1,aBT_Q_FMax,aRuote,2) > 0 Then
bBT_Win_FMax = True
End If
If SerieFreqTurbo(t + 1,t + 1,aBT_Q_FMin,aRuote,2) > 0 Then
bBT_Win_FMin = True
End If
If SerieFreqTurbo(t + 1,t + 1,aBT_Q_RMax,aRuote,2) > 0 Then
bBT_Win_RMax = True
End If
If SerieFreqTurbo(t + 1,t + 1,aBT_Q_RMin,aRuote,2) > 0 Then
bBT_Win_RMin = True
End If
' Aggiornamento consecutività Q_FMax
If bBT_Win_FMax Then
nWin_FMax_BT = nWin_FMax_BT + 1
nCurNeg_FMax = 0
Else
nCurNeg_FMax = nCurNeg_FMax + 1
If nCurNeg_FMax > nMaxNeg_FMax Then
nMaxNeg_FMax = nCurNeg_FMax
End If
End If
' Aggiornamento consecutività Q_FMin
If bBT_Win_FMin Then
nWin_FMin_BT = nWin_FMin_BT + 1
nCurNeg_FMin = 0
Else
nCurNeg_FMin = nCurNeg_FMin + 1
If nCurNeg_FMin > nMaxNeg_FMin Then
nMaxNeg_FMin = nCurNeg_FMin
End If
End If
' Aggiornamento consecutività Q_RMax
If bBT_Win_RMax Then
nWin_RMax_BT = nWin_RMax_BT + 1
nCurNeg_RMax = 0
Else
nCurNeg_RMax = nCurNeg_RMax + 1
If nCurNeg_RMax > nMaxNeg_RMax Then
nMaxNeg_RMax = nCurNeg_RMax
End If
End If
' Aggiornamento consecutività Q_RMin
If bBT_Win_RMin Then
nWin_RMin_BT = nWin_RMin_BT + 1
nCurNeg_RMin = 0
Else
nCurNeg_RMin = nCurNeg_RMin + 1
If nCurNeg_RMin > nMaxNeg_RMin Then
nMaxNeg_RMin = nCurNeg_RMin
End If
End If
End If
' ==============================================================
' SIMULAZIONE COLLIMANTI FULL INCMAX III PER QUESTA ESTRAZIONE
' ==============================================================
If bTestIncMaxBT And bBT_Rank1Trovata And(nFissi + nDinamici) = 66 Then
nInizio2400_BT = t - 2399
If nInizio2400_BT < 1 Then
nInizio2400_BT = 1
End If
For k = 1 To 90
aPresenzeDOC_BT(k) = 0
Next
nCasiDOC_BT = 0
For skipIdx_BT = 1 To 66
idxFill_BT = 0
For k = 1 To 66
If k <> skipIdx_BT Then
idxFill_BT = idxFill_BT + 1
aColonna65_BT(idxFill_BT) = aBT_BestCombo(k)
End If
Next
Call StatisticaFormazioneTurbo(aColonna65_BT,aRuote,nSorte,retRit65_BT,retRS65_BT,retInc65_BT,retFreq65_BT,nInizio2400_BT,t)
diff65_BT = retRS65_BT - retRit65_BT
Call ElencoRitardi(aColonna65_BT,aRuote,nSorte,nInizio2400_BT,t,aVetRitardi_BT,aVetIdEstr_BT)
If UBound(aVetRitardi_BT) >= 2 Then
sIncrList_BT = ""
For cvr_BT = 1 To UBound(aVetRitardi_BT) - 1
sIncrList_BT = sIncrList_BT & "." & CStr(aVetRitardi_BT(cvr_BT + 1) - aVetRitardi_BT(cvr_BT))
Next
Call SplitByChar(sIncrList_BT,".",aVetIncr_BT)
nTotIncr_BT = UBound(aVetIncr_BT)
If nTotIncr_BT >= 2 Then
ReDim aVetIncrInt_BT(nTotIncr_BT - 1)
For cvixim_BT = 1 To nTotIncr_BT - 1
aVetIncrInt_BT(cvixim_BT) = CInt(aVetIncr_BT(cvixim_BT))
Next
nIncrAttuale_BT = CInt(aVetIncr_BT(nTotIncr_BT))
nIncrStoricoMax_BT = MassimoV(aVetIncrInt_BT,1,nTotIncr_BT - 1)
diffIncMax_BT = nIncrAttuale_BT - nIncrStoricoMax_BT
If diff65_BT = 0 And diffIncMax_BT = 0 Then
nCasiDOC_BT = nCasiDOC_BT + 1
For k = 1 To 65
aPresenzeDOC_BT(aColonna65_BT(k)) = aPresenzeDOC_BT(aColonna65_BT(k)) + 1
Next
End If
End If
End If
Next
If nCasiDOC_BT > 0 Then
cCollimanti_BT = 0
ReDim aCollimanti_BT(90)
For k = 1 To 90
If aPresenzeDOC_BT(k) = nCasiDOC_BT Then
cCollimanti_BT = cCollimanti_BT + 1
aCollimanti_BT(cCollimanti_BT) = k
End If
Next
If cCollimanti_BT > 0 Then
ReDim Preserve aCollimanti_BT(cCollimanti_BT)
Call OrdinaMatrice(aCollimanti_BT,1)
nTotLineeCollimantiBT = nTotLineeCollimantiBT + 1
bSfaldatoCF_BT = False
nColpoSfaldamento_BT = 0
For tPost = t + 1 To nFine
If SerieFreqTurbo(tPost,tPost,aCollimanti_BT,aRuote,nSorte) > 0 Then
bSfaldatoCF_BT = True
nColpoSfaldamento_BT = tPost - t
Exit For
End If
Next
If bSfaldatoCF_BT Then
nLineeVincentiCollimantiBT = nLineeVincentiCollimantiBT + 1
If nColpoSfaldamento_BT > nMaxColpoEmpirico Then
nMaxColpoEmpirico = nColpoSfaldamento_BT
End If
If nColpoSfaldamento_BT <= 100 Then
aColpiDistribuzione(nColpoSfaldamento_BT) = aColpiDistribuzione(nColpoSfaldamento_BT) + 1
End If
Else
nLineeAttiveCollimantiBT = nLineeAttiveCollimantiBT + 1
aAttiveEstr(nLineeAttiveCollimantiBT) = t
aAttiveData(nLineeAttiveCollimantiBT) = DataEstrazione(t)
aAttiveCollimantiStr(nLineeAttiveCollimantiBT) = StringaNumeri(aCollimanti_BT,".")
aAttiveColpiTrascorsi(nLineeAttiveCollimantiBT) = nFine - t
aAttiveLen(nLineeAttiveCollimantiBT) = cCollimanti_BT
End If
End If
End If
End If
If nCasiTotali > 0 Then
sPercent = Round((nCasiVincenti / nCasiTotali) * 100,1) & "%"
Else
sPercent = "0.0%"
End If
Call Scrivi("Estr. " & t & " (" & DataEstrazione(t) & ") | Idonee: " & nTrovateInQuestoT & " | Progressivo C66: " & nCasiVincenti & " vinti su " & nCasiTotali & " (" & sPercent & ")")
Next
Call Scrivi("")
Call Scrivi("------------------------------------------------------------------------------------------")
Call Scrivi("RIEPILOGO STORICO BACKTEST ROLLING C66:",True)
Call Scrivi("Totale combinazioni idonee rilevate nel passato: " & nCasiTotali)
Call Scrivi("Totale combinazioni vincenti a colpo: " & nCasiVincenti)
Call Scrivi("Win-Rate a colpo della formazione C66: " & sPercent,True)
Call Scrivi("------------------------------------------------------------------------------------------")
Call Scrivi("")
' ==============================================================
' REPORT STATISTICO COMPLETO 4 QUADRANTI (C33) A COLPO SECCO
' ==============================================================
If nCasiTestatiQ_BT > 0 Then
Call Scrivi("==========================================================================================",True)
Call Scrivi(" VERIFICA SFALDAMENTO AMBO A COLPO NEI SINGOLI 4 QUADRANTI (C33 DINAMICA)",True)
Call Scrivi("==========================================================================================",True)
Call Scrivi("Analisi condotta su " & nCasiTestatiQ_BT & " formazioni Rank #1 testate al Colpo Secco #1:")
Call Scrivi("")
Call Scrivi("1) QUADRANTE QFM (Frequenza Max - 33 num):")
Call Scrivi(" - Vincente per Ambo a colpo: " & nWin_FMax_BT & " su " & nCasiTestatiQ_BT & " (" & Round((nWin_FMax_BT / nCasiTestatiQ_BT) * 100,1) & "%)")
Call Scrivi(" - Consecutivita Negativa ATTUALE : " & nCurNeg_FMax & " colpi a vuoto consecutivi")
Call Scrivi(" - Consecutivita Negativa MASSIMA : " & nMaxNeg_FMax & " colpi a vuoto record storico")
Call Scrivi("")
Call Scrivi("2) QUADRANTE Qfm (Frequenza Min - 33 num):")
Call Scrivi(" - Vincente per Ambo a colpo: " & nWin_FMin_BT & " su " & nCasiTestatiQ_BT & " (" & Round((nWin_FMin_BT / nCasiTestatiQ_BT) * 100,1) & "%)")
Call Scrivi(" - Consecutivita Negativa ATTUALE : " & nCurNeg_FMin & " colpi a vuoto consecutivi")
Call Scrivi(" - Consecutivita Negativa MASSIMA : " & nMaxNeg_FMin & " colpi a vuoto record storico")
Call Scrivi("")
Call Scrivi("3) QUADRANTE QRM (Ritardo Max - 33 num):")
Call Scrivi(" - Vincente per Ambo a colpo: " & nWin_RMax_BT & " su " & nCasiTestatiQ_BT & " (" & Round((nWin_RMax_BT / nCasiTestatiQ_BT) * 100,1) & "%)")
Call Scrivi(" - Consecutivita Negativa ATTUALE : " & nCurNeg_RMax & " colpi a vuoto consecutivi")
Call Scrivi(" - Consecutivita Negativa MASSIMA : " & nMaxNeg_RMax & " colpi a vuoto record storico")
Call Scrivi("")
Call Scrivi("4) QUADRANTE Qrm (Ritardo Min - 33 num):")
Call Scrivi(" - Vincente per Ambo a colpo: " & nWin_RMin_BT & " su " & nCasiTestatiQ_BT & " (" & Round((nWin_RMin_BT / nCasiTestatiQ_BT) * 100,1) & "%)")
Call Scrivi(" - Consecutivita Negativa ATTUALE : " & nCurNeg_RMin & " colpi a vuoto consecutivi")
Call Scrivi(" - Consecutivita Negativa MASSIMA : " & nMaxNeg_RMin & " colpi a vuoto record storico")
Call Scrivi("==========================================================================================")
Call Scrivi("")
End If
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 su un campione di " & nTotalWNums & " singoli estratti usciti nelle combinazioni:")
Call Scrivi(" - Ritardo Medio individuale all'uscita : " & Round(nSumRA / nTotalWNums,1) & " estrazioni")
Call Scrivi(" - Ritardo Storico Medio individuale : " & Round(nSumRS / nTotalWNums,1) & " estrazioni")
Call Scrivi(" - Frequenza Media individuale : " & 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
' QUADRO RIEPILOGATIVO AVANZATO MOTORE COLLIMANTI FULL INCMAX III
If bTestIncMaxBT Then
Call Scrivi("==========================================================================================",True)
Call Scrivi(" ESITO TRACKING STORICO MOTORE COLLIMANTI FULL INCMAX III DOC NEL BACKTEST",True)
Call Scrivi("==========================================================================================",True)
Call Scrivi("Totale linee Collimanti FULL generate nel periodo di test: " & nTotLineeCollimantiBT)
Call Scrivi("Linee Collimanti FULL gia sfaldate (vincenti per Ambo): " & nLineeVincentiCollimantiBT)
Call Scrivi("Linee Collimanti FULL ancora ATTIVE / IN CORSO : " & nLineeAttiveCollimantiBT)
Call Scrivi("")
Call Scrivi("COLPO MASSIMO STORICO EMPIRICO ASSOLUTO DI SFALDAMENTO : " & nMaxColpoEmpirico & " colpi!",True)
Call Scrivi("")
Call Scrivi("DISTRIBUZIONE ESATTA DEI COLPI DI SFALDAMENTO RILEVATI NELLO STORICO:")
For k = 1 To nMaxColpoEmpirico
If aColpiDistribuzione(k) > 0 Then
Call Scrivi(" - Sfaldamento avvenuto al Colpo " & Format2(k) & " : " & aColpiDistribuzione(k) & " volte (" & Round((aColpiDistribuzione(k) / nLineeVincentiCollimantiBT) * 100,1) & "%)")
End If
Next
Call Scrivi("")
If nLineeAttiveCollimantiBT > 0 Then
Call Scrivi("------------------------------------------------------------------------------------------",True)
Call Scrivi("LINEE COLLIMANTI FULL ANCORA IN CORSO (SCATURITE DALLE ULTIME ESTRAZIONI):",True)
Call Scrivi("------------------------------------------------------------------------------------------",True)
For idxAtt = 1 To nLineeAttiveCollimantiBT
nColpiResiduiEmpirici = nMaxColpoEmpirico - aAttiveColpiTrascorsi(idxAtt)
Call Scrivi("Generata all'estrazione " & aAttiveEstr(idxAtt) & " (" & aAttiveData(idxAtt) & ")")
Call Scrivi(" -> Formazione (" & aAttiveLen(idxAtt) & " numeri): " & aAttiveCollimantiStr(idxAtt))
Call Scrivi(" -> Colpi gia trascorsi senza ambo: " & aAttiveColpiTrascorsi(idxAtt))
If nColpiResiduiEmpirici > 0 Then
Call Scrivi(" -> ATTESA RESIDUA TEORICA rispetto al Colpo Max Empirico (" & nMaxColpoEmpirico & "): " & nColpiResiduiEmpirici & " colpi rimanenti!",True)
Else
Call Scrivi(" -> LIVELLO CRITICO DI MATURITA': Ha raggiunto o superato il Colpo Max Empirico! (PRONTO A COLPO)",True)
End If
Call Scrivi("")
Next
Else
Call Scrivi("Tutte le linee Collimanti FULL storiche analizzate risultano gia sfaldate con successo!")
End If
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(" - Finestra Armonica di Analisi INCMAX III : Ultime 2400 estrazioni consecutive (60 x 4 x 10, Figura 6)")
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("==========================================================================================")
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("==========================================================================================")
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: " & Left(sFasceFav,Len(sFasceFav) - 3))
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: " & UBound(aMiglioreComboDiOggi) & " numeri")
Call Scrivi(" -> Quantita rimasta : " & nFavoritiCount & " numeri")
Call Scrivi(" -> Abbattimento massa : " & Round((1 -(nFavoritiCount / UBound(aMiglioreComboDiOggi))) * 100,1) & "%")
Call Scrivi("")
Call Scrivi(" -> Sotto-gruppo Consigliato (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("==========================================================================================")
If nTipoFiltroFinale = 1 Then
Call Scrivi("FILTRO ATTIVO: [1] MULTI-CONVERGENZA SULLE TERZINE (RA PER AMBO >= " & nMinRATerzina & ")")
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(" -> Quantita elementi finali risultanti: " & nUnionCount & " numeri")
Call Scrivi(" -> Sotto-gruppo Ristretto Consigliato (Ambo a Colpo):",True)
Call Scrivi(" " & StringaNumeri(aUnionNumeri,"."),True)
End If
Else
If nTipoFiltroFinale = 2 Then
Call Scrivi("FILTRO ATTIVO: [2] RIDUZIONE SEQUENZIALE IN QUARTINE (DOPPIO LIVELLO X7)")
Call Scrivi("")
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)
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(" -> Quantita elementi finali ristretti: " & nQuartUnionCount & " numeri")
Call Scrivi(" -> Sotto-gruppo Ristretto Consigliato (Ambo a Colpo):",True)
Call Scrivi(" " & StringaNumeri(aQuartUnionNumeri,"."),True)
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 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
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 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
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 STAMPE DETTAGLIATE INTEGRALI
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("La seguente lista mostra le prime Combinazioni In Base al valore di Frequenza")
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("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("La seguente lista mostra le prime Combinazioni In Base al valore di Ritardo")
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("")
' 5.4 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("QFM " & StringaNumeri(aListQFM,"-"))
Call Scrivi("---")
Call Scrivi("Qfm " & StringaNumeri(aListQfm_min,"-"))
Call Scrivi("")
Call Scrivi("QUADRANTI RITARDO")
Call Scrivi("QRM " & StringaNumeri(aListQRM,"-"))
Call Scrivi("----")
Call Scrivi("Qrm " & StringaNumeri(aListQrm_min,"-"))
Call Scrivi("")
' 5.5 CONVERGENZE
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)
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)
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)
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 : " & StringaNumeri(aConv1,"-"),True)
Call Scrivi("CONVERGENTI QFM @ Qrm : " & StringaNumeri(aConv2,"-"),True)
Call Scrivi("CONVERGENTI Qfm @ QRM : " & StringaNumeri(aConv3,"-"),True)
Call Scrivi("CONVERGENTI Qfm @ Qrm : " & StringaNumeri(aConv4,"-"),True)
Call Scrivi("")
' 5.6 STRINGHE EXPORT 8 RIGHE
sExp_QFM = StringaNumeri(aListQFM,".")
sExp_Qfm_min = StringaNumeri(aListQfm_min,".")
sExp_QRM = StringaNumeri(aListQRM,".")
sExp_Qrm_min = StringaNumeri(aListQrm_min,".")
sExp_Conv1 = StringaNumeri(aConv1,".")
sExp_Conv2 = StringaNumeri(aConv2,".")
sExp_Conv3 = StringaNumeri(aConv3,".")
sExp_Conv4 = StringaNumeri(aConv4,".")
Call Scrivi("==========================================================================================",True)
Call Scrivi(" BLOCCO EXPORT 8 RIGHE (SOLO NUMERI SEPARATI DA PUNTO - FACILE DA COPIARE)",True)
Call Scrivi("==========================================================================================",True)
Call Scrivi(sExp_QFM)
Call Scrivi(sExp_Qfm_min)
Call Scrivi(sExp_QRM)
Call Scrivi(sExp_Qrm_min)
Call Scrivi(sExp_Conv1)
Call Scrivi(sExp_Conv2)
Call Scrivi(sExp_Conv3)
Call Scrivi(sExp_Conv4)
Call Scrivi("==========================================================================================")
Call Scrivi("")
' ==============================================================
' 5.7 ELEZIONE DEL MIGLIOR QUADRANTE TEORICO ATTUALE (C33)
' ==============================================================
If bEseguiBacktest And nCasiTestatiQ_BT > 0 Then
nSat_FMax = 0
nSat_FMin = 0
nSat_RMax = 0
nSat_RMin = 0
If nMaxNeg_FMax > 0 Then
nSat_FMax = nCurNeg_FMax / nMaxNeg_FMax
End If
If nMaxNeg_FMin > 0 Then
nSat_FMin = nCurNeg_FMin / nMaxNeg_FMin
End If
If nMaxNeg_RMax > 0 Then
nSat_RMax = nCurNeg_RMax / nMaxNeg_RMax
End If
If nMaxNeg_RMin > 0 Then
nSat_RMin = nCurNeg_RMin / nMaxNeg_RMin
End If
' Eleggiamo il quadrante con la saturazione/consecutività negativa maggiore
sBestQNome = "QFM (Frequenza Max)"
sBestQComboStr = sExp_QFM
nBestQCurNeg = nCurNeg_FMax
nBestQMaxNeg = nMaxNeg_FMax
nBestQWinRate = Round((nWin_FMax_BT / nCasiTestatiQ_BT) * 100,1)
nBestQSaturazione = nSat_FMax
If nSat_FMin > nBestQSaturazione Then
sBestQNome = "Qfm (Frequenza Min)"
sBestQComboStr = sExp_Qfm_min
nBestQCurNeg = nCurNeg_FMin
nBestQMaxNeg = nMaxNeg_FMin
nBestQWinRate = Round((nWin_FMin_BT / nCasiTestatiQ_BT) * 100,1)
nBestQSaturazione = nSat_FMin
End If
If nSat_RMax > nBestQSaturazione Then
sBestQNome = "QRM (Ritardo Max)"
sBestQComboStr = sExp_QRM
nBestQCurNeg = nCurNeg_RMax
nBestQMaxNeg = nMaxNeg_RMax
nBestQWinRate = Round((nWin_RMax_BT / nCasiTestatiQ_BT) * 100,1)
nBestQSaturazione = nSat_RMax
End If
If nSat_RMin > nBestQSaturazione Then
sBestQNome = "Qrm (Ritardo Min)"
sBestQComboStr = sExp_Qrm_min
nBestQCurNeg = nCurNeg_RMin
nBestQMaxNeg = nMaxNeg_RMin
nBestQWinRate = Round((nWin_RMin_BT / nCasiTestatiQ_BT) * 100,1)
nBestQSaturazione = nSat_RMin
End If
nBestQScarto = nBestQMaxNeg - nBestQCurNeg
Call Scrivi("==========================================================================================",True)
Call Scrivi(" MIGLIOR QUADRANTE TEORICO ATTUALE PER AMBO A COLPO SU " & NomeRuota(nRuota),True)
Call Scrivi("==========================================================================================",True)
Call Scrivi(" -> QUADRANTE ELETTO : " & sBestQNome,True)
Call Scrivi(" -> FORMAZIONE (33n) : " & sBestQComboStr,True)
Call Scrivi(" -> WIN-RATE STORICO A COLPO : " & nBestQWinRate & "%")
Call Scrivi(" -> CONSECUTIVITA NEGATIVA ATTUALE : " & nBestQCurNeg & " colpi a vuoto consecutivi")
Call Scrivi(" -> CONSECUTIVITA NEGATIVA MASSIMA : " & nBestQMaxNeg & " colpi a vuoto record storico")
If nBestQScarto <= 0 Then
Call Scrivi(" -> TENSIONE DI SFALDAMENTO: CRITICA / RAGGIUNTO RECORD NEGATIVO (ROTTURA IMMINENTE!)",True)
Else
Call Scrivi(" -> DISTANZA DAL LIMITE STORICO: Solo " & nBestQScarto & " colpi di margine al tetto massimo!",True)
End If
Call Scrivi("==========================================================================================")
Call Scrivi("")
End If
End If
' ==================================================================
' --- FASE 6: RIDUZIONE QUANTISTICA INCMAX III DOC & COLLIMANTI FULL ---
' ==================================================================
If bMiglioreTrovata And nTotR1 = 66 Then
Call Scrivi("==========================================================================================",True)
Call Scrivi(" FASE 6: RIDUZIONE QUANTISTICA INCMAX III DOC & COLLIMANTI FULL (C66 -> C65)",True)
Call Scrivi("==========================================================================================",True)
Call Scrivi("Finestra armonica analizzata: ultime 2400 estrazioni consecutive [" & nInizio2400 & " - " & nFine & "]")
Call Scrivi("Ruota target: " & NomeRuota(nRuota) & " | Sorte di scansione: " & nSorte & " (Ambo)")
Call Scrivi("")
For k = 1 To 90
aPresenzeDOC(k) = 0
Next
nCasiDOC = 0
For skipIdx = 1 To 66
idxFill = 0
For k = 1 To 66
If k <> skipIdx Then
idxFill = idxFill + 1
aColonna65(idxFill) = aMiglioreComboDiOggi(k)
End If
Next
Call StatisticaFormazioneTurbo(aColonna65,aRuote,nSorte,retRit65,retRS65,retInc65,retFreq65,nInizio2400,nFine)
diff65 = retRS65 - retRit65
Call ElencoRitardi(aColonna65,aRuote,nSorte,nInizio2400,nFine,aVetRitardi,aVetIdEstr)
If UBound(aVetRitardi) >= 2 Then
sIncrList = ""
For cvr = 1 To UBound(aVetRitardi) - 1
sIncrList = sIncrList & "." & CStr(aVetRitardi(cvr + 1) - aVetRitardi(cvr))
Next
Call SplitByChar(sIncrList,".",aVetIncr)
nTotIncr = UBound(aVetIncr)
If nTotIncr >= 2 Then
ReDim aVetIncrInt(nTotIncr - 1)
For cvixim = 1 To nTotIncr - 1
aVetIncrInt(cvixim) = CInt(aVetIncr(cvixim))
Next
nIncrAttuale = CInt(aVetIncr(nTotIncr))
nIncrStoricoMax = MassimoV(aVetIncrInt,1,nTotIncr - 1)
diffIncMax = nIncrAttuale - nIncrStoricoMax
If diff65 = 0 And diffIncMax = 0 Then
nCasiDOC = nCasiDOC + 1
For k = 1 To 65
aPresenzeDOC(aColonna65(k)) = aPresenzeDOC(aColonna65(k)) + 1
Next
End If
End If
End If
Next
Call Scrivi("Totale formazioni di classe 65 testate: 66")
Call Scrivi("Totale casi ottimali DOC rilevati (diff=0 e diffIncMax=0): " & nCasiDOC,True)
Call Scrivi("")
If nCasiDOC > 0 Then
For k = 1 To 90
aPresSortNum(k) = k
aPresSortVal(k) = aPresenzeDOC(k)
Next
For px = 1 To 89
For py = px + 1 To 90
If aPresSortVal(py) > aPresSortVal(px) Then
pTempV = aPresSortVal(px)
aPresSortVal(px) = aPresSortVal(py)
aPresSortVal(py) = pTempV
pTempN = aPresSortNum(px)
aPresSortNum(px) = aPresSortNum(py)
aPresSortNum(py) = pTempN
End If
Next
Next
Call Scrivi("CLASSIFICA PRESENZE ELEMENTI NELLE FORMAZIONI DOC:")
For k = 1 To 90
If aPresSortVal(k) > 0 Then
Call Scrivi("Num. " & Format2(aPresSortNum(k)) & " - presenze: " & aPresSortVal(k) & " su " & nCasiDOC)
End If
Next
Call Scrivi("")
cCollimantiFull = 0
ReDim aCollimantiFull(90)
For k = 1 To 90
If aPresenzeDOC(k) = nCasiDOC Then
cCollimantiFull = cCollimantiFull + 1
aCollimantiFull(cCollimantiFull) = k
End If
Next
If cCollimantiFull > 0 Then
ReDim Preserve aCollimantiFull(cCollimantiFull)
Call OrdinaMatrice(aCollimantiFull,1)
sExp_CollimantiFull = StringaNumeri(aCollimantiFull,".")
Call Scrivi("==========================================================================================",True)
Call Scrivi("GRUPPO RISTRETTO COLLIMANTI FULL (PRESENZA 100% IN TUTTE LE FORMAZIONI DOC)",True)
Call Scrivi("==========================================================================================",True)
Call Scrivi(" -> Quantita elementi isolati: " & cCollimantiFull & " numeri (Classe <= 16: RISPETTATA!)",True)
Call Scrivi(" -> Stringa giocabile: " & sExp_CollimantiFull,True)
Call Scrivi("")
Call StatisticaFormazioneTurbo(aCollimantiFull,aRuote,2,retRitCF,retRSCF,retIncCF,retFreqCF,nInizio,nFine)
nColpiRimanentiCF = retRSCF - retRitCF
Call Scrivi("PROFILO STATISTICO COLLIMANTI FULL PER AMBO SU " & NomeRuota(nRuota) & " (Archivio Totale):",True)
Call Scrivi(" - Ritardo Attuale (RA) : " & retRitCF)
Call Scrivi(" - Ritardo Storico (RS) : " & retRSCF)
Call Scrivi(" - Frequenza Totale (FQ) : " & retFreqCF)
Call Scrivi(" - Scarto (RS - RA) : " & nColpiRimanentiCF)
If nColpiRimanentiCF <= 0 Then
Call Scrivi(" -> STATO DI SFALDAMENTO : IPER-FREQUENTE / PRONTO A COLPO! (Scarto <= 0)",True)
Else
Call Scrivi(" -> COLPI TEORICI RIMANENTI: " & nColpiRimanentiCF & " colpi al massimo storico",True)
End If
Call Scrivi("==========================================================================================")
Call Scrivi("")
Else
Call Scrivi("Nessun numero e presente al 100% in tutti i casi DOC.")
End If
Else
Call Scrivi("Nessuna formazione di classe 65 ha soddisfatto la condizione INCMAX III DOC.")
End If
End If
' ==================================================================
' --- FASE 7: ESPORTAZIONE AUTOMATICA DEI 14 FILE TXT SUL DESKTOP ---
' ==================================================================
If bMiglioreTrovata And nTotR1 = 66 Then
Call Scrivi("==========================================================================================",True)
Call Scrivi(" FASE 7: GENERAZIONE E SALVATAGGIO DEI 14 FILE TXT PULITI SUL DESKTOP",True)
Call Scrivi("==========================================================================================",True)
Set WshShell = CreateObject("WScript.Shell")
sPercorsoDesktop = WshShell.SpecialFolders("Desktop") & "\"
Set WshShell = Nothing
Set fso = CreateObject("Scripting.FileSystemObject")
' FILE 1: 8 RIGHE (4 QUADRANTI + 4 CONVERGENTI)
sNomeFile = sPercorsoDesktop & "01_Quadranti_8Righe_" & SiglaRuota(nRuota) & "_Estr_" & nFine & ".txt"
On Error Resume Next
Set fFile = fso.CreateTextFile(sNomeFile,True)
If Err.Number = 0 Then
fFile.WriteLine(sExp_QFM)
fFile.WriteLine(sExp_Qfm_min)
fFile.WriteLine(sExp_QRM)
fFile.WriteLine(sExp_Qrm_min)
fFile.WriteLine(sExp_Conv1)
fFile.WriteLine(sExp_Conv2)
fFile.WriteLine(sExp_Conv3)
fFile.WriteLine(sExp_Conv4)
fFile.Close
Call Scrivi(" -> [01] File 8 Righe salvato: " & sNomeFile,True)
End If
On Error GoTo 0
' MATRICE 22 (13 colonne)
sNomeFile = sPercorsoDesktop & "02_Matrice_C66_22_13colonne_" & SiglaRuota(nRuota) & "_Estr_" & nFine & ".txt"
Call SviluppaMatrice22(aMiglioreComboDiOggi,sNomeFile)
' MATRICE 11 (48 colonne)
sNomeFile = sPercorsoDesktop & "03_Matrice_C66_11_48colonne_" & SiglaRuota(nRuota) & "_Estr_" & nFine & ".txt"
Call SviluppaMatrice11(aMiglioreComboDiOggi,sNomeFile)
' MATRICE 6 (143 colonne)
sNomeFile = sPercorsoDesktop & "04_Matrice_C66_6_143colonne_" & SiglaRuota(nRuota) & "_Estr_" & nFine & ".txt"
Call SviluppaMatrice6(aMiglioreComboDiOggi,sNomeFile)
' MATRICE 3 (726 terzine)
sNomeFile = sPercorsoDesktop & "05_Matrice_C66_3_726terzine_" & SiglaRuota(nRuota) & "_Estr_" & nFine & ".txt"
Call SviluppaMatrice3(aMiglioreComboDiOggi,sNomeFile)
' FILE 6: TUTTI I 4 QUADRANTI INSIEME
sNomeFile = sPercorsoDesktop & "06_Quadranti_Tutti4_" & SiglaRuota(nRuota) & "_Estr_" & nFine & ".txt"
On Error Resume Next
Set fFile = fso.CreateTextFile(sNomeFile,True)
If Err.Number = 0 Then
fFile.WriteLine(sExp_QFM)
fFile.WriteLine(sExp_Qfm_min)
fFile.WriteLine(sExp_QRM)
fFile.WriteLine(sExp_Qrm_min)
fFile.Close
Call Scrivi(" -> [06] File 4 Quadranti Insieme salvato: " & sNomeFile,True)
End If
On Error GoTo 0
' FILE 7: COPPIA QUADRANTI FREQUENZA
sNomeFile = sPercorsoDesktop & "07_Quadranti_Frequenza_QFM_Qfm_" & SiglaRuota(nRuota) & "_Estr_" & nFine & ".txt"
On Error Resume Next
Set fFile = fso.CreateTextFile(sNomeFile,True)
If Err.Number = 0 Then
fFile.WriteLine(sExp_QFM)
fFile.WriteLine(sExp_Qfm_min)
fFile.Close
Call Scrivi(" -> [07] File Quadranti Frequenza salvato: " & sNomeFile,True)
End If
On Error GoTo 0
' FILE 8: COPPIA QUADRANTI RITARDO
sNomeFile = sPercorsoDesktop & "08_Quadranti_Ritardo_QRM_Qrm_" & SiglaRuota(nRuota) & "_Estr_" & nFine & ".txt"
On Error Resume Next
Set fFile = fso.CreateTextFile(sNomeFile,True)
If Err.Number = 0 Then
fFile.WriteLine(sExp_QRM)
fFile.WriteLine(sExp_Qrm_min)
fFile.Close
Call Scrivi(" -> [08] File Quadranti Ritardo salvato: " & sNomeFile,True)
End If
On Error GoTo 0
' FILE 9: QUADRANTE SINGOLO QFM
sNomeFile = sPercorsoDesktop & "09_Quadrante_Singolo_QFM_" & SiglaRuota(nRuota) & "_Estr_" & nFine & ".txt"
On Error Resume Next
Set fFile = fso.CreateTextFile(sNomeFile,True)
If Err.Number = 0 Then
fFile.WriteLine(sExp_QFM)
fFile.Close
Call Scrivi(" -> [09] File Singolo QFM salvato: " & sNomeFile,True)
End If
On Error GoTo 0
' FILE 10: QUADRANTE SINGOLO Qfm
sNomeFile = sPercorsoDesktop & "10_Quadrante_Singolo_Qfm_" & SiglaRuota(nRuota) & "_Estr_" & nFine & ".txt"
On Error Resume Next
Set fFile = fso.CreateTextFile(sNomeFile,True)
If Err.Number = 0 Then
fFile.WriteLine(sExp_Qfm_min)
fFile.Close
Call Scrivi(" -> [10] File Singolo Qfm salvato: " & sNomeFile,True)
End If
On Error GoTo 0
' FILE 11: QUADRANTE SINGOLO QRM
sNomeFile = sPercorsoDesktop & "11_Quadrante_Singolo_QRM_" & SiglaRuota(nRuota) & "_Estr_" & nFine & ".txt"
On Error Resume Next
Set fFile = fso.CreateTextFile(sNomeFile,True)
If Err.Number = 0 Then
fFile.WriteLine(sExp_QRM)
fFile.Close
Call Scrivi(" -> [11] File Singolo QRM salvato: " & sNomeFile,True)
End If
On Error GoTo 0
' FILE 12: QUADRANTE SINGOLO Qrm
sNomeFile = sPercorsoDesktop & "12_Quadrante_Singolo_Qrm_" & SiglaRuota(nRuota) & "_Estr_" & nFine & ".txt"
On Error Resume Next
Set fFile = fso.CreateTextFile(sNomeFile,True)
If Err.Number = 0 Then
fFile.WriteLine(sExp_Qrm_min)
fFile.Close
Call Scrivi(" -> [12] File Singolo Qrm salvato: " & sNomeFile,True)
End If
On Error GoTo 0
' FILE 13: FILE DEDICATO AI COLLIMANTI FULL INCMAX III
If cCollimantiFull > 0 Then
sNomeFile = sPercorsoDesktop & "13_Collimanti_Full_INCMAX3_" & SiglaRuota(nRuota) & "_Estr_" & nFine & ".txt"
On Error Resume Next
Set fFile = fso.CreateTextFile(sNomeFile,True)
If Err.Number = 0 Then
fFile.WriteLine(sExp_CollimantiFull)
fFile.Close
Call Scrivi(" -> [13] File Collimanti FULL INCMAX III salvato: " & sNomeFile,True)
End If
On Error GoTo 0
End If
' FILE 14: MIGLIOR QUADRANTE TEORICO ATTUALE
If bEseguiBacktest And nCasiTestatiQ_BT > 0 Then
sNomeFile = sPercorsoDesktop & "14_Miglior_Quadrante_C33_" & SiglaRuota(nRuota) & "_Estr_" & nFine & ".txt"
On Error Resume Next
Set fFile = fso.CreateTextFile(sNomeFile,True)
If Err.Number = 0 Then
fFile.WriteLine(sBestQComboStr)
fFile.Close
Call Scrivi(" -> [14] File Miglior Quadrante Teorico salvato: " & sNomeFile,True)
End If
On Error GoTo 0
End If
Call Scrivi("")
Call Scrivi("TUTTI I 14 FILE TXT PULITI SONO STATI GENERATI SUL DESKTOP!",True)
Call Scrivi("==========================================================================================",True)
Call Scrivi("")
End If
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 COMBINAZIONI, QUADRANTI, GDP2 & MOTORE INCMAX III DOC v3.1",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
' ==================================================================
' SUB AUSILIARIE DI GENERAZIONE FILE TXT PULITI (SOLO NUMERI)
' ==================================================================
Sub SostituisciEStampa(sBloccoRighe,aNumeriBase,sTitolo,sFileDestinazione)
Dim aRighe
Dim aIndici
Dim aComboRisultante
Dim rigaIdx
Dim elemIdx
Dim sRigaOut
Dim nIndicePos
Dim fsoSub
Dim fFileSub
Dim bSubFileOk
bSubFileOk = False
On Error Resume Next
Set fsoSub = CreateObject("Scripting.FileSystemObject")
Set fFileSub = fsoSub.CreateTextFile(sFileDestinazione,True)
If Err.Number = 0 Then
bSubFileOk = True
End If
On Error GoTo 0
Call Scrivi("--- " & sTitolo & " ---",True)
aRighe = Split(sBloccoRighe,"|")
For rigaIdx = 0 To UBound(aRighe)
If Trim(aRighe(rigaIdx)) <> "" Then
aIndici = Split(Trim(aRighe(rigaIdx))," ")
ReDim aComboRisultante(UBound(aIndici) + 1)
For elemIdx = 0 To UBound(aIndici)
nIndicePos = CInt(aIndici(elemIdx))
aComboRisultante(elemIdx + 1) = aNumeriBase(nIndicePos)
Next
Call OrdinaMatrice(aComboRisultante,1)
sRigaOut = StringaNumeri(aComboRisultante,".")
Call Scrivi(sRigaOut)
If bSubFileOk Then
fFileSub.WriteLine(sRigaOut)
End If
End If
Next
If bSubFileOk Then
fFileSub.Close
Set fFileSub = Nothing
Set fsoSub = Nothing
Call Scrivi(" -> File salvato: " & sFileDestinazione,True)
End If
Call Scrivi("")
End Sub
Sub SviluppaMatrice22(aNumeriBase,sFileDestinazione)
Dim sM22
sM22 = ""
sM22 = sM22 & "1 2 3 4 10 15 17 18 19 21 32 34 35 36 37 43 48 50 51 52 54 65|"
sM22 = sM22 & "1 4 5 11 12 15 18 20 23 24 33 34 37 38 44 45 48 51 53 56 57 66|"
sM22 = sM22 & "1 4 6 16 18 22 25 26 29 30 31 34 37 39 49 51 55 58 59 62 63 64|"
sM22 = sM22 & "1 4 7 8 9 13 14 18 19 27 28 34 37 40 41 42 46 47 51 52 60 61|"
sM22 = sM22 & "2 3 6 8 10 17 20 21 25 28 30 35 36 39 41 43 50 53 54 58 61 63|"
sM22 = sM22 & "2 5 9 13 14 17 21 24 26 29 33 35 38 42 46 47 50 54 57 59 62 66|"
sM22 = sM22 & "2 7 11 12 16 17 21 22 23 27 31 35 40 44 45 49 50 54 55 56 60 64|"
sM22 = sM22 & "3 5 8 10 16 19 22 24 28 31 33 36 38 41 43 49 52 55 57 61 64 66|"
sM22 = sM22 & "3 7 10 14 19 20 25 26 27 29 30 36 40 43 47 52 53 58 59 60 62 63|"
sM22 = sM22 & "3 9 10 11 12 13 14 15 23 25 30 36 42 43 44 45 46 47 48 56 58 63|"
sM22 = sM22 & "5 6 7 13 15 24 25 27 30 32 33 38 39 40 46 48 57 58 60 63 65 66|"
sM22 = sM22 & "6 8 11 12 15 19 23 26 28 29 32 39 41 44 45 48 52 56 59 61 62 65|"
sM22 = sM22 & "6 9 10 13 14 15 16 20 22 31 32 39 42 43 46 47 48 49 53 55 64 65|"
Call SostituisciEStampa(sM22,aNumeriBase,"SISTEMA GDP2: C(66,22,2) = 13 COMBINAZIONI DA 22 NUMERI",sFileDestinazione)
End Sub
Sub SviluppaMatrice11(aNumeriBase,sFileDestinazione)
Dim sM11
sM11 = ""
sM11 = sM11 & "1 2 13 17 23 35 40 41 47 54 63|"
sM11 = sM11 & "1 3 11 12 30 32 33 34 48 50 54|"
sM11 = sM11 & "1 4 6 22 24 37 45 53 54 57 65|"
sM11 = sM11 & "1 5 14 19 28 33 35 54 59 60 61|"
sM11 = sM11 & "1 7 16 21 27 43 49 54 56 62 66|"
sM11 = sM11 & "1 8 18 20 25 31 36 46 54 59 64|"
sM11 = sM11 & "1 9 10 14 26 38 39 42 52 54 58|"
sM11 = sM11 & "1 15 17 23 29 35 44 51 54 55 62|"
sM11 = sM11 & "2 3 7 14 22 32 37 41 42 49 63|"
sM11 = sM11 & "2 4 11 18 26 41 45 46 50 52 63|"
sM11 = sM11 & "2 5 15 19 28 29 41 44 51 55 63|"
sM11 = sM11 & "2 6 21 25 33 36 41 43 48 53 63|"
sM11 = sM11 & "2 8 9 12 16 27 31 34 39 41 63|"
sM11 = sM11 & "2 10 20 24 38 41 56 63 64 65 66|"
sM11 = sM11 & "2 17 30 41 57 58 59 60 61 62 63|"
sM11 = sM11 & "3 4 16 20 23 27 32 40 45 60 64|"
sM11 = sM11 & "3 5 13 19 24 28 40 45 48 50 62|"
sM11 = sM11 & "3 6 8 31 32 44 53 55 56 58 66|"
sM11 = sM11 & "3 8 13 15 26 31 32 47 51 52 57|"
sM11 = sM11 & "3 9 24 25 29 32 36 39 61 62 65|"
sM11 = sM11 & "3 10 17 18 21 32 35 38 43 46 59|"
sM11 = sM11 & "4 5 11 18 19 26 28 46 47 52 62|"
sM11 = sM11 & "4 7 12 15 29 34 45 49 51 58 59|"
sM11 = sM11 & "4 8 14 21 23 31 40 42 43 45 61|"
sM11 = sM11 & "4 9 17 33 35 39 45 48 56 57 66|"
sM11 = sM11 & "4 10 13 25 30 36 38 44 45 47 55|"
sM11 = sM11 & "5 6 19 27 28 36 42 53 56 58 64|"
sM11 = sM11 & "5 7 12 19 23 28 30 34 37 43 66|"
sM11 = sM11 & "5 8 10 16 19 21 22 28 31 32 57|"
sM11 = sM11 & "5 9 17 19 20 25 28 38 39 49 65|"
sM11 = sM11 & "6 7 9 13 18 39 46 47 49 53 60|"
sM11 = sM11 & "6 10 11 15 16 27 38 50 51 53 61|"
sM11 = sM11 & "6 12 14 17 20 34 35 42 53 62 64|"
sM11 = sM11 & "6 23 26 29 30 40 52 53 56 59 66|"
sM11 = sM11 & "7 8 11 17 24 30 31 35 49 50 65|"
sM11 = sM11 & "7 10 12 23 25 34 36 38 40 49 57|"
sM11 = sM11 & "7 20 26 33 44 48 49 52 55 61 64|"
sM11 = sM11 & "8 10 22 29 31 33 37 38 48 60 62|"
sM11 = sM11 & "9 11 22 23 37 39 40 44 50 55 59|"
sM11 = sM11 & "9 15 20 21 22 30 37 39 43 51 64|"
sM11 = sM11 & "11 13 20 21 29 43 47 50 57 58 64|"
sM11 = sM11 & "11 14 15 25 36 42 50 51 56 60 66|"
sM11 = sM11 & "12 13 18 22 34 37 46 47 56 61 66|"
sM11 = sM11 & "12 21 24 26 34 43 44 52 55 60 65|"
sM11 = sM11 & "13 14 16 24 27 33 42 47 48 59 65|"
sM11 = sM11 & "14 16 18 27 29 30 42 44 46 55 57|"
sM11 = sM11 & "15 18 23 24 33 40 46 48 51 58 65|"
sM11 = sM11 & "16 17 22 25 26 27 35 36 37 52 58|"
Call SostituisciEStampa(sM11,aNumeriBase,"SISTEMA GDP2: C(66,11,2) = 48 COMBINAZIONI DA 11 NUMERI",sFileDestinazione)
End Sub
Sub SviluppaMatrice6(aNumeriBase,sFileDestinazione)
Dim sM6
sM6 = ""
sM6 = sM6 & "1 2 3 4 5 66|1 6 25 26 40 58|1 7 28 39 45 56|1 8 27 34 50 57|1 9 22 44 51 62|1 10 30 32 42 47|"
sM6 = sM6 & "1 11 17 38 49 55|1 12 16 24 37 59|1 13 18 36 54 64|1 14 23 52 60 63|1 15 33 41 46 65|1 19 29 31 43 48|"
sM6 = sM6 & "1 20 21 35 53 61|2 6 14 27 49 56|2 7 26 35 55 57|2 8 15 20 28 58|2 9 25 32 41 48|2 10 13 16 29 38|"
sM6 = sM6 & "2 11 18 37 44 60|2 12 17 36 45 65|2 19 22 53 59 63|2 21 30 50 52 62|2 23 34 40 51 61|2 24 31 42 46 54|"
sM6 = sM6 & "2 33 39 43 47 64|3 6 19 28 57 65|3 7 24 27 58 64|3 8 26 44 54 56|3 9 13 17 34 37|3 10 15 23 53 62|"
sM6 = sM6 & "3 11 16 35 36 50|3 12 18 25 30 38|3 14 20 31 41 47|3 21 39 49 51 63|3 22 29 45 52 61|3 32 40 43 46 59|"
sM6 = sM6 & "3 33 42 48 55 60|4 6 18 23 41 59|4 7 38 44 48 52|4 8 12 29 32 63|4 9 30 40 54 65|4 10 21 31 37 58|"
sM6 = sM6 & "4 11 22 26 34 47|4 13 42 50 53 56|4 14 16 28 33 51|4 15 19 24 45 55|4 17 39 46 57 61|4 20 27 36 43 62|"
sM6 = sM6 & "4 25 35 49 60 64|5 6 20 38 46 51|5 7 17 22 41 50|5 8 11 24 33 62|5 9 14 35 45 59|5 10 18 48 57 63|"
sM6 = sM6 & "5 12 21 28 47 54|5 13 43 52 58 65|5 15 29 40 44 49|5 16 26 32 53 64|5 19 30 34 39 60|5 23 31 36 55 56|"
sM6 = sM6 & "5 25 27 37 42 61|6 7 8 9 10 66|6 11 30 31 45 63|6 12 33 44 50 61|6 13 32 39 55 62|6 15 35 37 47 52|"
sM6 = sM6 & "6 16 22 43 54 60|6 17 21 29 42 64|6 24 34 36 48 53|7 11 19 32 54 61|7 12 31 40 60 62|7 13 20 25 33 63|"
sM6 = sM6 & "7 14 30 37 46 53|7 15 18 21 34 43|7 16 23 42 49 65|7 29 36 47 51 59|8 13 31 49 59 61|8 14 18 22 39 42|"
sM6 = sM6 & "8 16 21 40 41 55|8 17 23 30 35 43|8 19 25 36 46 52|8 37 45 48 51 64|8 38 47 53 60 65|9 11 23 28 46 64|"
sM6 = sM6 & "9 12 43 49 53 57|9 15 26 36 42 63|9 16 27 31 39 52|9 18 47 55 58 61|9 19 21 33 38 56|9 20 24 29 50 60|"
sM6 = sM6 & "10 11 25 43 51 56|10 12 22 27 46 55|10 14 19 40 50 64|10 17 26 33 52 59|10 20 34 45 49 54|10 24 35 39 44 65|"
sM6 = sM6 & "10 28 36 41 60 61|11 12 13 14 15 66|11 20 40 42 52 57|11 21 27 48 59 65|11 29 39 41 53 58|12 19 35 42 51 58|"
sM6 = sM6 & "12 20 23 26 39 48|12 34 41 52 56 64|13 19 23 27 44 47|13 21 26 45 46 60|13 22 28 35 40 48|13 24 30 41 51 57|"
sM6 = sM6 & "14 17 48 54 58 62|14 21 32 36 44 57|14 24 26 38 43 61|14 25 29 34 55 65|15 16 30 48 56 61|15 17 27 32 51 60|"
sM6 = sM6 & "15 22 31 38 57 64|15 25 39 50 54 59|16 17 18 19 20 66|16 25 45 47 57 62|16 34 44 46 58 63|17 24 40 47 56 63|"
sM6 = sM6 & "17 25 28 31 44 53|18 24 28 32 49 52|18 26 31 50 51 65|18 27 33 40 45 53|18 29 35 46 56 62|19 26 37 41 49 62|"
sM6 = sM6 & "20 22 32 37 56 65|20 30 44 55 59 64|21 22 23 24 25 66|22 30 33 36 49 58|23 29 33 37 54 57|23 32 38 45 50 58|"
sM6 = sM6 & "26 27 28 29 30 66|27 35 38 41 54 63|28 34 38 42 59 62|28 37 43 50 55 63|31 32 33 34 35 66|36 37 38 39 40 66|"
sM6 = sM6 & "41 42 43 44 45 66|46 47 48 49 50 66|51 52 53 54 55 66|56 57 58 59 60 66|61 62 63 64 65 66|"
Call SostituisciEStampa(sM6,aNumeriBase,"SISTEMA GDP2: C(66,6,2) = 143 COMBINAZIONI DA 6 NUMERI",sFileDestinazione)
End Sub
Sub SviluppaMatrice3(aNumeriBase,sFileDestinazione)
Dim sM3
sM3 = ""
sM3 = sM3 & "1 2 3|1 4 8|1 5 33|1 6 13|1 7 29|1 9 21|1 10 53|1 11 64|1 12 16|1 14 62|1 15 58|1 17 42|1 18 35|1 19 60|1 20 49|1 22 46|1 23 44|1 24 54|1 25 59|1 26 61|1 27 45|1 28 39|1 30 60|1 31 41|1 32 56|1 34 47|1 36 40|1 37 63|1 38 65|1 43 57|1 48 55|1 50 52|1 51 66|"
sM3 = sM3 & "2 4 46|2 5 12|2 6 7|2 8 27|2 9 15|2 10 11|2 13 43|2 14 39|2 16 41|2 17 24|2 18 57|2 19 48|2 20 28|2 21 42|2 22 56|2 23 59|2 24 38|2 25 63|2 26 33|2 29 62|2 30 31|2 32 53|2 34 37|2 35 60|2 36 44|2 40 61|2 45 66|2 47 58|2 49 52|2 50 51|2 54 65|2 55 64|"
sM3 = sM3 & "3 4 33|3 5 42|3 6 50|3 7 39|3 8 37|3 9 63|3 10 13|3 11 22|3 11 53|3 12 54|3 14 34|3 15 23|3 16 64|3 17 21|3 18 26|3 19 59|3 20 24|3 25 43|3 27 55|3 28 30|3 29 32|3 31 65|3 35 52|3 36 58|3 38 40|3 41 62|3 44 66|3 45 51|3 46 60|3 47 48|3 49 57|3 56 61|"
sM3 = sM3 & "4 5 34|4 6 20|4 7 55|4 9 14|4 10 57|4 11 52|4 12 20|4 13 45|4 15 28|4 16 54|4 17 29|4 18 37|4 19 27|4 21 24|4 22 43|4 23 30|4 25 26|4 31 47|4 32 59|4 35 40|4 36 51|4 38 44|4 39 62|4 41 61|4 42 64|4 48 60|4 49 53|4 50 66|4 56 58|4 63 65|"
sM3 = sM3 & "5 6 46|5 7 41|5 8 47|5 9 43|5 10 51|5 11 29|5 13 53|5 14 44|5 15 21|5 16 26|5 17 30|5 18 62|5 19 35|5 20 61|5 22 52|5 23 39|5 24 40|5 25 48|5 27 36|5 28 38|5 31 50|5 32 58|5 37 60|5 45 57|5 49 64|5 54 55|5 56 65|5 59 63|5 63 66|"
sM3 = sM3 & "6 8 27|6 9 18|6 10 35|6 11 12|6 14 21|6 15 47|6 16 66|6 17 33|6 19 39|6 22 53|6 23 54|6 24 48|6 25 50|6 26 64|6 28 58|6 29 65|6 30 44|6 31 42|6 32 63|6 34 52|6 36 59|6 37 49|6 38 60|6 40 57|6 41 51|6 43 56|6 45 55|6 61 62|"
sM3 = sM3 & "7 8 65|7 9 22|7 10 56|7 11 66|7 12 64|7 13 50|7 14 38|7 15 33|7 16 25|7 17 45|7 18 54|7 19 24|7 20 44|7 21 43|7 23 40|7 26 32|7 27 47|7 28 31|7 30 62|7 34 36|7 35 48|7 35 49|7 37 52|7 42 59|7 46 63|7 51 60|7 53 58|7 57 61|"
sM3 = sM3 & "8 9 36|8 10 54|8 11 14|8 12 57|8 13 28|8 15 42|8 16 46|8 17 51|8 18 43|8 19 66|8 20 31|8 21 56|8 22 60|8 23 25|8 24 30|8 26 35|8 29 53|8 32 34|8 33 58|8 38 55|8 39 40|8 41 44|8 45 63|8 48 61|8 49 62|8 50 64|8 52 59|"
sM3 = sM3 & "9 10 16|9 11 31|9 12 33|9 13 19|9 13 39|9 17 53|9 20 60|9 23 32|9 24 50|9 25 57|9 26 42|9 27 41|9 28 49|9 29 37|9 30 46|9 34 35|9 38 59|9 40 44|9 45 61|9 47 66|9 48 58|9 51 56|9 52 54|9 55 62|9 64 65|"
sM3 = sM3 & "10 12 17|10 14 63|10 15 49|10 18 22|10 19 62|10 20 39|10 21 58|10 23 37|10 23 41|10 24 45|10 25 42|10 26 31|10 27 44|10 28 40|10 29 30|10 32 55|10 33 50|10 34 46|10 36 47|10 38 52|10 43 48|10 59 60|10 61 64|10 65 66|"
sM3 = sM3 & "11 13 55|11 15 59|11 16 24|11 17 43|11 18 38|11 19 41|11 20 63|11 21 26|11 23 56|11 25 30|11 27 62|11 28 54|11 32 44|11 33 45|11 34 42|11 35 37|11 36 50|11 39 65|11 40 47|11 46 61|11 48 51|11 49 58|11 57 60|"
sM3 = sM3 & "12 13 48|12 14 53|12 15 56|12 18 25|12 19 21|12 22 38|12 23 50|12 24 28|12 26 43|12 27 59|12 29 66|12 30 49|12 31 32|12 32 41|12 34 45|12 35 39|12 36 60|12 37 65|12 40 42|12 44 46|12 47 62|12 51 63|12 52 55|12 58 61|"
sM3 = sM3 & "13 14 51|13 15 61|13 16 63|13 17 62|13 18 41|13 20 57|13 21 59|13 22 40|13 23 49|13 24 66|13 25 34|13 26 60|13 27 33|13 29 58|13 30 52|13 31 35|13 32 65|13 36 38|13 37 64|13 42 54|13 44 56|13 46 47|"
sM3 = sM3 & "14 15 37|14 16 58|14 17 29|14 18 47|14 19 64|14 20 25|14 22 45|14 22 61|14 23 33|14 24 36|14 26 66|14 27 30|14 28 43|14 31 59|14 32 52|14 35 41|14 40 48|14 42 46|14 49 54|14 50 55|14 56 57|14 60 65|"
sM3 = sM3 & "15 16 27|15 17 26|15 18 51|15 19 29|15 20 43|15 22 44|15 24 31|15 25 35|15 30 40|15 31 63|15 32 62|15 34 55|15 36 46|15 38 66|15 39 53|15 41 57|15 45 48|15 50 54|15 52 65|15 60 64|"
sM3 = sM3 & "16 17 60|16 18 31|16 19 38|16 20 34|16 21 62|16 22 23|16 28 29|16 30 51|16 32 39|16 33 57|16 35 55|16 36 61|16 37 40|16 42 65|16 43 52|16 44 47|16 45 50|16 48 62|16 49 56|16 53 59|"
sM3 = sM3 & "17 18 32|17 19 47|17 20 59|17 22 58|17 23 48|17 25 27|17 28 34|17 31 54|17 35 56|17 36 55|17 37 57|17 38 63|17 39 49|17 40 66|17 41 52|17 44 65|17 46 64|17 50 61|"
sM3 = sM3 & "18 19 50|18 20 48|18 21 52|18 23 27|18 24 46|18 28 61|18 29 45|18 30 34|18 33 42|18 36 56|18 39 61|18 40 60|18 44 59|18 49 66|18 53 64|18 55 63|18 58 65|"
sM3 = sM3 & "19 20 54|19 22 49|19 23 58|19 25 28|19 26 36|19 30 46|19 31 52|19 32 43|19 33 59|19 34 65|19 37 61|19 40 53|19 42 57|19 44 63|19 45 56|19 51 55|"
sM3 = sM3 & "20 21 50|20 22 65|20 23 66|20 26 45|20 27 37|20 29 40|20 30 38|20 32 35|20 33 46|20 36 62|20 41 58|20 42 47|20 51 52|20 53 55|20 56 64|"
sM3 = sM3 & "21 22 57|21 23 36|21 25 29|21 26 53|21 27 65|21 28 47|21 30 63|21 31 45|21 32 46|21 33 55|21 34 38|21 35 51|21 37 39|21 40 49|21 41 64|21 44 60|21 48 66|21 54 61|"
sM3 = sM3 & "22 24 29|22 25 55|22 26 30|22 27 31|22 28 62|22 32 37|22 33 48|22 34 66|22 35 63|22 36 42|22 39 51|22 41 54|22 47 64|22 50 59|"
sM3 = sM3 & "23 24 43|23 26 62|23 28 55|23 29 42|23 31 60|23 34 64|23 35 46|23 38 47|23 45 52|23 51 61|23 53 65|23 57 63|"
sM3 = sM3 & "24 25 64|24 26 41|24 27 53|24 32 49|24 33 51|24 34 56|24 35 57|24 37 42|24 39 52|24 44 55|24 47 59|24 58 60|24 61 63|24 62 65|"
sM3 = sM3 & "25 31 49|25 32 47|25 33 39|25 36 52|25 37 44|25 38 62|25 40 65|25 41 66|25 45 58|25 46 53|25 51 54|25 55 61|25 56 60|"
sM3 = sM3 & "26 27 46|26 28 65|26 29 52|26 34 54|26 37 48|26 38 58|26 39 44|26 40 63|26 47 55|26 49 59|26 50 57|26 51 56|"
sM3 = sM3 & "27 28 56|27 29 63|27 32 60|27 34 57|27 35 38|27 39 64|27 40 54|27 42 48|27 43 66|27 49 50|27 51 58|27 52 61|"
sM3 = sM3 & "28 32 45|28 33 41|28 35 66|28 36 63|28 37 66|28 42 44|28 46 51|28 48 53|28 50 60|28 52 57|28 59 64|"
sM3 = sM3 & "29 31 56|29 33 60|29 34 41|29 35 47|29 36 38|29 39 50|29 43 61|29 44 48|29 46 55|29 49 54|29 51 64|29 57 59|"
sM3 = sM3 & "30 32 61|30 33 35|30 36 53|30 37 45|30 39 42|30 41 48|30 43 65|30 47 57|30 50 56|30 54 59|30 55 66|30 58 64|"
sM3 = sM3 & "31 33 34|31 36 64|31 37 55|31 38 57|31 39 48|31 40 46|31 43 51|31 44 61|31 53 62|31 58 66|"
sM3 = sM3 & "32 33 54|32 36 66|32 38 64|32 40 50|32 42 51|32 48 57|"
sM3 = sM3 & "33 36 49|33 37 38|33 40 52|33 43 44|33 47 56|33 53 63|33 53 66|33 61 65|33 62 64|"
sM3 = sM3 & "34 39 60|34 40 58|34 43 58|34 44 51|34 48 49|34 50 63|34 53 61|34 59 62|"
sM3 = sM3 & "35 36 43|35 42 58|35 44 53|35 45 64|35 50 65|35 54 62|35 59 61|"
sM3 = sM3 & "36 37 41|36 39 45|36 48 54|36 57 65|"
sM3 = sM3 & "37 43 62|37 46 57|37 47 50|37 51 59|37 53 56|37 54 58|"
sM3 = sM3 & "38 39 46|38 41 56|38 42 61|38 43 54|38 45 53|38 48 50|38 49 51|"
sM3 = sM3 & "39 40 56|39 41 47|39 43 55|39 54 57|39 58 63|39 59 66|"
sM3 = sM3 & "40 41 55|40 43 64|40 45 59|40 51 62|"
sM3 = sM3 & "41 42 60|41 43 59|41 45 65|41 46 49|41 48 63|41 50 53|"
sM3 = sM3 & "42 43 53|42 45 47|42 49 63|42 50 62|42 52 66|42 55 56|"
sM3 = sM3 & "43 45 49|43 46 50|43 47 60|43 63 64|"
sM3 = sM3 & "44 45 52|44 49 65|44 50 58|44 54 64|44 57 62|"
sM3 = sM3 & "45 46 54|45 60 62|"
sM3 = sM3 & "46 48 65|46 52 56|46 58 59|46 62 66|"
sM3 = sM3 & "47 49 61|47 51 65|47 52 63|47 53 54|"
sM3 = sM3 & "48 52 64|48 56 59|"
sM3 = sM3 & "49 55 60|"
sM3 = sM3 & "51 53 57|"
sM3 = sM3 & "52 53 60|52 58 62|"
sM3 = sM3 & "54 56 66|54 60 63|"
sM3 = sM3 & "55 57 58|55 59 65|"
sM3 = sM3 & "56 62 63|"
sM3 = sM3 & "57 64 66|"
sM3 = sM3 & "60 61 66|"
Call SostituisciEStampa(sM3,aNumeriBase,"SISTEMA GDP2: C(66,3,2) = 726 COMBINAZIONI DA 3 NUMERI (TERZINE)",sFileDestinazione)
End Sub
(firmato: uno dei tanti nerd fan di cose come il canale yt omega click ecc...) 
