tigre62
Junior Member
si ferma al 2001 perchè joe ha replicato esattamente il mio metodo. Basta modificare
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.
tom's bakery
- Creatore Discussione lotto_tom75
- Data di inizio
joe
Advanced Member >PLATINUM PLUS<
Buongiorno e Buon Anno a tutte/i.
Ringrazio chi segue, chi è intervenuto e ... per le delucidazioni.
Evidentemente i risultati scarsi, portavano a considerare che l'istruzione mancante sia fondamentale
e necessaria a completare il metodo.
Come quasi sempre accade un esempio, permette di verificare la correttezza dello script.
Ho modificato quello presente al messaggio #78, aggiungendo quello che mi sembra di aver capito dai suggerimenti,
facendolo continuare sino al termine dell'archivio come richiesto da Alien.
Dunque consiglio di scaricarlo nuovamente nella versione aggiornata.
Ultima modifica:
lotto_tom75
Advanced Premium Member
Script n. 31 x lotto by me. Non so esattamente come ma nei mesi passati sono riuscito a montare questa macchinina software (script) che riesce ad analizzare la situazione statistica per qualsiasi classe, numero di ruote unite e numero di posizioni unite desiderate dal punto di vista incmax e non solo. A lei devo i successi.. della sezione "per gli amanti del 9 e 90" e di molte altri miei thread. Ho deciso dopo averla testata in lungo e largo di condividerla in questa "pasticceria" virtuale sicuro di fare un bel regalino elaborazionale a molti di voi. Con l'occasione specifico che come quasi tutte le mie creature è piuttosto "incasinata" sia a livello di struttura (comprende ad es. uno spezzettamento di codice di diversi include) che a livello di operatività (credo ci siano infatti alcune o molte ridondanze che ne inficiano la velocità massima raggiungibile). Inoltre anche se dai test per adesso non sono mai riuscito ad evidenziarne alcuno ci potrebbero essere anche errori di programmazione che ne limitano la precisione massima di analisi. Verificare quindi, come d'altronde è buona cosa fare sempre, ogni eventuale output prima di affidarsi ad esso per una eventuale giocata reale. Inoltre agli amici top scripter propongo, se hanno volontà di farlo, di cercare di ottimizzare questo "ferrarozzo" in modo da velocizzarlo e renderlo perchè no adattabile anche agli altri tipi di giochi quali million day, 10elotto, 10elotto ogni 5 minuti e superenalotto. Io ci ho provato molte volte prima di decidere di condividerne solo la versione presente per il lotto ma purtroppo non sono mai riuscito ad estenderlo appunto agli altri giochi.
code principale (richiede attraverso gli include quelli secondari sottostanti)
codice del file incluso [dim.ls]
codice del file incluso [input.ls]
codice del file incluso [generagraficoxincmaxstandard.ls]
sicuro di fare un bel regalino elaborazionale a molti di voi. Con l'occasione specifico che come quasi tutte le mie creature è piuttosto "incasinata" sia a livello di struttura (comprende ad es. uno spezzettamento di codice di diversi include) che a livello di operatività (credo ci siano infatti alcune o molte ridondanze che ne inficiano la velocità massima raggiungibile). Inoltre anche se dai test per adesso non sono mai riuscito ad evidenziarne alcuno ci potrebbero essere anche errori di programmazione che ne limitano la precisione massima di analisi. Verificare quindi, come d'altronde è buona cosa fare sempre, ogni eventuale output prima di affidarsi ad esso per una eventuale giocata reale. Inoltre agli amici top scripter propongo, se hanno volontà di farlo, di cercare di ottimizzare questo "ferrarozzo" in modo da velocizzarlo e renderlo perchè no adattabile anche agli altri tipi di giochi quali million day, 10elotto, 10elotto ogni 5 minuti e superenalotto. Io ci ho provato molte volte prima di decidere di condividerne solo la versione presente per il lotto ma purtroppo non sono mai riuscito ad estenderlo appunto agli altri giochi.code principale (richiede attraverso gli include quelli secondari sottostanti)
Codice:
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,K,nPuntatore
nPuntatore = nClasse
nTmp = aPuntatore(nPuntatore) + 1
Do While nTmp > nQNumPerRiga
nPuntatore = nPuntatore - 1
If nPuntatore <= 0 Then Exit Do
nTmp = aPuntatore(nPuntatore) + 1
Loop
If nPuntatore > 0 Then
For K = nPuntatore To nClasse
aPuntatore(K) = nTmp
Next
ReDim aComb(nClasse)
For K = 1 To nClasse
aComb(K) = aRighe(K,aPuntatore(K))
Next
nSviluppate = nSviluppate + 1
GetComb = True
Else
GetComb = False
End If
End Function
Function GetQuantitaSviluppate
GetQuantitaSviluppate = nSviluppate
End Function
Private Function AlimentArrayNumDaSvil(aNumeri)
Dim k,q
For k = 1 To UBound(aNumeri)
If aNumeri(k) Then
q = q + 1
End If
Next
AlimentArrayNumDaSvil = q
End Function
Private Sub AlimentaArrayRighe(aNumeri)
Dim nRiga,k
nQNumPerRiga =(nQNumeri - nClasse) + 1
ReDim aRighe(nClasse,nQNumPerRiga)
For nRiga = 1 To nClasse
'i = 0
For k = nRiga To(nRiga + nQNumPerRiga) - 1 '(nQNumeri - nClasse) + nRiga
' i = i + 1
' i = (k - nRiga )+1
aRighe(nRiga,(k - nRiga) + 1) = aNumeri(k)
Next
Next
End Sub
End Class
Sub Main
'Script n.31 by tom's bakery by tom - analizzatore incmax multiposizionale multiruota senza limite di classe
Dim casidiffincmaxp
casidiffincmaxp = 0
Dim estrazioneprogressiva
Dim alcolponumero
Dim sortediverifica
Dim verificaestratti
Dim esitoverifica
Dim colpidiverifica
Dim colpomassimo
Dim colpirimanentirispettocolpidiverifica
Dim colpirimanentirispettocolpomassimo
Dim casipositivi
Dim casinegativi
Dim casiattuali
Dim casitotali
Dim percentualepositiva
Dim inizioverifica
Dim fineverifica
Dim verificarerisultatisiono
Dim colpirimanentiminimi
colpirimanentiminimi = EstrazioneFin
Dim contadiffincmaxposizionalenegative
contadiffincmaxposizionalenegative = 0
Dim contacasitotali
contacasitotali = 0
verificarerisultatisiono = InputBox("verificare risultati? s/n",,"n")
Dim velocitaletturamsg
velocitaletturamsg = CInt(InputBox("velocita lettura messaggi es. 10=fast 10000=slow",,10))
Includi ".\dim.ls"
Includi ".\input.ls"
Scrivi
Scrivi "verifica diff incmax posizionale minima " & diffincmaxposizionaleminima
Scrivi
Scrivi
Scrivi "verifica diff incmax posizionale massima " & diffincmaxposizionalemassima
Scrivi
Scrivi
Scrivi "<font color=green>elaborazione effettuata con archivio lotto aggiornato al " & GetInfoEstrazione(EstrazioneFin) & "</font>"
Scrivi "A partire dall'estrazione " & GetInfoEstrazione(EstrazioneIni)
Scrivi "Numero ultime estrazioni esaminate " & EstrazioneFin - EstrazioneIni
Scrivi
Dim filesolonumeridoc
filesolonumeridoc = "filesolonumeridoc.txt"
Dim filesolonumeridocdaestrapolarefacilmente
filesolonumeridocdaestrapolarefacilmente = "filesolonumeridocdastrapolarefacilmente.txt"
If FileEsistente(filesolonumeridocdaestrapolarefacilmente) Then
Call CloseFileHandle(filesolonumeridocdaestrapolarefacilmente)
Call EliminaFile(filesolonumeridocdaestrapolarefacilmente)
End If
If FileEsistente(filesolonumeridoc) Then
Call EliminaFile(filesolonumeridoc)
End If
If FileEsistente(filereport) Then
Call EliminaFile(filereport)
End If
If FileEsistente(filecombruoteunite) Then
Call EliminaFile(filecombruoteunite)
End If
If FileEsistente(filecombposizioni) Then
Call EliminaFile(filecombposizioni)
End If
qualiruote = ScegliRuote(ruotescelte)
aposizioni = Array(0,1,2,3,4,5)
If verificarerisultatisiono = "s" Then
inizioverifica = CInt(InputBox("quante ultime estrazioni verificare ",,60))
sortediverifica = CInt(InputBox("sorte di verifica ",,1))
colpidiverifica = CInt(InputBox("colpi di verifica ",,inizioverifica - 2))
colpirimanentirispettocolpidiverifica = EstrazioneFin
colpirimanentirispettocolpomassimo = EstrazioneFin
casipositivi = 0
casinegativi = 0
casitotali = 0
Else
inizioverifica = EstrazioneFin
End If
fineverifica = EstrazioneFin
ReDim anumeri(0)
Dim tabellaofile
tabellaofile = InputBox("tabella o file",,"t")
Dim sortediricerca
sortediricerca = CInt(InputBox("sorte di ricerca ",,1))
Dim contaestrazioni
contaestrazioni = 0
Dim numerivoluti
Dim ritardorelativoaritmax
Dim diffposizionalexritpmax
Dim anum
Dim apos
Dim aruo
Dim conta
Dim rallenta
If tabellaofile = "t" Then
numerivoluti = ScegliNumeri(anumeri)
For estrazioneprogressiva = fineverifica - inizioverifica To fineverifica
contaestrazioni = contaestrazioni + 1
For Classeposizionale = quanteposizioniuniteminimo To quanteposizioniunitemassimo
coltot = InitSviluppoIntegrale(aposizioni,Classeposizionale)
If coltot > 0 Then
Do While GetCombSviluppo(acolposizionale) = True
ScriviFile filecombposizioni,StringaNumeri(acolposizionale)
Call CloseFileHandle(filecombposizioni)
Loop
End If
If ScriptInterrotto Then Exit For
Next
For numeroruoteunite = quanteruoteuniteminimo To quanteruoteunite 'ubound(ruotescelte)
coltotruoteunite = InitSviluppoIntegrale(ruotescelte,numeroruoteunite)
If coltotruoteunite > 0 Then
Do While GetCombSviluppo(acolruoteunite) = True
ScriviFile filecombruoteunite,StringaNumeri(acolruoteunite)
Call CloseFileHandle(filecombruoteunite)
Loop
End If
If ScriptInterrotto Then Exit For
Next
Call LeggiRigheFileDiTesto(filecombposizioni,aRigheposizioni)
For y = 0 To UBound(aRigheposizioni)
If aRigheposizioni(y) <> "" Then
Call SplitByChar(aRigheposizioni(y),".",aNumposizioni)
ReDim aNumposizioni(UBound(aNumposizioni))
End If
Next
Call LeggiRigheFileDiTesto(filecombruoteunite,aRigheruoteunite)
For y = 0 To UBound(aRigheruoteunite)
If aRigheruoteunite(y) <> "" Then
Call SplitByChar(aRigheruoteunite(y),".",aNumruoteunite)
ReDim aNumruoteunite(UBound(aNumruoteunite))
End If
Next
ReDim anumeriok(0)
Dim contatore
For Classe = Classedisviluppominima To Classedisviluppomassima ' IL MOTORE SENZA LIMITE DI CLASSE VA POSIZIONATO SOLO QUI...
'----------------------------------------------------------------------------------
Dim csvil
Dim nclasse
Dim collunghette
Set csvil = New clsSviluppo
Set collunghette = GetNewCollection
nclasse = Classe 'nclassescelta
' ntotlunghette = cSvil.InitSviluppo(aLunghette,nclasse)
coltotok = csvil.InitSviluppo(anumeri,nclasse)
'------------------------------------------------------------------------------------
' coltotok = InitSviluppoIntegrale(anumeri,Classe) ' <<<<<<<<<<< ' IL MOTORE SENZA LIMITE DI CLASSE VA POSIZIONATO SOLO QUI...
If coltotok > 0 Then
Do While cSvil.GetComb(anumeriok)
'Do While GetCombSviluppo(anumeriok) = True
If FileEsistente(filecombposizioni) Then
Call LeggiRigheFileDiTesto(filecombposizioni,aRigheposizioni)
End If
ReDim posizioniuniteok(UBound(aRigheposizioni))
For y = 0 To UBound(aRigheposizioni)
If aRigheposizioni(y) <> "" Then
Call SplitByChar("." & aRigheposizioni(y) & ".",".",posizioniuniteok(y))
If FileEsistente(filecombruoteunite) Then
Call LeggiRigheFileDiTesto(filecombruoteunite,aRigheruoteunite)
End If
ReDim ruoteuniteok(UBound(aRigheruoteunite))
For w = 0 To UBound(aRigheruoteunite)
If aRigheruoteunite(w) <> "" Then
Call SplitByChar("." & aRigheruoteunite(w) & ".",".",ruoteuniteok(w))
Call StatisticaFormazioneTurbo(anumeriok,ruoteuniteok(w),sortediricerca,rit,ritmax,Incmax,freq,Inizio,estrazioneprogressiva,,posizioniuniteok(y))
conta = conta + 1
Dim ritarda1
For ritarda1 = 1 To velocitaletturamsg
Call Messaggio(StringaNumeri(ruoteuniteok(w)) & "|" & StringaNumeri(posizioniuniteok(y)) & "|" & ritardoMassimorilevato & "|" & " c+ " & casipositivi & " c- " & casinegativi & " ca " & casiattuali & " clpmax " & colpomassimo & " esn " & contaestrazioni & " su " & inizioverifica & " crm " & colpirimanentiminimi & " conta " & conta)
Next
If rit > ritardoMassimorilevato Then
ritardoMassimorilevato = rit
ritardorelativoaritmax = rit
diffposizionalexritpmax = Int(ritardoMassimorilevato - ritardorelativoaritmax)
Formazioneconritardomax = StringaNumeri(anumeriok)
ruoteconritardomax = StringaNumeri(ruoteuniteok(w))
posizioniconritardomax = StringaNumeri(posizioniuniteok(y))
Call StatisticaFormazioneTurbo(anumeriok,ruoteuniteok(w),sortediricerca,ritstandard,ritmaxstandard,Incmaxstandard,freqstandard,Inizio,estrazioneprogressiva)
formazioneconrapmax = StringaNumeri(anumeriok)
Call SplitByChar("." & formazioneconrapmax & ".",".",vettorebyformazioneconrapmax)
Call StatisticaFormazioneTurbo(vettorebyformazioneconrapmax,ruoteuniteok(w),sortediricerca,ritstandard0,ritmaxstandard0,Incmaxstandard0,freqstandard0,Inizio,estrazioneprogressiva)
End If
If filtroattivato = "si" Then
diffposizionale = Int(ritmax - rit)
If diffposizionale >= diffpvolutaminima And diffposizionale <= diffpvolutamassima And Incmax >= Incmaxposizionalevolutominimo And Incmax <= Incmaxposizionalevolutomassimo Then
Call StatisticaFormazioneTurbo(anumeriok,ruoteuniteok(w),sortediricerca,ritstandard,ritmaxstandard,Incmaxstandard,freqstandard,Inizio,estrazioneprogressiva)
Call SplitByChar(StringaNumeri(anumeriok),".",anum)
Call SplitByChar(StringaNumeri(posizioniuniteok(y)),".",apos)
Call SplitByChar(StringaNumeri(ruoteuniteok(w)),".",aruo)
Call disegnagraficoincmaxposizionale(anum,apos,aruo,diffposizionale,diffposizionalexritpmax,ritardoMassimorilevato,casidiffincmaxp,filereport,estrazioneprogressiva,sortediverifica,colpidiverifica,colpomassimo,colpirimanentirispettocolpidiverifica,colpirimanentirispettocolpomassimo,casipositivi,casinegativi,casitotali,alcolponumero,verificaestratti,esitoverifica,percentualepositiva,diffincmaxposizionaleminima,diffincmaxposizionalemassima,contadiffincmaxposizionalenegative,contacasitotali,inizioverifica,fineverifica,casiattuali,colpirimanentiminimi,sortediricerca)
Else
End If
End If ' x filtro attivo si/no
For v = 0 To UBound(ruoteuniteok(w))
If ScriptInterrotto Then Exit For 'new exit
Next
For v2 = 0 To UBound(posizioniuniteok(y))
If ScriptInterrotto Then Exit For 'new exit
Next
End If
If ScriptInterrotto Then Exit For 'new exit
Next
End If
If ScriptInterrotto Then Exit For 'new exit
Next
If ScriptInterrotto Then Exit Do
Loop
End If
For rallenta = 1 To velocitaletturamsg
Call Messaggio("estr " & estrazioneprogressiva & " n. " & contaestrazioni & " di " & fineverifica -(fineverifica - inizioverifica) & " casi tot " & " c+ " & casipositivi & " c- " & casinegativi & " cdiffincmaxp0 " & casidiffincmaxp)
If ScriptInterrotto Then Exit For
Next
If ScriptInterrotto Then Exit For
Next ' x classe
Scrivi
Scrivi "range di analisi " & GetInfoEstrazione(Inizio) & "-" & GetInfoEstrazione(fine)
Scrivi "range di verifica " & GetInfoEstrazione(inizioverifica) & "-" & GetInfoEstrazione(fineverifica)
Scrivi "gruppo base analizzato " & StringaNumeri(numeri) & " classe " & UBound(numeri)
Scrivi "numeri immessi da tabella "
Scrivi "gruppo base analizzato di classe " & UBound(anumeri) '+ 1
Scrivi "classe di sviluppo minima " & Classedisviluppominima
Scrivi "classe di sviluppo massima " & Classedisviluppomassima
Scrivi "numero max formazioni integrali sviluppate " & coltotok
Scrivi "ruote analizzate " & StringaNumeri(ruotescelte)
Scrivi "ruote unite minimo " & quanteruoteuniteminimo
Scrivi "ruote unite massimo " & quanteruoteunite
Scrivi "posizioni unite minimo " & quanteposizioniuniteminimo
Scrivi "posizioni unite massimo " & quanteposizioniunitemassimo
Scrivi "sorte di ricerca " & sortediricerca
Scrivi "filtro diffp e incmaxp applicato s/n " & vuoiapplicarefiltro
Scrivi "diffp minima " & diffpvolutaminima
Scrivi "diffp massima " & diffpvolutamassima
Scrivi "incmaxp minimo " & Incmaxposizionalevolutominimo
Scrivi "incmaxp massimo " & Incmaxposizionalevolutomassimo
Scrivi "ritardo massimo rilevato generale " & ritardoMassimorilevato
Scrivi "formazione con ritardo massimo generale rilevato " & Formazioneconritardomax
Scrivi "ruote con ritardo massimo generale rilevato " & ruoteconritardomax
Scrivi "posizioni unite con ritardo massimo generale rilevato " & posizioniconritardomax
Scrivi "diff posizionale " & diffposizionalexritpmax
Scrivi "parametri standard per 5 posizioni unite " & " ra " & ritstandard0 & " rs " & ritmaxstandard0 & " incmax " & Incmaxstandard0 & " freq " & freqstandard0
Scrivi "casi diff incmaxp=0 " & casidiffincmaxp
Scrivi
Scrivi "numero di casi con incmax posizionale attuale > storico: " & contadiffincmaxposizionalenegative
Scrivi
Scrivi "numero di casi totali: " & contacasitotali
Scrivi
Scrivi "colpi rimanenti minimi: " & colpirimanentiminimi
Scrivi
Scrivi "colpo massimo: " & colpomassimo
Scrivi
Scrivi "tt " & TempoTrascorso
Scrivi
Scrivi
Scrivi "contenuto file txt report"
Scrivi
Scrivi
'-----------------
'inserire code lettura file txt solonumeridoc
'Dim anum
'Dim y
Dim c
Dim sfiletxtgrupponumerico,sfile
sfiletxtgrupponumerico = ".\filesolonumeridoc.txt"
sfile = sfiletxtgrupponumerico
Call Messaggio("Lettura file di testo")
ReDim aRighe(0)
Call LeggiRigheFileDiTesto(sfile,aRighe)
For y = 0 To UBound(aRighe)
If aRighe(y) <> "" Then
Call SplitByChar(aRighe(y),";",anum)
Scrivi StringaNumeri(anum)
Scrivi
If ScriptInterrotto Then Exit For
End If
'Scrivi
'Scrivi "contenuto file report txt "
'Scrivi
'For c = 0 To UBound(anum)
'Scrivi anum(c)
' If ScriptInterrotto Then Exit For
' Next
If ScriptInterrotto Then Exit For
Next
'-----------------
ScriviFile filereport,""
ScriviFile filereport,"gruppo base analizzato di classe " & UBound(numeri)
ScriviFile filereport,"classe di sviluppo minima " & Classedisviluppominima
ScriviFile filereport,"classe di sviluppo massima " & Classedisviluppomassima
ScriviFile filereport,"ruote unite minimo " & quanteruoteuniteminimo
ScriviFile filereport,"ruote unite massimo " & quanteruoteunite
ScriviFile filereport,"posizioni unite minimo " & quanteposizioniuniteminimo
ScriviFile filereport,"posizioni unite massimo " & quanteposizioniunitemassimo
ScriviFile filereport,"filtro diffp e incmaxp applicato s/n " & vuoiapplicarefiltro
ScriviFile filereport,"sorte di ricerca " & sortediricerca
ScriviFile filereport,"diffp minima " & diffpvolutaminima
ScriviFile filereport,"diffp massima " & diffpvolutamassima
ScriviFile filereport,"incmaxp minimo " & Incmaxposizionalevolutominimo
ScriviFile filereport,"incmaxp massimo " & Incmaxposizionalevolutomassimo
ScriviFile filereport,"ritardo massimo rilevato generale " & ritardoMassimorilevato
ScriviFile filereport,"formazione con ritardo massimo generale rilevato " & Formazioneconritardomax
ScriviFile filereport,"ruote con ritardo massimo generale rilevato " & ruoteconritardomax
ScriviFile filereport,"posizioni unite con ritardo massimo generale rilevato " & posizioniconritardomax
ScriviFile filereport,"diff posizionale " & diffposizionalexritpmax
ScriviFile filereport,"parametri standard per 5 posizioni unite xe " & " ra " & ritstandard & " rs " & ritmaxstandard & " incmax " & Incmaxstandard & " freq " & freqstandard
ScriviFile filereport,"casi diff incmaxp=0 " & casidiffincmaxp
ScriviFile filereport,""
ScriviFile filereport,"numero di casi con incmax posizionale attuale > storico: " & contadiffincmaxposizionalenegative
ScriviFile filereport,""
ScriviFile filereport,"numero di casi totali: " & contacasitotali
ScriviFile filereport,""
ScriviFile filereport,"tt " & TempoTrascorso
Call CloseFileHandle(filereport)
Call CloseFileHandle(filereportformazioniposizionali)
Call SplitByChar(Formazioneconritardomax,".",anum)
Call SplitByChar(posizioniconritardomax,".",apos)
Call SplitByChar(ruoteconritardomax,".",aruo)
' Call disegnagraficoincmaxposizionale(anum,apos,aruo,diffposizionale,diffposizionalexritpmax,ritardoMassimorilevato,casidiffincmaxp,filereport,estrazioneprogressiva,sortediverifica,colpidiverifica,colpomassimo,colpirimanentirispettocolpidiverifica,colpirimanentirispettocolpomassimo,casipositivi,casinegativi,casitotali,alcolponumero,verificaestratti,esitoverifica,percentualepositiva,diffincmaxposizionaleminima,diffincmaxposizionalemassima,contadiffincmaxposizionalenegative,contacasitotali,inizioverifica,fineverifica,casiattuali,colpirimanentiminimi,sortediricerca)
If ScriptInterrotto Then Exit For ' da verifica esiti ecc...
Next ' x verifica esiti...
Scrivi
Scrivi "c+ " & casipositivi
Scrivi "c- " & casinegativi
Scrivi "ca " & casiattuali
Scrivi "sorte di verifica " & sortediverifica
Scrivi "colpi di verifica " & colpidiverifica
Scrivi "cmax " & colpomassimo
Scrivi "es verificate " & contaestrazioni
Scrivi
Scrivi "tt " & TempoTrascorso
ScriviFile filereport,""
ScriviFile filereport,"c+ " & casipositivi
ScriviFile filereport,"c- " & casinegativi
ScriviFile filereport,"es verificate " & contaestrazioni
ScriviFile filereport,""
ScriviFile filereport,"tt " & TempoTrascorso
Else
Dim h
Dim z ' x ruoteunite
numerivoluti = ScegliFile(".\",".txt","filetxtvoluto")
filecombruoteunite = ".\filecombruoteunite.txt"
filecombposizioni = ".\filecombposizioni.txt"
filereport = ".\filereport.txt"
Dim filesolonumeridocbyanalisitxt
filesolonumeridocbyanalisitxt = ".\filesolonumeridocbyanalisitxt.txt"
If FileEsistente(filereport) Then
Call EliminaFile(filereport)
End If
If FileEsistente(filecombruoteunite) Then
Call EliminaFile(filecombruoteunite)
End If
If FileEsistente(filecombposizioni) Then
Call EliminaFile(filecombposizioni)
End If
If FileEsistente(filesolonumeridocbyanalisitxt) Then
Call EliminaFile(filesolonumeridocbyanalisitxt)
End If
filecombruoteunite = ".\filecombruoteunite.txt"
filecombposizioni = ".\filecombposizioni.txt"
filereport = ".\filereport.txt"
Call Messaggio("lettura file di testo")
ReDim aRighe(0)
Call LeggiRigheFileDiTesto(numerivoluti,aRighe)
For h = 0 To UBound(aRighe)
If aRighe(h) <> "" Then
ReDim anumeri(0)
Call SplitByChar(aRighe(h),".",anumeri)
Scrivi "<font color=red size=4>" & StringaNumeri(anumeri) & "</font>"
For estrazioneprogressiva = fineverifica - inizioverifica To fineverifica
contaestrazioni = contaestrazioni + 1
For Classeposizionale = quanteposizioniuniteminimo To quanteposizioniunitemassimo
coltot = InitSviluppoIntegrale(aposizioni,Classeposizionale)
If coltot > 0 Then
Do While GetCombSviluppo(acolposizionale) = True
ScriviFile filecombposizioni,StringaNumeri(acolposizionale)
Call CloseFileHandle(filecombposizioni)
Loop
End If
If ScriptInterrotto Then Exit For
Next
For numeroruoteunite = quanteruoteuniteminimo To quanteruoteunite 'ubound(ruotescelte)
coltotruoteunite = InitSviluppoIntegrale(ruotescelte,numeroruoteunite)
If coltotruoteunite > 0 Then
Do While GetCombSviluppo(acolruoteunite) = True
ScriviFile filecombruoteunite,StringaNumeri(acolruoteunite)
Call CloseFileHandle(filecombruoteunite)
Loop
End If
If ScriptInterrotto Then Exit For
Next
Call LeggiRigheFileDiTesto(filecombposizioni,aRigheposizioni)
For y = 0 To UBound(aRigheposizioni)
If aRigheposizioni(y) <> "" Then
Call SplitByChar(aRigheposizioni(y),".",aNumposizioni)
ReDim aNumposizioni(UBound(aNumposizioni))
End If
Next
Call LeggiRigheFileDiTesto(filecombruoteunite,aRigheruoteunite)
For z = 0 To UBound(aRigheruoteunite)
If aRigheruoteunite(z) <> "" Then
Call SplitByChar(aRigheruoteunite(z),".",aNumruoteunite)
ReDim aNumruoteunite(UBound(aNumruoteunite))
End If
Next
ReDim anumeriok(0)
For Classe = Classedisviluppominima To Classedisviluppomassima
coltotok = InitSviluppoIntegrale(anumeri,Classe)
If coltotok > 0 Then
Do While GetCombSviluppo(anumeriok) = True
If FileEsistente(filecombposizioni) Then
Call LeggiRigheFileDiTesto(filecombposizioni,aRigheposizioni)
End If
ReDim posizioniuniteok(UBound(aRigheposizioni))
For y = 0 To UBound(aRigheposizioni)
If aRigheposizioni(y) <> "" Then
Call SplitByChar("." & aRigheposizioni(y) & ".",".",posizioniuniteok(y))
If FileEsistente(filecombruoteunite) Then
Call LeggiRigheFileDiTesto(filecombruoteunite,aRigheruoteunite)
End If
ReDim ruoteuniteok(UBound(aRigheruoteunite))
For w = 0 To UBound(aRigheruoteunite)
If aRigheruoteunite(w) <> "" Then
Call SplitByChar("." & aRigheruoteunite(w) & ".",".",ruoteuniteok(w))
Call StatisticaFormazioneTurbo(anumeriok,ruoteuniteok(w),sortediricerca,rit,ritmax,Incmax,freq,Inizio,estrazioneprogressiva,,posizioniuniteok(y))
Dim ritarda2
For ritarda2 = 1 To velocitaletturamsg
Call Messaggio(StringaNumeri(ruoteuniteok(w)) & "|" & StringaNumeri(posizioniuniteok(y)) & "|" & ritardoMassimorilevato & "|" & " c+ " & casipositivi & " c- " & casinegativi & " ca " & casiattuali & " clpmax " & colpomassimo & " esn " & contaestrazioni & " su " & inizioverifica & " crm " & colpirimanentiminimi)
Next
If rit > ritardoMassimorilevato Then
ritardoMassimorilevato = rit
ritardorelativoaritmax = rit
diffposizionalexritpmax = Int(ritardoMassimorilevato - ritardorelativoaritmax)
Formazioneconritardomax = StringaNumeri(anumeriok)
ruoteconritardomax = StringaNumeri(ruoteuniteok(w))
posizioniconritardomax = StringaNumeri(posizioniuniteok(y))
Call StatisticaFormazioneTurbo(anumeriok,ruoteuniteok(w),sortediricerca,ritstandard,ritmaxstandard,Incmaxstandard,freqstandard,Inizio,estrazioneprogressiva)
formazioneconrapmax = StringaNumeri(anumeriok)
Call SplitByChar("." & formazioneconrapmax & ".",".",vettorebyformazioneconrapmax)
Call StatisticaFormazioneTurbo(vettorebyformazioneconrapmax,ruoteuniteok(w),sortediricerca,ritstandard0,ritmaxstandard0,Incmaxstandard0,freqstandard0,Inizio,estrazioneprogressiva)
End If
If filtroattivato = "si" Then
diffposizionale = Int(ritmax - rit)
If diffposizionale >= diffpvolutaminima And diffposizionale <= diffpvolutamassima And Incmax >= Incmaxposizionalevolutominimo And Incmax <= Incmaxposizionalevolutomassimo Then
Call StatisticaFormazioneTurbo(anumeriok,ruoteuniteok(w),sortediricerca,ritstandard,ritmaxstandard,Incmaxstandard,freqstandard,Inizio,estrazioneprogressiva)
Call SplitByChar(StringaNumeri(anumeriok),".",anum)
Call SplitByChar(StringaNumeri(posizioniuniteok(y)),".",apos)
Call SplitByChar(StringaNumeri(ruoteuniteok(w)),".",aruo)
Call disegnagraficoincmaxposizionale(anum,apos,aruo,diffposizionale,diffposizionalexritpmax,ritardoMassimorilevato,casidiffincmaxp,filereport,estrazioneprogressiva,sortediverifica,colpidiverifica,colpomassimo,colpirimanentirispettocolpidiverifica,colpirimanentirispettocolpomassimo,casipositivi,casinegativi,casitotali,alcolponumero,verificaestratti,esitoverifica,percentualepositiva,diffincmaxposizionaleminima,diffincmaxposizionalemassima,contadiffincmaxposizionalenegative,contacasitotali,inizioverifica,fineverifica,casiattuali,colpirimanentiminimi,sortediricerca)
Else
End If
End If ' x filtro attivo si/no
For v = 0 To UBound(ruoteuniteok(w))
If ScriptInterrotto Then Exit For 'new exit
Next
For v2 = 0 To UBound(posizioniuniteok(y))
If ScriptInterrotto Then Exit For 'new exit
Next
End If
If ScriptInterrotto Then Exit For 'new exit
Next
End If
If ScriptInterrotto Then Exit For 'new exit
Next
If ScriptInterrotto Then Exit Do
Loop
End If
For rallenta = 1 To velocitaletturamsg
Call Messaggio("estr " & estrazioneprogressiva & " n.riga " & contaestrazioni & " di " & UBound(aRighe) & " c+ " & casipositivi & " c- " & casinegativi & " cdiffincmaxp0 " & casidiffincmaxp)
If ScriptInterrotto Then Exit For
Next
Call AvanzamentoElab(1,Classedisviluppomassima,Classe)
If ScriptInterrotto Then Exit For
Next ' x classe
Scrivi
Scrivi "range di verifica " & GetInfoEstrazione(fineverifica - inizioverifica) & "-" & GetInfoEstrazione(fineverifica)
Scrivi "ultimo gruppo base analizzato " & StringaNumeri(anumeri)
Scrivi "numeri immessi da file txt "
Scrivi "file txt analizzato " & numerivoluti
Scrivi "gruppo base analizzato di classe " & UBound(anumeri) + 1
Scrivi "classe di sviluppo minima " & Classedisviluppominima
Scrivi "classe di sviluppo massima " & Classedisviluppomassima
Scrivi "ruote analizzate " & StringaNumeri(ruotescelte)
Scrivi "ruote unite minimo " & quanteruoteuniteminimo
Scrivi "ruote unite massimo " & quanteruoteunite
Scrivi "posizioni unite minimo " & quanteposizioniuniteminimo
Scrivi "posizioni unite massimo " & quanteposizioniunitemassimo
Scrivi "sorte di ricerca " & sortediricerca
Scrivi "filtro diffp e incmaxp applicato s/n " & vuoiapplicarefiltro
Scrivi "diffp minima " & diffpvolutaminima
Scrivi "diffp massima " & diffpvolutamassima
Scrivi "incmaxp minimo " & Incmaxposizionalevolutominimo
Scrivi "incmaxp massimo " & Incmaxposizionalevolutomassimo
Scrivi "ritardo massimo rilevato generale " & ritardoMassimorilevato
Scrivi "formazione con ritardo massimo generale rilevato " & Formazioneconritardomax
Scrivi "ruote con ritardo massimo generale rilevato " & ruoteconritardomax
Scrivi "posizioni unite con ritardo massimo generale rilevato " & posizioniconritardomax
Scrivi "diff posizionale " & diffposizionalexritpmax
Scrivi "parametri standard per 5 posizioni unite " & " ra " & ritstandard0 & " rs " & ritmaxstandard0 & " incmax " & Incmaxstandard0 & " freq " & freqstandard0
Scrivi "casi diff incmaxp=0 " & casidiffincmaxp
Scrivi
Scrivi "numero di casi con incmax posizionale attuale > storico: " & contadiffincmaxposizionalenegative
Scrivi
Scrivi "numero di casi totali: " & contacasitotali
Scrivi
Scrivi "colpi rimanenti minimi: " & colpirimanentiminimi
Scrivi
Scrivi "colpo massimo: " & colpomassimo
Scrivi
Scrivi "tt " & TempoTrascorso
ScriviFile filereport,""
ScriviFile filereport,"gruppo base analizzato di classe " & UBound(anumeri)
ScriviFile filereport,"classe di sviluppo minima " & Classedisviluppominima
ScriviFile filereport,"classe di sviluppo massima " & Classedisviluppomassima
ScriviFile filereport,"ruote unite minimo " & quanteruoteuniteminimo
ScriviFile filereport,"ruote unite massimo " & quanteruoteunite
ScriviFile filereport,"posizioni unite minimo " & quanteposizioniuniteminimo
ScriviFile filereport,"posizioni unite massimo " & quanteposizioniunitemassimo
ScriviFile filereport,"filtro diffp e incmaxp applicato s/n " & vuoiapplicarefiltro
ScriviFile filereport,"diffp minima " & diffpvolutaminima
ScriviFile filereport,"diffp massima " & diffpvolutamassima
ScriviFile filereport,"incmaxp minimo " & Incmaxposizionalevolutominimo
ScriviFile filereport,"incmaxp massimo " & Incmaxposizionalevolutomassimo
ScriviFile filereport,"ritardo massimo rilevato generale " & ritardoMassimorilevato
ScriviFile filereport,"formazione con ritardo massimo generale rilevato " & Formazioneconritardomax
ScriviFile filereport,"ruote con ritardo massimo generale rilevato " & ruoteconritardomax
ScriviFile filereport,"posizioni unite con ritardo massimo generale rilevato " & posizioniconritardomax
ScriviFile filereport,"diff posizionale " & diffposizionalexritpmax
ScriviFile filereport,"parametri standard per 5 posizioni unite xe " & " ra " & ritstandard & " rs " & ritmaxstandard & " incmax " & Incmaxstandard & " freq " & freqstandard
ScriviFile filereport,"casi diff incmaxp=0 " & casidiffincmaxp
ScriviFile filereport,""
ScriviFile filereport,"numero di casi con incmax posizionale attuale > storico: " & contadiffincmaxposizionalenegative
ScriviFile filereport,""
ScriviFile filereport,"numero di casi totali: " & contacasitotali
ScriviFile filereport,""
ScriviFile filereport,"tt " & TempoTrascorso
Call ScriviFile(filesolonumeridocbyanalisitxt,Formazioneconritardomax & " r: " & StringaRuote(aruo) & " p: " & StringaNumeri(apos))
Call CloseFileHandle(filesolonumeridocbyanalisitxt)
Call CloseFileHandle(filereport)
Call CloseFileHandle(filereportformazioniposizionali)
Call SplitByChar(Formazioneconritardomax,".",anum)
Call SplitByChar(posizioniconritardomax,".",apos)
Call SplitByChar(ruoteconritardomax,".",aruo)
Call disegnagraficoincmaxposizionale(anum,apos,aruo,diffposizionale,diffposizionalexritpmax,ritardoMassimorilevato,casidiffincmaxp,filereport,estrazioneprogressiva,sortediverifica,colpidiverifica,colpomassimo,colpirimanentirispettocolpidiverifica,colpirimanentirispettocolpomassimo,casipositivi,casinegativi,casitotali,alcolponumero,verificaestratti,esitoverifica,percentualepositiva,diffincmaxposizionaleminima,diffincmaxposizionalemassima,contadiffincmaxposizionalenegative,contacasitotali,inizioverifica,fineverifica,casiattuali,colpirimanentiminimi,sortediricerca)
If ScriptInterrotto Then Exit For ' da verifica esiti ecc...
Next ' x verifica esiti...
Scrivi
Scrivi "c+ " & casipositivi
Scrivi "c- " & casinegativi
Scrivi "ca " & casiattuali
Scrivi "sorte di verifica " & sortediverifica
Scrivi "colpi di verifica " & colpidiverifica
Scrivi "cmax " & colpomassimo
Scrivi "es verificate " & contaestrazioni
Scrivi
Scrivi "tt " & TempoTrascorso
ScriviFile filereport,""
ScriviFile filereport,"c+ " & casipositivi
ScriviFile filereport,"c- " & casinegativi
ScriviFile filereport,"es verificate " & contaestrazioni
ScriviFile filereport,""
ScriviFile filereport,"tt " & TempoTrascorso
End If
If ScriptInterrotto Then Exit For
Next ' fine lettura file x anumeri...
End If ' x fine scelta tabella o file
End Sub
Function selesito
Dim ret
Dim avoci
For ret = 1 To 1
selesito = ret
Next
End Function
Class clsparstat
Dim idestr
Dim ritmax
Dim incrritmax
End Class
Includi ".\generagraficoxincmaxstandard.ls"
Sub gestioneoutput(coll,ritmax,an,sorte,inizio,fine,ruota,rit,fre,aruotesel)
Dim x,y,k
Dim sfrz
Dim clsp
For k = 1 To 90
If an(k) Then
sfrz = sfrz & Format2(k) & "."
End If
Next
sfrz = Left(sfrz,Len(sfrz) - 1)
If ruota = 13 Then
Call Scrivi("sulla ruota di : " & getstringaruote(aruotesel))
Else
Call Scrivi("sulla ruota di : " & NomeRuota(ruota))
End If
Call Scrivi("classe di sviluppo : " & "quella decisa")
Call Scrivi("sorte ricercata : " & sorte)
Call Scrivi("formazione analizzata : " & sfrz)
Call Scrivi("da estrazione : " & GetInfoEstrazione(inizio))
Call Scrivi("a estrazione : " & GetInfoEstrazione(fine))
Call Scrivi
Call Scrivi("ritardo : " & rit)
Call Scrivi("ritardomax : " & ritmax)
Call Scrivi("frequenza : " & fre)
Call Scrivi
Call Scrivi("dettaglio evoluzione ritmax",True)
For Each clsp In coll
Call Scrivi("estrazione : " & FormatSpace(clsp.idestr,5,True) & _
" ritmax : " & FormatSpace(clsp.ritmax,5,True) & _
" inccrritmax : " & FormatSpace(clsp.incrritmax,5,True))
Next
Call Scrivi
Call Scrivi("grafico di confronto ritmax / incritmax",True)
Call PreparaGrafico("",,,,,1,5)
ReDim av(coll.count,2)
For Each clsp In coll
x = x + 1
av(x,1) = x
av(x,2) = clsp.ritmax
Next
Call DisegnaLineaGrafico(av,vbBlue,"ritmax")
x = 0
ReDim av(coll.count,2)
For Each clsp In coll
x = x + 1
av(x,1) = x
av(x,2) = clsp.incrritmax
Next
Call DisegnaLineaGrafico(av,vbRed,"incritmax")
Call InserisciGrafico
End Sub 'function
Class clslunghetta
Private anumeri
Private aposizione(1) ' aggiunto valore di posizione
Private minizio,mfine,aruote,msorte
Private mclasse
Private aelencorit
Private aidestrelencorit
Private aelencoincrritmax
Private aidestrincrritmax
Private aritardiallincremento
Private mritardo,mritardomax,mincrritmax,mfrequenza
Private mincrritardomaxsto,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,aposizione)
minizio = rangeinizio
mfine = rangefine
aruote = vetruote
msorte = sorteingioco
Call alimentavettorelunghetta(slunghetta,schrsep)
Call ElencoRitardi(anumeri,aruote,msorte,minizio,mfine,aelencorit,aidestrelencorit)
Call alimentavettoreincrritmax
End Sub
Sub eseguistatistica(aposizione)
Call StatisticaFormazioneTurbo(anumeri,aruote,msorte,mritardo,mritardomax,mincrritmax,mfrequenza,minizio,mfine,,aposizione)
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,nincr,nid,k
Dim nupper
nid = 0
ReDim aelencoincrritmax(0)
ReDim aidestrincrritmax(0)
ReDim aritardiallincremento(0)
aelencoincrritmax(0) = aelencorit(1)
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 = StringaNumeri(aelencoincrritmax,,True)
nupper = UBound(aelencoincrritmax)
mincrritardomaxsto = MassimoV(aelencoincrritmax,1,nupper - 1)
End Sub
Sub disegnagraficoincrritmax
Dim x,y,k
Dim nvaloremaxx,nvaloremaxy,nvaloreminx
Dim nstepx,nstepy
Dim nuppervetincrrit
nvaloreminx = MinimoV(aidestrincrritmax,1)
nvaloremaxx = aidestrincrritmax(UBound(aidestrincrritmax))
nvaloremaxy = MassimoV(aelencorit,1)
nstepx =(nvaloremaxx -(minizio - 1)) \10
nstepy = nvaloremaxy \10
Call PreparaGrafico("formazione " & StringaNumeri(anumeri),nvaloreminx,nvaloremaxx,0,nvaloremaxy,nstepx,nstepy)
nuppervetincrrit = UBound(aelencoincrritmax)
ReDim av(nuppervetincrrit - 1,2)
For k = 1 To nuppervetincrrit'+1
x = aidestrincrritmax(k)'+1
y = aelencoincrritmax(k)
av(k - 1,1) = x
av(k - 1,2) = y
Next
Call DisegnaLineaGrafico(av,vbRed,"incrritmax")
ReDim av(nuppervetincrrit - 1,2)
For k = 1 To nuppervetincrrit
x = aidestrincrritmax(k)
y = aritardiallincremento(k)
av(k - 1,1) = x
av(k - 1,2) = y
Next
Call DisegnaLineaGrafico(av,vbBlue,"ritmax")
Call InserisciGrafico
End Sub
End Class
Function disegnagraficoincmaxposizionale(anum,apos,aruo,diffposizionale,diffposizionalexritpmax,ritardomassimorilevato,casidiffincmaxp,filereport,estrazioneprogressiva,sortediverifica,colpidiverifica,colpomassimo,colpirimanentirispettocolpidiverifica,colpirimanentirispettocolpomassimo,casipositivi,casinegativi,casitotali,alcolponumero,verificaestratti,esitoverifica,percentualepositiva,diffincmaxposizionaleminima,diffincmaxposizionalemassima,contadiffincmaxposizionalenegative,contacasitotali,inizioverifica,fineverifica,casiattuali,colpirimanentiminimi,sortediricerca) 'sub main
Dim StringaIncrementiComplessivi
Dim vettoreincrementicomplessivi
Dim numeroincrementicomplessivi
Dim inizio,fine,sorte,clsl,an,schrsep,k,sfrz
Dim aposizione(5)
Dim quanteposizioniunite
Dim vettorenumeroposizionipulitodaipunti
Dim stringapulita
stringapulita = StringaNumeri(apos)
Dim lenght
lenght = Len(stringapulita)
Dim captured_string
captured_string = Mid(stringapulita,2,lenght)'left(stringapulita)
Dim lenght2
lenght2 = Len(captured_string)
Dim captured_string2
captured_string2 = Mid(captured_string,1,lenght2 - 1)'left(stringapulita)
Call SplitByChar(captured_string2,".",vettorenumeroposizionipulitodaipunti)
quanteposizioniunite = UBound(vettorenumeroposizionipulitodaipunti) + 1 'cint(inputbox("quante posizioni unite",,ubound(vettorenumeroposizionipulitodaipunti) + 1))
Select Case(quanteposizioniunite)
Case 1
aposizione(1) = vettorenumeroposizionipulitodaipunti(0) '4 ' apos(1) 'cint(inputbox("posizione da analizzare",,1))
Case 2
aposizione(1) = vettorenumeroposizionipulitodaipunti(0)'cint(inputbox("prima posizione da analizzare",,1))
aposizione(2) = vettorenumeroposizionipulitodaipunti(1)'cint(inputbox("seconda posizione da analizzare",,2))
Case 3
aposizione(1) = vettorenumeroposizionipulitodaipunti(0)'cint(inputbox("prima posizione da analizzare",,1))
aposizione(2) = vettorenumeroposizionipulitodaipunti(1)'cint(inputbox("seconda posizione da analizzare",,2))
aposizione(3) = vettorenumeroposizionipulitodaipunti(2)'cint(inputbox("terza posizione da analizzare",,3))
Case 4
aposizione(1) = vettorenumeroposizionipulitodaipunti(0)'cint(inputbox("prima posizione da analizzare",,1))
aposizione(2) = vettorenumeroposizionipulitodaipunti(1)'cint(inputbox("seconda posizione da analizzare",,3))
aposizione(3) = vettorenumeroposizionipulitodaipunti(2)'cint(inputbox("terza posizione da analizzare",,4))
aposizione(4) = vettorenumeroposizionipulitodaipunti(3)'cint(inputbox("quarta posizione da analizzare",,5))
Case 5
aposizione(1) = vettorenumeroposizionipulitodaipunti(0)'cint(inputbox("prima posizione da analizzare",,1))
aposizione(2) = vettorenumeroposizionipulitodaipunti(1)'cint(inputbox("seconda posizione da analizzare",,2))
aposizione(3) = vettorenumeroposizionipulitodaipunti(2)'cint(inputbox("terza posizione da analizzare",,3))
aposizione(4) = vettorenumeroposizionipulitodaipunti(3)'cint(inputbox("quarta posizione da analizzare",,4))
aposizione(5) = vettorenumeroposizionipulitodaipunti(4)'cint(inputbox("quinta posizione da analizzare",,5))
End Select
Dim vettorenumeroruotepulitodaipunti
Dim stringapulitaxruote
stringapulitaxruote = StringaNumeri(aruo)
Dim lenghtxruote
lenghtxruote = Len(stringapulitaxruote)
Dim captured_stringxruote
captured_stringxruote = Mid(stringapulitaxruote,2,lenghtxruote)'left(stringapulita)
Dim lenght2xruote
lenght2xruote = Len(captured_stringxruote)
Dim captured_string2xruote
captured_string2xruote = Mid(captured_stringxruote,1,lenght2xruote - 1)'left(stringapulita)
Call SplitByChar(captured_string2xruote,".",vettorenumeroruotepulitodaipunti)
Dim quanteruoteunite
quanteruoteunite = UBound(vettorenumeroruotepulitodaipunti) + 1 'cint(inputbox("quante ruote unite",,ubound(vettorenumeroruotepulitodaipunti) + 1))
Select Case(quanteruoteunite)
Case 1
ReDim aruote(1)
aruote(1) = vettorenumeroruotepulitodaipunti(0) '4 ' apos(1) 'cint(inputbox("posizione da analizzare",,1))
Case 2
ReDim aruote(2)
aruote(1) = vettorenumeroruotepulitodaipunti(0)'cint(inputbox("prima posizione da analizzare",,1))
aruote(2) = vettorenumeroruotepulitodaipunti(1)'cint(inputbox("seconda posizione da analizzare",,2))
Case 3
ReDim aruote(3)
aruote(1) = vettorenumeroruotepulitodaipunti(0)'cint(inputbox("prima posizione da analizzare",,1))
aruote(2) = vettorenumeroruotepulitodaipunti(1)'cint(inputbox("seconda posizione da analizzare",,2))
aruote(3) = vettorenumeroruotepulitodaipunti(2)'cint(inputbox("terza posizione da analizzare",,3))
Case 4
ReDim aruote(4)
aruote(1) = vettorenumeroruotepulitodaipunti(0)'cint(inputbox("prima posizione da analizzare",,1))
aruote(2) = vettorenumeroruotepulitodaipunti(1)'cint(inputbox("seconda posizione da analizzare",,3))
aruote(3) = vettorenumeroruotepulitodaipunti(2)'cint(inputbox("terza posizione da analizzare",,4))
aruote(4) = vettorenumeroruotepulitodaipunti(3)'cint(inputbox("quarta posizione da analizzare",,5))
Case 5
ReDim aruote(5)
aruote(1) = vettorenumeroruotepulitodaipunti(0)'cint(inputbox("prima posizione da analizzare",,1))
aruote(2) = vettorenumeroruotepulitodaipunti(1)'cint(inputbox("seconda posizione da analizzare",,2))
aruote(3) = vettorenumeroruotepulitodaipunti(2)'cint(inputbox("terza posizione da analizzare",,3))
aruote(4) = vettorenumeroruotepulitodaipunti(3)'cint(inputbox("quarta posizione da analizzare",,4))
aruote(5) = vettorenumeroruotepulitodaipunti(4)'cint(inputbox("quinta posizione da analizzare",,5))
Case 6
ReDim aruote(6)
aruote(1) = vettorenumeroruotepulitodaipunti(0)'cint(inputbox("prima posizione da analizzare",,1))
aruote(2) = vettorenumeroruotepulitodaipunti(1)'cint(inputbox("seconda posizione da analizzare",,2))
aruote(3) = vettorenumeroruotepulitodaipunti(2)'cint(inputbox("terza posizione da analizzare",,3))
aruote(4) = vettorenumeroruotepulitodaipunti(3)'cint(inputbox("quarta posizione da analizzare",,4))
aruote(5) = vettorenumeroruotepulitodaipunti(4)'cint(inputbox("quinta posizione da analizzare",,5))
aruote(6) = vettorenumeroruotepulitodaipunti(5)'cint(inputbox("quinta posizione da analizzare",,5))
Case 7
ReDim aruote(7)
aruote(1) = vettorenumeroruotepulitodaipunti(0)'cint(inputbox("prima posizione da analizzare",,1))
aruote(2) = vettorenumeroruotepulitodaipunti(1)'cint(inputbox("seconda posizione da analizzare",,2))
aruote(3) = vettorenumeroruotepulitodaipunti(2)'cint(inputbox("terza posizione da analizzare",,3))
aruote(4) = vettorenumeroruotepulitodaipunti(3)'cint(inputbox("quarta posizione da analizzare",,4))
aruote(5) = vettorenumeroruotepulitodaipunti(4)'cint(inputbox("quinta posizione da analizzare",,5))
aruote(6) = vettorenumeroruotepulitodaipunti(5)'cint(inputbox("quinta posizione da analizzare",,5))
aruote(7) = vettorenumeroruotepulitodaipunti(6)'cint(inputbox("quinta posizione da analizzare",,5))
Case 8
ReDim aruote(8)
aruote(1) = vettorenumeroruotepulitodaipunti(0)'cint(inputbox("prima posizione da analizzare",,1))
aruote(2) = vettorenumeroruotepulitodaipunti(1)'cint(inputbox("seconda posizione da analizzare",,2))
aruote(3) = vettorenumeroruotepulitodaipunti(2)'cint(inputbox("terza posizione da analizzare",,3))
aruote(4) = vettorenumeroruotepulitodaipunti(3)'cint(inputbox("quarta posizione da analizzare",,4))
aruote(5) = vettorenumeroruotepulitodaipunti(4)'cint(inputbox("quinta posizione da analizzare",,5))
aruote(6) = vettorenumeroruotepulitodaipunti(5)'cint(inputbox("quinta posizione da analizzare",,5))
aruote(7) = vettorenumeroruotepulitodaipunti(6)'cint(inputbox("quinta posizione da analizzare",,5))
aruote(8) = vettorenumeroruotepulitodaipunti(7)'cint(inputbox("quinta posizione da analizzare",,5))
Case 9
ReDim aruote(9)
aruote(1) = vettorenumeroruotepulitodaipunti(0)'cint(inputbox("prima posizione da analizzare",,1))
aruote(2) = vettorenumeroruotepulitodaipunti(1)'cint(inputbox("seconda posizione da analizzare",,2))
aruote(3) = vettorenumeroruotepulitodaipunti(2)'cint(inputbox("terza posizione da analizzare",,3))
aruote(4) = vettorenumeroruotepulitodaipunti(3)'cint(inputbox("quarta posizione da analizzare",,4))
aruote(5) = vettorenumeroruotepulitodaipunti(4)'cint(inputbox("quinta posizione da analizzare",,5))
aruote(6) = vettorenumeroruotepulitodaipunti(5)'cint(inputbox("quinta posizione da analizzare",,5))
aruote(7) = vettorenumeroruotepulitodaipunti(6)'cint(inputbox("quinta posizione da analizzare",,5))
aruote(8) = vettorenumeroruotepulitodaipunti(7)'cint(inputbox("quinta posizione da analizzare",,5))
aruote(9) = vettorenumeroruotepulitodaipunti(8)'cint(inputbox("quinta posizione da analizzare",,5))
Case 10
ReDim aruote(10)
aruote(1) = vettorenumeroruotepulitodaipunti(0)'cint(inputbox("prima posizione da analizzare",,1))
aruote(2) = vettorenumeroruotepulitodaipunti(1)'cint(inputbox("seconda posizione da analizzare",,2))
aruote(3) = vettorenumeroruotepulitodaipunti(2)'cint(inputbox("terza posizione da analizzare",,3))
aruote(4) = vettorenumeroruotepulitodaipunti(3)'cint(inputbox("quarta posizione da analizzare",,4))
aruote(5) = vettorenumeroruotepulitodaipunti(4)'cint(inputbox("quinta posizione da analizzare",,5))
aruote(6) = vettorenumeroruotepulitodaipunti(5)'cint(inputbox("quinta posizione da analizzare",,5))
aruote(7) = vettorenumeroruotepulitodaipunti(6)'cint(inputbox("quinta posizione da analizzare",,5))
aruote(8) = vettorenumeroruotepulitodaipunti(7)'cint(inputbox("quinta posizione da analizzare",,5))
aruote(9) = vettorenumeroruotepulitodaipunti(8)'cint(inputbox("quinta posizione da analizzare",,5))
aruote(10) = vettorenumeroruotepulitodaipunti(9)'cint(inputbox("quinta posizione da analizzare",,5))
Case 11
ReDim aruote(11)
aruote(1) = vettorenumeroruotepulitodaipunti(0)'cint(inputbox("prima posizione da analizzare",,1))
aruote(2) = vettorenumeroruotepulitodaipunti(1)'cint(inputbox("seconda posizione da analizzare",,2))
aruote(3) = vettorenumeroruotepulitodaipunti(2)'cint(inputbox("terza posizione da analizzare",,3))
aruote(4) = vettorenumeroruotepulitodaipunti(3)'cint(inputbox("quarta posizione da analizzare",,4))
aruote(5) = vettorenumeroruotepulitodaipunti(4)'cint(inputbox("quinta posizione da analizzare",,5))
aruote(6) = vettorenumeroruotepulitodaipunti(5)'cint(inputbox("quinta posizione da analizzare",,5))
aruote(7) = vettorenumeroruotepulitodaipunti(6)'cint(inputbox("quinta posizione da analizzare",,5))
aruote(8) = vettorenumeroruotepulitodaipunti(7)'cint(inputbox("quinta posizione da analizzare",,5))
aruote(9) = vettorenumeroruotepulitodaipunti(8)'cint(inputbox("quinta posizione da analizzare",,5))
aruote(10) = vettorenumeroruotepulitodaipunti(9)'cint(inputbox("quinta posizione da analizzare",,5))
aruote(11) = vettorenumeroruotepulitodaipunti(10)'cint(inputbox("quinta posizione da analizzare",,5))
End Select
schrsep = " "
inizio = EstrazioneIni
fine = estrazioneprogressiva 'estrazionefin
Set clsl = New clslunghetta
ReDim an(90)
If scegliformazione(an,anum) Then
For k = 1 To 90
If an(k) Then
sfrz = sfrz & Format2(k) & ","
End If
Next
sfrz = RimuoviLastChr(sfrz,",")
an = Array(0)
an = array_push(an,sfrz)
sorte = sortediricerca 'selesito
Call clsl.init(an,schrsep,inizio,fine,aruote,sorte,aposizione)
Call clsl.eseguistatistica(aposizione)
contacasitotali = contacasitotali + 1
Dim xlastincmaxelementofthestring
Dim thelastincmaxelementofthestring
Call SplitByChar(clsl.strincritmaxsto,".",xlastincmaxelementofthestring)
thelastincmaxelementofthestring = xlastincmaxelementofthestring(UBound(xlastincmaxelementofthestring))
Dim stringaxallincmax
stringaxallincmax = clsl.strincritmaxsto '& "." & clsl.incrritmax
Dim vettorexallincmax
Call SplitByChar(stringaxallincmax,".",vettorexallincmax)
Dim incmaxstoricoeffettivo
incmaxstoricoeffettivo = MassimoV(vettorexallincmax,0,UBound(vettorexallincmax) - 1)
Dim ultimovaloredellastringaincrementi
ultimovaloredellastringaincrementi = vettorexallincmax(UBound(vettorexallincmax))
Dim Valoredicontrollo
If Int(ultimovaloredellastringaincrementi) = Int(clsl.incrritmax) Then
Valoredicontrollo = 1
End If
If Int(incmaxstoricoeffettivo) = Int(clsl.incrritmax) Then
Valoredicontrollo = 2 ' Valoredicontrollo + 1
End If
Dim diffincmaxposizionale
diffincmaxposizionale = Int(incmaxstoricoeffettivo) - Int(clsl.incrritmax)
If diffincmaxposizionale < 0 Then
contadiffincmaxposizionalenegative = contadiffincmaxposizionalenegative + 1
End If
'Dim filesolonumeridoc
filesolonumeridoc = "filesolonumeridoc.txt"
filesolonumeridocdaestrapolarefacilmente = "filesolonumeridocdastrapolarefacilmente.txt"
If clsl.ritardo > EstrazioneFin Then ' filtro extra ' disattivazione output x risultanze non doc
Scrivi
Scrivi "<font color=red>verifica cofronto x filtro extra clsl.ritardomax " & clsl.ritardomax & " clsl.ritardo " & clsl.ritardo & "</font>"
Scrivi
Call Scrivi("analisi incremento ritardo massimo per la sorte di " & NomeSorte(sortediricerca),True,,vbRed,vbWhite,4)
Call Scrivi
Call Scrivi("sulla ruota di : " & StringaRuote(aruote) & " ",True,,vbBlue,vbWhite,3)
Call Scrivi("posizione n. : " & StringaNumeri(aposizione))
' Dim Classedisviluppo
' SplitByChar clsl.lunghettastring,".",Classedisviluppo
' Scrivi "classe di sviluppo : " & Classedisviluppo
Call Scrivi("da estrazione : " & GetInfoEstrazione(inizio),True,,vbBlue,vbWhite,3)
Call Scrivi("a estrazione : " & GetInfoEstrazione(estrazioneprogressiva),True,,vbBlue,vbWhite,3)
Call Scrivi
Call Scrivi("numeri formazione : " & clsl.lunghettastring,True,,,,2)
Call Scrivi("ritardo attuale : " & clsl.ritardo,True,,,,2)
Call Scrivi("ritardo massimo storico : " & clsl.ritardomax,True,,,,2)
Call Scrivi("frequenza : " & clsl.frequenza,True,,,,2)
Call Scrivi("incremento del ritardo massimo attuale : " & clsl.incrritmax,True,,,,2)
Call Scrivi("incremento del ritardo massimo storico più alto : " & clsl.incrritmaxsto,True,,,,2)
Call Scrivi("stringa degli incrementi : " & clsl.strincritmaxsto & ".<font color=red>" & clsl.incrritmax & "</font>",True,,,,2)
' 'per rilevare numero incrementi
'
' Dim StringaIncrementiComplessivi
'
' StringaIncrementiComplessivi = clsl.strincritmaxsto & "." & clsl.incrritmax
'
' Dim vettoreincrementicomplessivi
'
' vettoreincrementicomplessivi = SplitByChar(StringaIncrementiComplessivi,".",vettoreincrementicomplessivi)
'
' Dim numeroincrementicomplessivi
'
' numeroincrementicomplessivi = UBound(vettoreincrementicomplessivi)
'
' '----------------------------------
End If ' fine filtro extra
contacasitotali = contacasitotali + 1
stringaxallincmax = clsl.strincritmaxsto ' & "." & clsl.incrritmax
Call SplitByChar(stringaxallincmax,".",vettorexallincmax)
incmaxstoricoeffettivo = MassimoV(vettorexallincmax,0,UBound(vettorexallincmax)) ' - 1)
diffincmaxposizionale = Int(incmaxstoricoeffettivo) - Int(clsl.incrritmax)
If diffincmaxposizionale < 0 Then
contadiffincmaxposizionalenegative = contadiffincmaxposizionalenegative + 1
End If
If Valoredicontrollo = 2 And Int(clsl.incrritmax) = Int(incmaxstoricoeffettivo) Or Valoredicontrollo = 2 And diffincmaxposizionale >= diffincmaxposizionaleminima And diffincmaxposizionale <= diffincmaxposizionalemassima Then
Scrivi
Scrivi "<font size=5 color=violet>valore di controllo filtrato? " & Valoredicontrollo
Scrivi
Scrivi "<font size=5 color=blue> clsl.incrritmax " & clsl.incrritmax & " VS " & " Int(incmaxstoricoeffettivo) " & Int(incmaxstoricoeffettivo) & "</font>"
If clsl.ritardomax = clsl.ritardo Then ' filtro extra
Scrivi "<font size=5 color=red><strong>riuscito anche controllo x incmaxp att=sto o x diff incmax posizionale voluta!!! :) "
casidiffincmaxp = casidiffincmaxp + 1
'Call ScriviFile(filesolonumeridoc,clsl.lunghettastring & " r: " & StringaRuote(aruote))
'Call ScriviFile(filesolonumeridocdastrapolarefacilmente,clsl.lunghettastring & " r: " & StringaRuote(aruote) & " p: " & StringaNumeri(aposizione))
'per rilevare numero incrementi
'Dim StringaIncrementiComplessivi
StringaIncrementiComplessivi = clsl.strincritmaxsto & "." & clsl.incrritmax
'Dim vettoreincrementicomplessivi
Call SplitByChar(StringaIncrementiComplessivi,".",vettoreincrementicomplessivi)
Scrivi
Scrivi "<font color=blue size=3>|" & StringaIncrementiComplessivi & "|"
Scrivi
Scrivi "<font color=red size=3>|" & StringaNumeri(vettoreincrementicomplessivi) & "|"
'Dim numeroincrementicomplessivi
numeroincrementicomplessivi = UBound(vettoreincrementicomplessivi)
'----------------------------------
Call ScriviFile(filesolonumeridoc,clsl.lunghettastring & " r: " & StringaRuote(aruote) & " p: " & StringaNumeri(aposizione) & " rap=rsp " & clsl.ritardo & " num. inc " & numeroincrementicomplessivi & " incmax att=sto " & clsl.incrritmax & " fqp " & clsl.frequenza & " s " & sorte & ";")
Call CloseFileHandle(filesolonumeridoc)
Call ScriviFile(filesolonumeridocdaestrapolarefacilmente,clsl.lunghettastring)
Call CloseFileHandle(filesolonumeridocdaestrapolarefacilmente)
Call Scrivi("analisi incremento ritardo massimo per la sorte di " & NomeSorte(sorte),True,,vbRed,vbWhite,4)
Call Scrivi
Call Scrivi("sulla ruota di : " & StringaRuote(aruote) & " ",True,,vbBlue,vbWhite,3)
Call Scrivi("posizione n. : " & StringaNumeri(aposizione))
Dim Classedisviluppo
SplitByChar clsl.lunghettastring,".",Classedisviluppo
Scrivi "classe di sviluppo : " & UBound(Classedisviluppo) + 1
Call Scrivi("da estrazione : " & GetInfoEstrazione(inizio),True,,vbBlue,vbWhite,3)
Call Scrivi("a estrazione : " & GetInfoEstrazione(estrazioneprogressiva),True,,vbBlue,vbWhite,3)
Call Scrivi
Call Scrivi("numeri formazione : " & clsl.lunghettastring,True,,,,2)
Call Scrivi("ritardo attuale : " & clsl.ritardo,True,,,,2)
Call Scrivi("ritardo massimo storico : " & clsl.ritardomax,True,,,,2)
Call Scrivi("frequenza : " & clsl.frequenza,True,,,,2)
Call Scrivi("incremento del ritardo massimo attuale : " & clsl.incrritmax,True,,,,2)
Call Scrivi("incremento del ritardo massimo storico più alto : " & incmaxstoricoeffettivo,True,,,,2) 'clsl.incrritmaxsto,True,,,,2)
Call Scrivi("stringa degli incrementi : " & clsl.strincritmaxsto & ".<font color=red>" & clsl.incrritmax & "</font>",True,,,,2)
Call Scrivi("diff incmax posizionale : " & diffincmaxposizionale)
Call ScriviFile(filereport,"")
Call ScriviFile(filereport,"------situazione diffp 0 e incmaxp att = sto----------")
Call ScriviFile(filereport,"")
Call ScriviFile(filereport,"analisi incremento ritardo massimo per la sorte di " & NomeSorte(sorte))
Call ScriviFile(filereport,"")
Call ScriviFile(filereport,"sulla ruota di : " & StringaRuote(aruote))
Call ScriviFile(filereport,"posizione n. : " & StringaNumeri(aposizione))
Call ScriviFile(filereport,"da estrazione : " & GetInfoEstrazione(inizio))
Call ScriviFile(filereport,"a estrazione : " & GetInfoEstrazione(estrazioneprogressiva))
Call ScriviFile(filereport,"")
Call ScriviFile(filereport,"numeri formazione : " & clsl.lunghettastring)
Call ScriviFile(filereport,"ritardo attuale : " & clsl.ritardo)
Call ScriviFile(filereport,"ritardo massimo storico : " & clsl.ritardomax)
Call ScriviFile(filereport,"frequenza : " & clsl.frequenza)
Call ScriviFile(filereport,"incremento del ritardo massimo attuale : " & clsl.incrritmax)
Call ScriviFile(filereport,"incremento del ritardo massimo storico più alto : " & incmaxstoricoeffettivo) 'clsl.incrritmaxsto)
Call ScriviFile(filereport,"stringa degli incrementi : " & clsl.strincritmaxsto & "." & clsl.incrritmax)
Call ScriviFile(filereport,"diff incmax posizionale : " & diffincmaxposizionale)
If clsl.ritardomax > 0 Then
'Call clsl.disegnagraficoincrritmax
End If
'Call CloseFileHandle(filereport)
Dim vettorexlaverificafinale
Call SplitByChar(clsl.lunghettastring,".",vettorexlaverificafinale)
Scrivi
Scrivi "verifica vettore passato |" & StringaNumeri(vettorexlaverificafinale) & "|"
Scrivi
Scrivi
Scrivi "verifica parametri " & " ruote |" & StringaNumeri(aruote) & "| sorte di verifica |" & sortediverifica & "| colpi di verifica " & colpidiverifica
Scrivi
Scrivi
Scrivi "numero di casi con incmax posizionale attuale > storico: " & contadiffincmaxposizionalenegative
Scrivi
Scrivi
Scrivi "numero di casi totali: " & contacasitotali
Scrivi
Call Scrivi("diff incmax posizionale : " & diffincmaxposizionale,True,,vbYellow,vbBlack,4)
Call Scrivi("diff incmax posizionale minima richiesta : " & diffincmaxposizionaleminima)
Call Scrivi("diff incmax posizionale massima richiesta : " & diffincmaxposizionalemassima)
Dim vettorexlaverificafinaledoc
vettorexlaverificafinaledoc = Array(0)
Dim cv
For cv = 0 To UBound(vettorexlaverificafinale)
vettorexlaverificafinaledoc = array_push(vettorexlaverificafinaledoc,Int(vettorexlaverificafinale(cv)))
Scrivi "vettore di interi " & vettorexlaverificafinaledoc(cv)
Next
Call VerificaEsitoTurbo(vettorexlaverificafinaledoc,aruote,estrazioneprogressiva + 1,sortediverifica,colpidiverifica,,esitoverifica,alcolponumero,verificaestratti)
If esitoverifica <> "" Then
casipositivi = casipositivi + 1
Scrivi verificaestratti & " al colpo " & alcolponumero
If alcolponumero > colpomassimo Then
colpomassimo = alcolponumero
End If
Else
colpirimanentirispettocolpidiverifica = colpidiverifica -(fineverifica - estrazioneprogressiva)
colpirimanentirispettocolpomassimo = colpomassimo -(fineverifica - estrazioneprogressiva)
If colpirimanentirispettocolpidiverifica < 0 Then
casinegativi = casinegativi + 1
Else
casiattuali = casiattuali + 1
Scrivi "ca rispetto colpi di verifica " & colpirimanentirispettocolpidiverifica
Scrivi "ca rispetto colpo massimo " & colpirimanentirispettocolpomassimo
If colpirimanentirispettocolpidiverifica < colpirimanentiminimi Then
colpirimanentiminimi = colpirimanentirispettocolpidiverifica
End If
If colpirimanentirispettocolpomassimo < colpirimanentiminimi Then
colpirimanentiminimi = colpirimanentirispettocolpomassimo
End If
End If
Erase vettorexlaverificafinale
End If ' fine filtro extra
End If
If clsl.ritardo <> ritardomassimorilevato Then
Else
If clsl.ritardo = ritardomassimorilevato And clsl.ritardomax = ritardomassimorilevato Then
Else
End If
End If
End If
End If
Call CloseFileHandle(filereport)
End Function 'end sub
Function selesito
Dim ret
Dim avoci
avoci = Array("","estratto","ambo","terno","quaterna","cinquina")
ret = ScegliOpzioneMenu(avoci,1," analisi posizionale per sorte di : ")
selesito = ret
End Function
Function scegliformazione(an,anum)
Dim sformazione
Dim k,i
sformazione = StringaNumeri(anum) 'inputbox("inserire la formazione da analizzare separando i numeri che la compongono con il punto",,stringanumeri(anum))
ReDim av(0)
Call SplitByChar(sformazione,".",av)
For k = 0 To UBound(av)
If Int(av(k)) > 0 And Int(av(k)) <= 90 Then
an(Int(av(k))) = True
i = i + 1
End If
Next
If i > 0 Then scegliformazione = True
End Function
Function array_push(arr,vars)
Dim k,newelem,newarrsize,elem
If IsArray(arr) Then
If Len(vars) > 0 Then
If InStr(vars,",") = False Then
newarrsize = CInt(UBound(arr) + 1)
ReDim Preserve arr(newarrsize)
arr(newarrsize) = vars
Else
k =(UBound(arr) + 1)
newelem = Split(vars,",")
newarrsize = CInt(UBound(arr) + UBound(newelem) + 1)
ReDim Preserve arr(newarrsize)
For Each elem In newelem
arr(k) = Trim(elem)
k = k + 1
Next
End If
End If
array_push = arr
Else
array_push = False
End If
End Function
Sub playwav(sfile,nrepeat,stesto)
Dim ovoice,ospfilestream
Dim k
Set ovoice = CreateObject("sapi.spvoice")
Set ospfilestream = CreateObject("sapi.spfilestream")
For k = 1 To nrepeat
ospfilestream.Open sfile
ovoice.speakstream ospfilestream
ospfilestream.Close
Next
ovoice.speak stesto
End Subcodice del file incluso [dim.ls]
Codice:
Dim filecombruoteunite
Dim filecombposizioni
Dim ruotescelte
Dim qualiruote
Dim aposizioni
Dim Classeposizionale
Dim coltot
Dim acolposizionale
Dim numeroruoteunite
Dim acolruoteunite
Dim y
Dim coltotruoteunite
ReDim aRigheposizioni(0)
ReDim aNumposizioni(0)
ReDim aRigheruoteunite(0)
ReDim aNumruoteunite(0)
Dim Inizio
Dim fine
Dim rit
Dim ritmax
Dim Incmax
Dim freq
Dim z
Dim diff
Dim sorte
Dim ritardoMassimorilevato
Dim Formazioneconritardomax
Dim ruoteconritardomax
Dim posizioniconritardomax
Dim filtroattivato
Dim filereportformazioniposizionali
Dim ritstandard,ritmaxstandard,Incmaxstandard,freqstandard
Dim Classedisviluppominima
Dim Classedisviluppomassima
Dim quanteruoteuniteminimo
Dim quanteruoteunite
Dim quanteposizioniuniteminimo
Dim quanteposizioniunitemassimo
Dim vuoiapplicarefiltro
Dim diffposizionale
Dim diffpvolutaminima
Dim filereport
Dim diffpvolutamassima
Dim Incmaxposizionalevolutominimo
Dim Incmaxposizionalevolutomassimo
Dim coltotok
Dim Classe
Dim numerivoluti
Dim num
Dim w
Dim formazioneconrapmax
Dim vettorebyformazioneconrapmax
Dim ritstandard0,ritmaxstandard0,Incmaxstandard0,freqstandard0
Dim v
Dim v2
Dim diffincmaxposizionaleminima
Dim diffincmaxposizionalemassimacodice del file incluso [input.ls]
Codice:
ReDim numeri(0)
filereportformazioniposizionali = ".\filereportformazioniposizionali.txt"
If FileEsistente(filereportformazioniposizionali) Then
Call EliminaFile(filereportformazioniposizionali)
End If
sorte = 1
ScegliNumeri(numeri)
Classedisviluppominima = CInt(InputBox("classe di sviluppo minima",,UBound(numeri)))
Classedisviluppomassima = CInt(InputBox("classe di sviluppo massima",,Classedisviluppominima))
quanteruoteuniteminimo = CInt(InputBox("quante ruote unite minimo",,1))
quanteruoteunite = CInt(InputBox("quante ruote unite massimo",,quanteruoteuniteminimo))
quanteposizioniuniteminimo = CInt(InputBox("quante posizioni unite minimo",,2))
quanteposizioniunitemassimo = CInt(InputBox("quante posizioni unite massimo",,5))'quanteposizioniuniteminimo))
vuoiapplicarefiltro = InputBox("vuoi applicare filtro di selezione output e report file? s/n",,"s")
If vuoiapplicarefiltro = "s" Or vuoiapplicarefiltro = "S" Or vuoiapplicarefiltro = "si" Or vuoiapplicarefiltro = "SI" Or vuoiapplicarefiltro = "Si" Then
diffpvolutaminima = CInt(InputBox("diff posizionale voluta minima",,0))
diffpvolutamassima = CInt(InputBox("diff posizionale voluta massima",,0)) '3
diffincmaxposizionaleminima = CInt(InputBox("diff incmax posizionale voluta minima",,0))
diffincmaxposizionalemassima = CInt(InputBox("diff incmax posizionale voluta massima",,0)) '9
Incmaxposizionalevolutominimo = CInt(InputBox("incmax posizionale voluto minimo",,0))
Incmaxposizionalevolutomassimo = CInt(InputBox("incmax posizionale voluto massimo",,360)) ' 90 Incmaxposizionalevolutominimo))
filtroattivato = "si"
End If
Inizio = EstrazioneIni
fine = EstrazioneFin
filecombruoteunite = ".\filecombruoteunite.txt"
filecombposizioni = ".\filecombposizioni.txt"
filereport = ".\filereport.txt"codice del file incluso [generagraficoxincmaxstandard.ls]
Codice:
Function analisincmax(anum)
Dim idestr,Ruota,sorte
Dim Inizio,Fine
Dim k,p,i,r,pMax
Dim Rit,RitMax,IncRitMax,Fre
Dim collStoria
Dim cParStat
Dim bEstrValida
Set collStoria = GetNewCollection
Inizio = EstrazioneIni
Fine = EstrazioneFin
ReDim aN(90)
If ScegliFormazione(aN,anum) Then
ReDim aRuoteSel(12)
Ruota = ScegliRuotaEx(aRuoteSel)
sorte = ScegliEsito
If Ruota > 0 And sorte > 0 Then
For idestr = Inizio To Fine
If Ruota = 11 Then
bEstrValida = False
pMax = 0
For r = 1 To 10
If Estratto(idestr,r,1) > 0 Then bEstrValida = True
p = 0
For k = 1 To 5
If aN(Estratto(idestr,r,k)) Then
p = p + 1
End If
Next
If p > pMax Then pMax = p
Next
If bEstrValida Then
If pMax >= sorte Then
If IncRitMax > 0 Then
Set cParStat = New clsParStat
cParStat.idestr = idestr - 1
cParStat.RitMax = RitMax
cParStat.IncrRitMax = IncRitMax
collStoria.Add cParStat
End If
Rit = 0
Fre = Fre + 1
IncRitMax = 0
Else
Rit = Rit + 1
If Rit > RitMax Then
IncRitMax = IncRitMax + 1
RitMax = Rit
End If
End If
End If
ElseIf Ruota = 13 Then
bEstrValida = False
pMax = 0
For r = 1 To 12
If aRuoteSel(r) Then
If Estratto(idestr,r,1) > 0 Then bEstrValida = True
p = 0
For k = 1 To 5
If aN(Estratto(idestr,r,k)) Then
p = p + 1
End If
Next
If p > pMax Then pMax = p
End If
Next
If bEstrValida Then
If pMax >= sorte Then
If IncRitMax > 0 Then
Set cParStat = New clsParStat
cParStat.idestr = idestr - 1
cParStat.RitMax = RitMax
cParStat.IncrRitMax = IncRitMax
collStoria.Add cParStat
End If
Rit = 0
Fre = Fre + 1
IncRitMax = 0
Else
Rit = Rit + 1
If Rit > RitMax Then
IncRitMax = IncRitMax + 1
RitMax = Rit
End If
End If
End If
Else
If Estratto(idestr,Ruota,1) > 0 Then
p = 0
For k = 1 To 5
If aN(Estratto(idestr,Ruota,k)) Then
p = p + 1
End If
Next
If p >= sorte Then
If IncRitMax > 0 Then
Set cParStat = New clsParStat
cParStat.idestr = idestr - 1
cParStat.RitMax = RitMax
cParStat.IncrRitMax = IncRitMax
collStoria.Add cParStat
End If
Rit = 0
Fre = Fre + 1
IncRitMax = 0
Else
Rit = Rit + 1
If Rit > RitMax Then
IncRitMax = IncRitMax + 1
RitMax = Rit
End If
End If
End If
End If
Call AvanzamentoElab(Inizio,Fine,idestr)
If ScriptInterrotto Then Exit For
Next
If IncRitMax > 0 Then
Set cParStat = New clsParStat
cParStat.idestr = idestr - 1
cParStat.RitMax = RitMax
cParStat.IncrRitMax = IncRitMax
collStoria.Add cParStat
End If
Call GestioneOutput(collStoria,RitMax,aN,sorte,Inizio,Fine,Ruota,Rit,Fre,aRuoteSel)
Else
MsgBox "Ruota non valida"
End If
End If
End Function
Ultima modifica:
lotto_tom75
Advanced Premium Member
Dopo il ferrarozzo... (grazie claudiotto per il pollicion) arriva il lamborghini... 
Script n.32 
Script n. 32 tom's bakery x lotto by tom - implementando il motore di sviluppo integrale senza limite di classe di Edoardo_95 che saluto e ringrazio anche qui e che spero si rifaccia vivo presto come ha fatto il nostro comune maestro Luigi, lo script consente di ridurre in modo semi automatico qualsiasi gruppo base a qualsiasi formazione di fq max (o altro parametro estremo tipo ra max ecc...) fino alla classe finale desiderata proseguendo nella riduzione solo se il numero di risultanze con il valore estremo desiderato è pari a 1 eliminando quindi tutti i possibili casi "bivio" che potrebbero inficiare la teorica valenza della formazione statistica finale.
E' fortemente consigliato non superare mai lo step riduzionale -3 in quanto per gradini riduzionali superiori (-4 ecc...) le formazioni di sviluppo integrale, specialmente per gruppi base ampi, raggiungono facilmente il milione e passa di unità rallentando in modo indicibile l'elaborazione intrapresa.
Script n.32 Script n. 32 tom's bakery x lotto by tom - implementando il motore di sviluppo integrale senza limite di classe di Edoardo_95 che saluto e ringrazio anche qui e che spero si rifaccia vivo presto come ha fatto il nostro comune maestro Luigi, lo script consente di ridurre in modo semi automatico qualsiasi gruppo base a qualsiasi formazione di fq max (o altro parametro estremo tipo ra max ecc...) fino alla classe finale desiderata proseguendo nella riduzione solo se il numero di risultanze con il valore estremo desiderato è pari a 1 eliminando quindi tutti i possibili casi "bivio" che potrebbero inficiare la teorica valenza della formazione statistica finale.
E' fortemente consigliato non superare mai lo step riduzionale -3 in quanto per gradini riduzionali superiori (-4 ecc...) le formazioni di sviluppo integrale, specialmente per gruppi base ampi, raggiungono facilmente il milione e passa di unità rallentando in modo indicibile l'elaborazione intrapresa.
Codice:
Option Explicit
' Script n.32 tom's bakery x lotto by tom - implementando il motore di sviluppo integrale senza limite di classe di Edoardo_95 che saluto e 'ringrazio anche qui e che spero si rifaccia vivo presto come ha fatto il nostro comune maestro Luigi, lo script consente
' di ridurre in modo semi automatico qualsiasi gruppo base a qualsiasi formazione di fq max (o altro parametro estremo tipo ra max ecc...)
' fino alla classe finale desiderata proseguendo nella riduzione solo se il numero di risultanze con il valore estremo desiderato è pari a 1.
' eliminando quindi tutti i possibili casi "bivio" che potrebbero inficiare la teorica valenza della formazione statistica finale.
' E' fortemente consigliato non superare mai lo step riduzionale -3 in quanto per gradini riduzionali superiori (-4 ecc...) le formazioni di sviluppo 'integrale, specialmente per gruppi base ampi, raggiungono facilmente il milione e passa di unità rallentando in modo indicibile l'elaborazione 'intrapresa.
Class clsSviluppo
Private aBNumDaSvil
Private nQNumeri
Private nCombInt
Private nClasse
Private aRighe
Private nQNumPerRiga
Private aPuntatore
Private nSviluppate
Function InitSviluppo(aNumeri,Classe)
nQNumeri = AlimentArrayNumDaSvil(aNumeri)
nCombInt = Combinazioni(nQNumeri,Classe)
nClasse = Classe
nSviluppate = 0
If nCombInt > 0 Then
Call AlimentaArrayRighe
Call InitArrayPuntatore
End If
InitSviluppo = nCombInt
End Function
Function GetQuantitaNumeriDaSvil
GetQuantitaNumeriDaSvil = nQNumeri
End Function
Function GetStringaNumDaSvil
Dim s,k
s = ""
For k = 1 To UBound(aBNumDaSvil)
If aBNumDaSvil(k) Then
s = s & Format2(k) & "."
End If
Next
GetStringaNumDaSvil = RimuoviLastChr(s,".")
End Function
Private Sub InitArrayPuntatore
Dim k
ReDim aPuntatore(nClasse)
For k = 1 To nClasse - 1
aPuntatore(k) = 1
Next
aPuntatore(k) = 0
End Sub
Function GetComb(aComb)
Dim nTmp,K,nPuntatore
nPuntatore = nClasse
nTmp = aPuntatore(nPuntatore) + 1
Do While nTmp > nQNumPerRiga
nPuntatore = nPuntatore - 1
If nPuntatore <= 0 Then Exit Do
nTmp = aPuntatore(nPuntatore) + 1
Loop
If nPuntatore > 0 Then
For K = nPuntatore To nClasse
aPuntatore(K) = nTmp
Next
ReDim aComb(nClasse)
For K = 1 To nClasse
aComb(K) = aRighe(K,aPuntatore(K))
Next
nSviluppate = nSviluppate + 1
GetComb = True
Else
GetComb = False
End If
End Function
Function GetQuantitaSviluppate
GetQuantitaSviluppate = nSviluppate
End Function
Private Function AlimentArrayNumDaSvil(aNumeri)
Dim k,q
aBNumDaSvil = ArrayNumeriToBool(aNumeri)
For k = 1 To 90
If aBNumDaSvil(k) Then
q = q + 1
End If
Next
AlimentArrayNumDaSvil = q
End Function
Private Sub AlimentaArrayRighe
Dim nRiga,k,aNumeri
Call ArrayBNumToArrayNum(aBNumDaSvil,aNumeri)
nQNumPerRiga =(nQNumeri - nClasse) + 1
ReDim aRighe(nClasse,nQNumPerRiga)
For nRiga = 1 To nClasse
For k = nRiga To(nRiga + nQNumPerRiga) - 1 '(nQNumeri - nClasse) + nRiga
aRighe(nRiga,(k - nRiga) + 1) = aNumeri(k)
Next
Next
End Sub
Sub OutputARighe
Dim k,j,s
For k = 1 To nClasse
s = ""
For j = 1 To nQNumPerRiga
s = s & Format2(aRighe(k,j)) & "."
Next
Next
End Sub
End Class
Sub Main
Dim filediraccolta
filediraccolta = ".\filediraccolta.txt"
If FileEsistente(filediraccolta) Then
Call EliminaFile(filediraccolta)
End If
Dim cSvil
Dim aNumDaSvil,nClasse,nCombInt,nQNumeri
Dim aColonna
Dim Inizio
Dim fine
Dim aRetcol,nSorte,RetRit1,RetRitMax,RetIncrRitMax,RetFreq,Iniziorange,idestrazione
fine = EstrazioneFin
Inizio = 1
Dim freqmassima
freqmassima = 0
Dim numfqmaxuguali
numfqmaxuguali = 0
Dim Formazioneconfqmassima
Dim Formazionesceltasolonumeri
Dim Stringaoutput
Dim contacomb
contacomb = 0
ReDim aruote(0)
'aruote(1) = 1
'aruote(2) = 2
'aruote(3) = 6
'aruote(4) = 10
'aruote(5) = 12
ScegliRuote(aruote)
nSorte = CInt(InputBox("sorte",,2))
Set cSvil = New clsSviluppo
Call ScegliNumeri(aNumDaSvil)
ScriviFile filediraccolta,StringaNumeri(aNumDaSvil)
CloseFileHandle(filediraccolta)
nClasse = CInt(InputBox("classe iniziale max 90 e min 1",,UBound(aNumDaSvil))) 'ScegliEsito(UBound(aNumDaSvil) - 2,2,90)
Dim nClassefinale
nClassefinale = CInt(InputBox("classe finale max 90 e min 1",,UBound(aNumDaSvil) - 1))
Dim Stepriduzionalevoluto 'meglio x i tempi di elaborazione non troppo lunghi se >= -3 e <= -1
Stepriduzionalevoluto = CInt(InputBox("step riduzionale voluto max -3 min -1",,- 3))
Dim nClassedinamica
For nClassedinamica = nClasse To nClassefinale Step Stepriduzionalevoluto
'leggo il file filediraccolta
Dim anum
Dim y
Dim c
Call Messaggio("Lettura file di testo")
ReDim aRighe(0)
Call LeggiRigheFileDiTesto(filediraccolta,aRighe)
For y = 0 To UBound(aRighe)
If aRighe(y) <> "" Then
Call SplitByChar("." & aRighe(y) & ".",".",anum)
End If
Dim anumint
ReDim anumint(UBound(anum) - 1)
For c = 1 To UBound(anum) - 1
Scrivi "|" & anum(c) & "|"
anumint(c) = Int(anum(c))
'
If ScriptInterrotto Then Exit For
Next
'
If ScriptInterrotto Then Exit For
Next
Dim varStop
nCombInt = cSvil.InitSviluppo(anumint,nClassedinamica)
If nCombInt Then
nQNumeri = cSvil.GetQuantitaNumeriDaSvil
Scrivi cSvil.GetStringaNumDaSvil
Scrivi
Scrivi "Quantita numeri : " & nQNumeri
Scrivi "Classe : " & nClassedinamica
Scrivi "Combinazioni integrali : " & nCombInt
Scrivi
cSvil.OutputARighe
Scrivi
Do While cSvil.GetComb(aColonna)
Call StatisticaFormazioneTurbo(aColonna,aruote,nSorte,RetRit1,RetRitMax,RetIncrRitMax,RetFreq,Inizio,fine)
contacomb = contacomb + 1
Stringaoutput = StringaNumeri(aColonna) & " - " & StringaRuote(aruote) & " -s " & nSorte & " -ra " & RetRit1 & " -rs " & RetRitMax & " -incmax " & RetIncrRitMax & " -freq " & RetFreq & " -inizio " & Inizio & " -fine " & fine
If RetFreq > freqmassima Then
freqmassima = RetFreq
Formazioneconfqmassima = "<font color=red>" & Stringaoutput
Formazionesceltasolonumeri = StringaNumeri(aColonna)
numfqmaxuguali = 0
End If
If RetFreq = freqmassima Then
numfqmaxuguali = numfqmaxuguali + 1
End If
Messaggio cSvil.GetQuantitaSviluppate & " r " & StringaRuote(aruote) & " ncd " & nClassedinamica
If ScriptInterrotto Then Exit Do
Call AvanzamentoElab(1,nCombInt,contacomb)
Loop
Scrivi
Scrivi "Sviluppate : " & cSvil.GetQuantitaSviluppate
Else
MsgBox "Impossibile sviluppare",vbCritical
Exit For
End If
Scrivi
Scrivi "report finale"
Scrivi
Scrivi "formazione con fq massima " & Formazioneconfqmassima
Scrivi
Dim giustovalorenumfqmaxuguali
giustovalorenumfqmaxuguali = numfqmaxuguali - 1
Scrivi "num. fq max uguali " & numfqmaxuguali - 1
Scrivi
Scrivi
Scrivi "formazione scelta (solo numeri) " & Formazionesceltasolonumeri
Scrivi
Scrivi
Scrivi "Tt " & TempoTrascorso
Scrivi
If Formazioneconfqmassima <> "" And numfqmaxuguali - 1 = 0 Then
If FileEsistente(filediraccolta) Then
Call EliminaFile(filediraccolta)
End If
ScriviFile filediraccolta,Formazionesceltasolonumeri
CloseFileHandle(filediraccolta)
Else
Scrivi "<font color=red>Alt! NUMERO FQ MAX UGUALI purtroppo maggiore di zero e pari a " & giustovalorenumfqmaxuguali
Scrivi "<font color=red>Interrompo qui l'elaborazione. Ricordo però che è possibile ripeterla da questo punto provando a cambiare valore di step riduzionale"
Scrivi "<font color=red>e sperando che così facendo la risultanza relativa alla fq max ricercata sia unica :)"
Stop
End If
If giustovalorenumfqmaxuguali <> 0 Then Exit For
'--------------- fine controllo x interrompere elaborazione o meno...
'prima di analizzare la nuova classe riazzeriamo tutto...
freqmassima = 0
giustovalorenumfqmaxuguali = 0
Formazioneconfqmassima = ""
Formazionesceltasolonumeri = ""
Next ' x nclassedinamica
' End If ' varstop
End Sub
Ultima modifica:
lotto_tom75
Advanced Premium Member
Script n. 33 tom's bakery x lotto by tom : sviluppo 100x100 chiamato così x la modalità utilizzata dal sottoscritto + frequentemente per verificare esiti di qualsiasi sorte per qualsiasi ruota e in qualsiasi classe finale nelle ultime 100 estrazioni consecutive by sviluppo di tipo selettivo senza limite di classe in modalità random. Ovviamente anche in questo caso tutti i parametri compreso il range temporale di verifica sono modificabili a piacere.
Aggiornamento del 26/8/2023
Codice:
Option Explicit
Sub Main
'script n.33 tom's bakery x lotto by tom : sviluppo 100x100 chiamato così x la modalità utilizzata dal sottoscritto + frequentemente per verificare esiti di qualsiasi sorte per qualsiasi ruota e in qualsiasi classe finale nelle ultime 100 estrazioni consecutive by sviluppo di tipo selettivo senza limite di classe in modalità random.
'Ovviamente anche in questo caso tutti i parametri compreso il range temporale di verifica sono modificabili a piacere.
Dim nSorte,aRuote,Ini,fin,sMsg,nMoltip,nTrov,nNumSel
Dim nCicloTeo,nRitMax,nRitMin,nClasseLunghetta,nRuoteSel,nLunghetteDaTrov,i2,ccColonna,ClasseFin
Dim TimeStart
Dim k,CollComb,cColonna
Dim aN
Dim TipoAlgo
Dim RetRit,RetRitMax,RetIncrRitMax,RetFrq
Dim nSuperficialita
Call Scrivi
Call Scrivi("Elaborazione eseguita con archivio lotto aggiornato al: " & giorno(EstrazioneFin) & "-" & Mese(EstrazioneFin) & "-" & Anno(EstrazioneFin))
Call Scrivi
Dim estrazione
Dim colpidiverifica
Dim winalcolponumero
Dim esitoverifica
Dim estrattiusciti
Dim estrazionediuscita
Dim colpomassimo
Dim casipositivi
Dim casinegativi
Dim casiattuali
Dim casitotali
Dim estrazionidaverificare
Dim sortediverifica
Dim Inizioverifica
Dim colpirimanentirispettocolpomassimo
Dim colpirimanentirispettocolpidiricerca
Dim colpirimanentiminimi
Dim Formazioneconcolpirimanentiminimi
Dim ruotaconcolpirimanentiminimi
Dim esitoestratto
Dim esitoambo
Dim esitoterno
Dim esitoquaterna
Dim esitocinquina
Dim estrapolaestratti
estrapolaestratti = "estrapolaestratti.txt"
If FileEsistente(estrapolaestratti) Then
Call EliminaFile(estrapolaestratti)
End If
esitoestratto = 0
esitoambo = 0
esitoterno = 0
esitoquaterna = 0
esitocinquina = 0
colpirimanentiminimi = EstrazioneFin
fin = EstrazioneFin
estrazionidaverificare = CInt(InputBox("estrazioni da verificare",,100))
Inizioverifica = fin - estrazionidaverificare
colpidiverifica = CInt(InputBox("colpidi di verifica",,estrazionidaverificare - 2))
sortediverifica = CInt(InputBox("sorte di verifica",,2))
nTrov = 0
nNumSel = ScegliNumeri(aN)
ReDim aRuote(0)
Call ScegliRuote(aRuote)
nSorte = SelEsito
nClasseLunghetta = CInt(InputBox("Scegli classe lunghetta di partenza",,71))
ClasseFin = CInt(InputBox("Scegli classe lunghetta finale",,nClasseLunghetta - 1))
For estrazione = Inizioverifica To fin
Scrivi
Scrivi "<font color=red>" & GetInfoEstrazione(estrazione) & "</font>"
Scrivi
Dim r
For r = 1 To 100
Call Messaggio(GetInfoEstrazione(estrazione) & " c+ " & casipositivi & " c- " & casinegativi & " ca " & casiattuali & " clpmax " & colpomassimo & " crt min " & colpirimanentirispettocolpomassimo & " ruote " & StringaRuote(aRuote))
Next
TipoAlgo = 0
nSuperficialita = 0
nLunghetteDaTrov = 1
nMoltip = 8
nRitMax = 0
nRitMin = 0
Ini = fin - nRitMax
If Ini <= 0 Then Ini = 1
TimeStart = Timer
Call GetLunghettePiuRitardate(aN,aRuote,nClasseLunghetta,nSorte,CollComb,EstrazioneIni,estrazione,nRitMin,nRitMax,nLunghetteDaTrov,TipoAlgo,nSuperficialita)
Call OrdinaItemCollection(CollComb,"Ritardo",,,- 1)
Call Scrivi("Analisi sulla ruota " & StringaRuote(aRuote) & " per la sorte di " & nSorte)
Scrivi
For i2 = nClasseLunghetta To ClasseFin Step - 1
For Each cColonna In CollComb
Call GetLunghettePiuRitardate(cColonna.aNum,aRuote,i2,nSorte,CollComb,EstrazioneIni,estrazione,nRitMin,nRitMax,nLunghetteDaTrov,TipoAlgo,nSuperficialita)
For Each ccColonna In CollComb
Call StatisticaFormazioneTurbo(ccColonna.aNum,aRuote,nSorte,RetRit,RetRitMax,RetIncrRitMax,RetFrq,EstrazioneIni,estrazione)
If i2 = ClasseFin Then
Call Scrivi(" " & " " & " " & cColonna.GetStringaNum & " Rit " & cColonna.Ritardo)
Call Scrivi(i2 & " " & ccColonna.GetStringaNum & "" & " -1")
Dim numeridaverificare
Dim ruotedaverificare
Call SplitByChar("." & ccColonna.GetStringaNum & ".",".",numeridaverificare)
Call SplitByChar("." & StringaNumeri(aRuote) & ".",".",ruotedaverificare)
Call VerificaEsitoTurbo(numeridaverificare,ruotedaverificare,estrazione + 1,sortediverifica,colpidiverifica,,esitoverifica,winalcolponumero,estrattiusciti,estrazionediuscita)
If esitoverifica <> "" Then
Scrivi esitoverifica & " | <font color=green>ok | estratti " & estrattiusciti & " al colpo numero " & winalcolponumero & "</font>"
ScriviFile estrapolaestratti,esitoverifica & " . " & estrattiusciti
CloseFileHandle(estrapolaestratti)
Dim convertiesito
If esitoverifica = "Estratto" Then
convertiesito = 1
End If
If esitoverifica = "Ambo" Then
convertiesito = 2
End If
If esitoverifica = "Terno" Then
convertiesito = 3
End If
If esitoverifica = "Quaterna" Then
convertiesito = 4
End If
If esitoverifica = "Cinqina" Then
convertiesito = 5
End If
Select Case(convertiesito)
Case 1
esitoestratto = esitoestratto + 1
Case 2
esitoambo = esitoambo + 1
Case 3
esitoterno = esitoterno + 1
Case 4
esitoquaterna = esitoquaterna + 1
Case 5
esitocinquina = esitocinquina + 1
End Select
casipositivi = casipositivi + 1
If winalcolponumero > colpomassimo Then
colpomassimo = winalcolponumero
Dim colpomassimorelativo
colpomassimorelativo = colpomassimo
End If
Else
colpirimanentirispettocolpidiricerca = colpidiverifica -(EstrazioneFin - estrazione)
colpirimanentirispettocolpomassimo = colpomassimo -(EstrazioneFin - estrazione)
If colpirimanentirispettocolpidiricerca < 0 Then
Scrivi "no"
casinegativi = casinegativi + 1
Else
Scrivi
Scrivi "<font color=blue>formazione " & StringaNumeri(numeridaverificare) & "</font>"
Scrivi "<font color=blue>ruote " & StringaNumeri(ruotedaverificare) & "</font>"
Scrivi "<font color=blue>colpi rimanenti rispetto colpi di ricerca " & colpirimanentirispettocolpidiricerca & "</font>"
Scrivi "<font color=blue>colpi rimanenti rispetto colpo massimo " & colpirimanentirispettocolpomassimo & "</font>"
Scrivi "<font color=blue>colpo massimo relativo " & colpomassimorelativo & "</font>"
Scrivi
casiattuali = casiattuali + 1
If colpirimanentirispettocolpidiricerca < colpirimanentiminimi Then
colpirimanentiminimi = colpirimanentirispettocolpidiricerca
Formazioneconcolpirimanentiminimi = StringaNumeri(numeridaverificare)
ruotaconcolpirimanentiminimi = StringaNumeri(ruotedaverificare)
End If
If colpirimanentirispettocolpomassimo < colpirimanentiminimi Then
colpirimanentiminimi = colpirimanentirispettocolpomassimo
Formazioneconcolpirimanentiminimi = StringaNumeri(numeridaverificare)
ruotaconcolpirimanentiminimi = StringaNumeri(ruotedaverificare)
End If
End If
End If
End If
Next
Next
Next
Scrivi
If ScriptInterrotto Then Exit For
Next
Scrivi
Scrivi "elaborazione con archivio aggiornato al " & GetInfoEstrazione(EstrazioneFin)
Scrivi "sdr " & nSorte
Scrivi "sdv " & sortediverifica
Scrivi "cf " & ClasseFin
Scrivi "c+ " & casipositivi
Scrivi "c- " & casinegativi
Scrivi "ca " & casiattuali
Scrivi "clp rim min " & colpirimanentiminimi
Scrivi "formazione con clp rim min " & Formazioneconcolpirimanentiminimi
Scrivi "ruota con clp rim min " & ruotaconcolpirimanentiminimi
Scrivi "ct " & casitotali
casitotali = casipositivi + casinegativi + casiattuali
If casipositivi <> "" Then
Scrivi "%+ " &(casipositivi/casitotali)*100
End If
Scrivi "cna " &(fin - Inizioverifica) - casitotali
Scrivi "clpmax " & colpomassimo
Scrivi
Scrivi "e : " & esitoestratto
Scrivi "a : " & esitoambo
Scrivi "t : " & esitoterno
Scrivi "q : " & esitoquaterna
Scrivi "c : " & esitocinquina
Scrivi "---------------------------"
Scrivi "tot : " & esitoestratto + esitoambo + esitoterno + esitoquaterna + esitocinquina
Scrivi
Call Scrivi("Tempo di elaborazione : " & TempoTrascorso)
End Sub
Function ScegliClassseLunghetta
Dim aVoci(30)
Dim k,i
For k = 2 To(2 - 1) + UBound(aVoci)
i = i + 1
aVoci(i) = k
Next
k = ScegliOpzioneMenu(aVoci,5,"Classe lunghetta")
ScegliClassseLunghetta = Int(aVoci(k))
End Function
Function SelRuote(aRuote)
Dim t,k,bTutte
bTutte = False
t = ScegliRuote(aRuote)
For k = 1 To t
If aRuote(k) = TT_ Then
bTutte = True
Exit For
End If
Next
If bTutte Then
ReDim aRuote(10)
For k = 1 To 10
aRuote(k) = k
Next
SelRuote = 10
Else
SelRuote = t
End If
End Function
Function FormattaSecondi(s)
Dim hh
Dim Mm
Dim Ss
Dim TimeStr
hh = s \ 3600
Mm =(s Mod 3600) \ 60
Ss = s -((hh * 3600) +(Mm * 60))
TimeStr = Format2(hh) & ":" & Format2(Mm) & ":" & Format2(Ss)
FormattaSecondi = TimeStr
End Function
Function SelEsito
Dim ret
Dim aVoci
aVoci = Array("","Estratto","Ambo","Terno","Quaterna","Cinquina")
ret = ScegliOpzioneMenu(aVoci,1," Analisi per Sorte di : ")
SelEsito = ret
End Function
Function SelRuota
Dim ret
Dim aVoci
aVoci = Array("","BARI","CAGLIARI","FIRENZE","GENOVA","MILANO","NAPOLI","PALERMO","ROMA","TORINO","VENEZIA","TUTTE","NAZIONALE")
ret = ScegliOpzioneMenu(aVoci,3," Analizza Ruota di : ")
SelRuota = ret
End FunctionAggiornamento del 26/8/2023
Codice:
Option Explicit
Sub Main
' tom's bakery script x lotto n. script n. 33 B script 100x100 UPGRADE con scelta x esaminare situazione passata di tot estrazioni passate (es. 10); lo script raggruppa e visualizza
'anche le formazioni non sfaldatasi per la sorte, classe e ruota di ricerca tra l'estrazione di fine verifca decisa e quella ultima presente in archivio. Spesso il gu relativo potrebbe
'regalare soprese anche a colpo... e quindi rappresentare un'ottima base per eventuali riduzioni relative...
Dim nSorte,aRuote,Ini,fin,sMsg,nMoltip,nTrov,nNumSel
Dim nCicloTeo,nRitMax,nRitMin,nClasseLunghetta,nRuoteSel,nLunghetteDaTrov,i2,ccColonna,ClasseFin
Dim TimeStart
Dim k,CollComb,cColonna
Dim aN
Dim TipoAlgo
Dim RetRit,RetRitMax,RetIncrRitMax,RetFrq
Dim nSuperficialita
Call Scrivi
Call Scrivi("Elaborazione eseguita con archivio lotto aggiornato al: " & giorno(EstrazioneFin) & "-" & Mese(EstrazioneFin) & "-" & Anno(EstrazioneFin))
Call Scrivi
Dim estrazione
Dim colpidiverifica
Dim winalcolponumero
Dim esitoverifica
Dim estrattiusciti
Dim estrazionediuscita
Dim colpomassimo
Dim casipositivi
Dim casinegativi
Dim casiattuali
Dim casitotali
Dim estrazionidaverificare
Dim sortediverifica
Dim Inizioverifica
Dim colpirimanentirispettocolpomassimo
Dim colpirimanentirispettocolpidiricerca
Dim colpirimanentiminimi
Dim Formazioneconcolpirimanentiminimi
Dim ruotaconcolpirimanentiminimi
Dim esitoestratto
Dim esitoambo
Dim esitoterno
Dim esitoquaterna
Dim esitocinquina
Dim estrapolaestratti
Dim raccoltaambatebuone
estrapolaestratti = "estrapolaestratti.txt"
If FileEsistente(estrapolaestratti) Then
Call EliminaFile(estrapolaestratti)
End If
esitoestratto = 0
esitoambo = 0
esitoterno = 0
esitoquaterna = 0
esitocinquina = 0
colpirimanentiminimi = EstrazioneFin
fin = EstrazioneFin
Dim EstrazioneFinaleAssoluta
Dim diquanteestrazionitroncarevirtualmentelarchivio
diquanteestrazionitroncarevirtualmentelarchivio = CInt(InputBox("Di quante ultime estrazioni troncare virtualmente l'archivio?",,0))
EstrazioneFinaleAssoluta = EstrazioniArchivio - diquanteestrazionitroncarevirtualmentelarchivio
MsgBox "ricordarsi che per andare indietro del numero di estrazioni volute in questa versione basta usare l'apposita barra temporale presente in fondo al programma"
estrazionidaverificare = CInt(InputBox("estrazioni da verificare",,369))
Inizioverifica = fin - estrazionidaverificare
colpidiverifica = CInt(InputBox("colpidi di verifica",,estrazionidaverificare - 2))
sortediverifica = CInt(InputBox("sorte di verifica",,1))
nTrov = 0
nNumSel = ScegliNumeri(aN)
ReDim aRuote(0)
Call ScegliRuote(aRuote)
nSorte = SelEsito
nClasseLunghetta = CInt(InputBox("Scegli classe lunghetta di partenza",,3))
ClasseFin = CInt(InputBox("Scegli classe lunghetta finale",,nClasseLunghetta - 1))
For estrazione = Inizioverifica To fin
Scrivi
Scrivi "<font color=red>" & GetInfoEstrazione(estrazione) & "</font>"
Scrivi
Dim r
For r = 1 To 100
Call Messaggio(GetInfoEstrazione(estrazione) & " c+ " & casipositivi & " c- " & casinegativi & " ca " & casiattuali & " clpmax " & colpomassimo & " crt min " & colpirimanentirispettocolpomassimo & " ruote " & StringaRuote(aRuote))
Next
TipoAlgo = 0
nSuperficialita = 0
nLunghetteDaTrov = 1
nMoltip = 8
nRitMax = 0
nRitMin = 0
Ini = fin - nRitMax
If Ini <= 0 Then Ini = 1
TimeStart = Timer
Call GetLunghettePiuRitardate(aN,aRuote,nClasseLunghetta,nSorte,CollComb,EstrazioneIni,estrazione,nRitMin,nRitMax,nLunghetteDaTrov,TipoAlgo,nSuperficialita)
Call OrdinaItemCollection(CollComb,"Ritardo",,,- 1)
Call Scrivi("Analisi sulla ruota " & StringaRuote(aRuote) & " per la sorte di " & nSorte)
Scrivi
For i2 = nClasseLunghetta To ClasseFin Step - 1
For Each cColonna In CollComb
Call GetLunghettePiuRitardate(cColonna.aNum,aRuote,i2,nSorte,CollComb,EstrazioneIni,estrazione,nRitMin,nRitMax,nLunghetteDaTrov,TipoAlgo,nSuperficialita)
For Each ccColonna In CollComb
Call StatisticaFormazioneTurbo(ccColonna.aNum,aRuote,nSorte,RetRit,RetRitMax,RetIncrRitMax,RetFrq,EstrazioneIni,estrazione)
If i2 = ClasseFin Then
Call Scrivi(" " & " " & " " & cColonna.GetStringaNum & " Rit " & cColonna.Ritardo)
Call Scrivi(i2 & " " & ccColonna.GetStringaNum & "" & " -1")
Dim numeridaverificare
Dim ruotedaverificare
Call SplitByChar("." & ccColonna.GetStringaNum & ".",".",numeridaverificare)
Call SplitByChar("." & StringaNumeri(aRuote) & ".",".",ruotedaverificare)
Scrivi "Verifica sfaldamento eventuale da " & GetInfoEstrazione(fin) & " a " & GetInfoEstrazione(EstrazioneFinaleAssoluta)
Call StatisticaFormazioneTurbo(numeridaverificare,aRuote,nSorte,RetRit,RetRitMax,RetIncrRitMax,RetFrq,fin,EstrazioneFinaleAssoluta)
If RetFrq <> "" And RetFrq > 0 Then
Scrivi "<strong>COMBINAZIONE GIA' SFALDATA entro il " & GetInfoEstrazione(EstrazioneFinaleAssoluta) & " (teoricamente già bruciata...) </strong>",,,,vbRed
Scrivi "FREQUENZA DI VERIFICA " & RetFrq
Else
Scrivi "<strong>COMBINAZIONE NON SFALDATA entro il " & GetInfoEstrazione(EstrazioneFinaleAssoluta) & " (teoricamente buona...) </strong>",,,,vbBlue
raccoltaambatebuone = raccoltaambatebuone & "." & StringaNumeri(numeridaverificare)
End If
Call VerificaEsitoTurbo(numeridaverificare,ruotedaverificare,estrazione + 1,sortediverifica,colpidiverifica,,esitoverifica,winalcolponumero,estrattiusciti,estrazionediuscita)
If esitoverifica <> "" Then
Scrivi esitoverifica & " | <font color=green>ok | estratti " & estrattiusciti & " al colpo numero " & winalcolponumero & "</font>"
ScriviFile estrapolaestratti,esitoverifica & " . " & estrattiusciti
CloseFileHandle(estrapolaestratti)
Dim convertiesito
If esitoverifica = "Estratto" Then
convertiesito = 1
End If
If esitoverifica = "Ambo" Then
convertiesito = 2
End If
If esitoverifica = "Terno" Then
convertiesito = 3
End If
If esitoverifica = "Quaterna" Then
convertiesito = 4
End If
If esitoverifica = "Cinqina" Then
convertiesito = 5
End If
Select Case(convertiesito)
Case 1
esitoestratto = esitoestratto + 1
Case 2
esitoambo = esitoambo + 1
Case 3
esitoterno = esitoterno + 1
Case 4
esitoquaterna = esitoquaterna + 1
Case 5
esitocinquina = esitocinquina + 1
End Select
casipositivi = casipositivi + 1
If winalcolponumero > colpomassimo Then
colpomassimo = winalcolponumero
Dim colpomassimorelativo
colpomassimorelativo = colpomassimo
End If
Else
colpirimanentirispettocolpidiricerca = colpidiverifica -(EstrazioneFin - estrazione)
colpirimanentirispettocolpomassimo = colpomassimo -(EstrazioneFin - estrazione)
If colpirimanentirispettocolpidiricerca < 0 Then
Scrivi "no"
casinegativi = casinegativi + 1
Else
Scrivi
Scrivi "<font color=blue>formazione " & StringaNumeri(numeridaverificare) & "</font>"
Scrivi "<font color=blue>ruote " & StringaNumeri(ruotedaverificare) & "</font>"
Scrivi "<font color=blue>colpi rimanenti rispetto colpi di ricerca " & colpirimanentirispettocolpidiricerca & "</font>"
Scrivi "<font color=blue>colpi rimanenti rispetto colpo massimo " & colpirimanentirispettocolpomassimo & "</font>"
Scrivi "<font color=blue>colpo massimo relativo " & colpomassimorelativo & "</font>"
Scrivi
casiattuali = casiattuali + 1
If colpirimanentirispettocolpidiricerca < colpirimanentiminimi Then
colpirimanentiminimi = colpirimanentirispettocolpidiricerca
Formazioneconcolpirimanentiminimi = StringaNumeri(numeridaverificare)
ruotaconcolpirimanentiminimi = StringaNumeri(ruotedaverificare)
End If
If colpirimanentirispettocolpomassimo < colpirimanentiminimi Then
colpirimanentiminimi = colpirimanentirispettocolpomassimo
Formazioneconcolpirimanentiminimi = StringaNumeri(numeridaverificare)
ruotaconcolpirimanentiminimi = StringaNumeri(ruotedaverificare)
End If
End If
End If
End If
Next
Next
Next
Scrivi
If ScriptInterrotto Then Exit For
Next ' x estrazione
Scrivi
Scrivi "elaborazione con archivio aggiornato al " & GetInfoEstrazione(EstrazioneFinaleAssoluta)
Scrivi "archivio lotto troncato virtualmente di " & diquanteestrazionitroncarevirtualmentelarchivio & " ultime estrazioni "
Scrivi "range temporale di analisi " & GetInfoEstrazione(EstrazioneIni) & " - " & GetInfoEstrazione(EstrazioneFin)
Scrivi "n. ultime estrazioni analizzate e verificate " & estrazionidaverificare
Scrivi "ultima estrazione di verifica sfaldamento cf " & GetInfoEstrazione(fin)
Scrivi "quante estrazioni in meno rispetto l'ultima ... " & EstrazioniArchivio - EstrazioneFin
Scrivi "sdr " & nSorte
Scrivi "sdv " & sortediverifica
Scrivi "cf " & ClasseFin
Scrivi "c+ " & casipositivi
Scrivi "c- " & casinegativi
Scrivi "ca " & casiattuali
Scrivi "clp rim min " & colpirimanentiminimi
Scrivi "formazione con clp rim min " & Formazioneconcolpirimanentiminimi
Scrivi "ruota con clp rim min " & ruotaconcolpirimanentiminimi
Scrivi "ct " & casitotali
casitotali = casipositivi + casinegativi + casiattuali
If casipositivi <> "" Then
Scrivi "%+ " &(casipositivi/casitotali)*100
End If
Scrivi "cna " &(fin - Inizioverifica) - casitotali
Scrivi "clpmax " & colpomassimo
Scrivi
Scrivi "e : " & esitoestratto
Scrivi "a : " & esitoambo
Scrivi "t : " & esitoterno
Scrivi "q : " & esitoquaterna
Scrivi "c : " & esitocinquina
Scrivi "---------------------------"
Scrivi "tot : " & esitoestratto + esitoambo + esitoterno + esitoquaterna + esitocinquina
Scrivi
Dim xclasseguambatebuone
raccoltaambatebuone = Replace(raccoltaambatebuone,"...",".")
raccoltaambatebuone = Replace(raccoltaambatebuone,"..","")
Scrivi "gu ambate teoricamente buone da ripulire e ordinare " & raccoltaambatebuone
raccoltaambatebuone = Left(raccoltaambatebuone,Len(raccoltaambatebuone) - 1)
Call SplitByChar(raccoltaambatebuone,".",xclasseguambatebuone)
Call OrdinaMatriceTurbo(xclasseguambatebuone,1)
Scrivi "gu ambate teoricamente buone ripulito e ordinato con occorenze multiple " & StringaNumeri(xclasseguambatebuone) & " classe " & UBound(xclasseguambatebuone)
'prova rilevamento automatico presenze x singoli elementi del gu (by chatgpt)
Dim inputString
inputString = StringaNumeri(xclasseguambatebuone)
'esempio analisi di formazione di multipli "fissa"
'inputString = "04.04.08.08.08.08.08.08.08.08.08.08.15.15.15.15.15.15.15.15.15.15.15.15.15.15.15.15.15.15.15.15.15.15.15.15.15.15.15.15.15.15.15.15.17.17.17.17.17.17.17.17.17.17.17.19.19.19.19.19.19.19.24.24.24.24.24.24.25.25.25.25.25.25.25.25.25.25.25.25.25.25.25.25.25.25.25.25.25.25.34.34.34.34.34.34.34.39.39.39.39.39.39.39.39.39.39.53.53.56.56.56.56.56.56.56.56.56.56.56.56.56.56.56.56.56.56.56.56.56.56.56.56.56.56.67.67.67.67.67.67.68.68.68.68"
Dim elements
'elements = Split(inputString, ".")
Call SplitByChar(inputString,".",elements)
Dim dict
Set dict = CreateObject("Scripting.Dictionary")
Dim element
Dim key
Dim WSscript
For Each element In elements
If IsNumeric(element) Then
If dict.Exists(element) Then
dict(element) = dict(element) + 1
Else
dict.Add element,1
End If
End If
Next
Scrivi
For Each key In dict.Keys
Scrivi key & ": presenze " &(dict(key))
Next
Scrivi
'-----------------------------------------------------------------------------------------------------------
Call EliminaRipetuti(xclasseguambatebuone)
Call SplitByChar(StringaNumeri(xclasseguambatebuone),".",xclasseguambatebuone)
Scrivi "gu ambate teoricamente buone ripulito e ordinato senza ripetuti " & StringaNumeri(xclasseguambatebuone) & " classe " & UBound(xclasseguambatebuone) + 1
Dim xordinamentoguambatebuone
Call SplitByChar(StringaNumeri(xclasseguambatebuone),".",xordinamentoguambatebuone)
Dim i
Dim n
ReDim Valorinterixordinamentoguambatebuone(UBound(xordinamentoguambatebuone))
Scrivi
For i = 0 To UBound(xordinamentoguambatebuone)
Scrivi "|" & xordinamentoguambatebuone(i) & "|"
Next
Scrivi
Call Scrivi("Tempo di elaborazione : " & TempoTrascorso)
End Sub
Function ScegliClassseLunghetta
Dim aVoci(30)
Dim k,i
For k = 2 To(2 - 1) + UBound(aVoci)
i = i + 1
aVoci(i) = k
Next
k = ScegliOpzioneMenu(aVoci,5,"Classe lunghetta")
ScegliClassseLunghetta = Int(aVoci(k))
End Function
Function SelRuote(aRuote)
Dim t,k,bTutte
bTutte = False
t = ScegliRuote(aRuote)
For k = 1 To t
If aRuote(k) = TT_ Then
bTutte = True
Exit For
End If
Next
If bTutte Then
ReDim aRuote(10)
For k = 1 To 10
aRuote(k) = k
Next
SelRuote = 10
Else
SelRuote = t
End If
End Function
Function FormattaSecondi(s)
Dim hh
Dim Mm
Dim Ss
Dim TimeStr
hh = s \ 3600
Mm =(s Mod 3600) \ 60
Ss = s -((hh * 3600) +(Mm * 60))
TimeStr = Format2(hh) & ":" & Format2(Mm) & ":" & Format2(Ss)
FormattaSecondi = TimeStr
End Function
Function SelEsito
Dim ret
Dim aVoci
aVoci = Array("","Estratto","Ambo","Terno","Quaterna","Cinquina")
ret = ScegliOpzioneMenu(aVoci,1," Analisi per Sorte di : ")
SelEsito = ret
End Function
Function SelRuota
Dim ret
Dim aVoci
aVoci = Array("","BARI","CAGLIARI","FIRENZE","GENOVA","MILANO","NAPOLI","PALERMO","ROMA","TORINO","VENEZIA","TUTTE","NAZIONALE")
ret = ScegliOpzioneMenu(aVoci,3," Analizza Ruota di : ")
SelRuota = ret
End Function
Ultima modifica:
lotto_tom75
Advanced Premium Member
Script n. 34 tom's bakery by tom x lotto ; analizzatore risultanze colimanti e derivanti da filtraggi custom di elaborazioni random volute
Codice:
Option Explicit
Sub Main
' Script n.34 tom's bakery by tom x lotto ; analizzatore risultanze colimanti e derivanti da filtraggi custom di elaborazioni random volute
Dim k
Dim Classe
Dim aCol
ReDim aNum(90)
Dim i
Dim valorecollimantidesiderato
Dim nSorte,Fine,RetRit1,QuantitaNumeriScelti,aRuoteSel,RuoteSelezionate,RetRitMax,RetIncrRitMax,RetFreq,Inizio
Dim ColTot,aRetcol
Dim valoreInizioelaborazione,valorefineelaborazione
Dim sfilexcollimazionefull
Dim sfile
sfilexcollimazionefull = ".\lunghettesolonumerixcollimazionefull.txt"
sfile = ".\lunghetta-valutando-tutte-le-ruote-separate-xsortevoluta.txt"
If FileEsistente(sfilexcollimazionefull) Then
Call EliminaFile(sfilexcollimazionefull)
End If
If FileEsistente(sfile) Then
Call EliminaFile(sfile)
End If
ReDim aNum(0)
QuantitaNumeriScelti = ScegliNumeri(aNum)
ReDim aRuoteSel(12)
ReDim aRuoteSel(12)
RuoteSelezionate = ScegliRuote(aRuoteSel)
Dim Classeiniziale
Dim Classefinale
Classeiniziale = CInt(InputBox("classe iniziale",,85)) ' UBound(aNum) - 1))
Classefinale = CInt(InputBox("classe finale",,Classeiniziale))
Dim y
nSorte = CInt(InputBox("sorte",,5))
valorecollimantidesiderato = CInt(InputBox("valore collimanti desiderato (circa)",,10))
Call EliminaFile(sfile)
Inizio = EstrazioneIni '1
valoreInizioelaborazione = 1
valorefineelaborazione = CInt(InputBox("valore fine elaborazione random (max10000)",,10000))
Dim moltiplicatoreelaborazionirandom
moltiplicatoreelaborazionirandom = CInt(InputBox("valore fine elaborazione random (max10000)",,1000))
valorefineelaborazione = valorefineelaborazione * moltiplicatoreelaborazionirandom
For y = Classeiniziale To Classefinale Step - 1
ReDim aRuoteTmp(1)
Dim valide
valide = 0
Dim collimazionefullok
collimazionefullok = 0
For k = 1 To RuoteSelezionate
aRuoteTmp(1) = aRuoteSel(k)
For i = valoreInizioelaborazione To valorefineelaborazione
Call GetColonnaCasuale(y,aRetcol,aNum)
Call StatisticaFormazioneTurbo(aRetcol,aRuoteTmp,nSorte,RetRit1,RetRitMax,RetIncrRitMax,RetFreq,Inizio)
Call AvanzamentoElab(1,valorefineelaborazione,i)
Call Messaggio("Colonna " & i & " Ruota: " & SiglaRuota(aRuoteTmp(1)) & " classe " & y & " sorte " & nSorte & " valide " & valide & " collimanti 100% " & Int(collimazionefullok)/2)
Dim Diff
Diff = RetRitMax - RetRit1
If(RetRit1 > 0 And Diff = 0) Then
collimazionefullok = 0
valide = valide + 1
Call analisicollimanti(sfilexcollimazionefull,collimazionefullok)
Call Scrivi("Ruota: " & SiglaRuota(aRuoteSel(k)) & " Colonna: " & i & " " & StringaNumeri(aRetcol,,True) & " RA " & RetRit1 & " RS " & RetRitMax & " INCMAX " & RetIncrRitMax & " FQ " & RetFreq & " Diff " & Diff & " classe " & y & " sorte " & nSorte)
Dim reportlunghettadoc2,reportlunghettesolonumerixanalisicollimazionefull
reportlunghettadoc2 = "Ruota: " & SiglaRuota(aRuoteSel(k)) & " Colonna: " & i & " " & StringaNumeri(aRetcol,,True) & " RA " & RetRit1 & " RS " & RetRitMax & " INCMAX " & RetIncrRitMax & " FQ " & RetFreq & " Diff " & Diff
sfile = ".\lunghetta-valutando-tutte-le-ruote-separate-xsortevoluta.txt"
sfilexcollimazionefull = ".\lunghettesolonumerixcollimazionefull.txt"
reportlunghettesolonumerixanalisicollimazionefull = StringaNumeri(aRetcol,,True)
Call ScriviFile(sfile,reportlunghettadoc2,False,True)
Call ScriviFile(sfilexcollimazionefull,reportlunghettesolonumerixanalisicollimazionefull,False,True)
If i = valorefineelaborazione Then
Exit For
End If
End If
Call CloseFileHandle(sfile)
Call CloseFileHandle(sfilexcollimazionefull)
If ScriptInterrotto Or(collimazionefullok/2) > 0 And(collimazionefullok/2) <= valorecollimantidesiderato Then Exit For
Next
Next
Dim x
Dim k2
Dim sfilerisultanzexanalisicollimazione
Dim filerisultanzecollimazione
filerisultanzecollimazione = ".\risultaticollimazione.txt"
Dim Stringarisultaticollimazione
If FileEsistente(filerisultanzecollimazione) Then
Call EliminaFile(filerisultanzecollimazione)
End If
filerisultanzecollimazione = ".\risultaticollimazione.txt"
Call CloseFileHandle(sfilexcollimazionefull)
ReDim numeri(90,2)
ReDim nr(90)
If FileEsistente(sfilexcollimazionefull) Then
Call Messaggio("Lettura file di testo")
ReDim aRighe(0)
Call LeggiRigheFileDiTesto(sfilexcollimazionefull,aRighe)
For k = 0 To UBound(aRighe)
If aRighe(k) <> "" Then
Call SplitByChar(aRighe(k),".",nr)
For k2 = 0 To UBound(nr)
numeri(nr(k2),1) = numeri(nr(k2),1) + 1
numeri(nr(k2),2) = nr(k2)
Next
End If
Next
Call OrdinaMatrice(numeri,- 1,1)
ColoreTesto(2)
ColoreTesto(0)
Scrivi
Scrivi
Scrivi "Questi numeri sottostanti collimano per almeno due valori..."
Scrivi
Scrivi
For x = 1 To 90
If numeri(x,1) >= 2 Then
Scrivi Format2(numeri(x,2)) & " pres. " & numeri(x,1)
Stringarisultaticollimazione =(Format2(numeri(x,2)) & " pres. " & numeri(x,1))
Call ScriviFile(filerisultanzecollimazione,Stringarisultaticollimazione,False,True)
End If
Next
Scrivi
Scrivi
Scrivi "Questi numeri sottostanti collimano per tutte le " &(UBound(aRighe) + 1) & " righe rilevate..."
Scrivi
Scrivi
For x = 1 To 90
If numeri(x,1) = UBound(aRighe) + 1 Then
Scrivi Format2(numeri(x,2)) & " pres. " & numeri(x,1)
Stringarisultaticollimazione =(Format2(numeri(x,2)) & " pres. " & numeri(x,1))
Call ScriviFile(filerisultanzecollimazione,Stringarisultaticollimazione,False,True)
collimazionefullok = collimazionefullok + 1
End If
Next
Scrivi
Scrivi "I valori collimanti al 100% sono in tutto: " & collimazionefullok
Scrivi
Scrivi
Call Scrivi("versione report con i soli numeri collimanti al 100%")
Scrivi
For x = 1 To 90
If numeri(x,1) = UBound(aRighe) + 1 Then
Scrivi Format2(numeri(x,2))
Stringarisultaticollimazione =(Format2(numeri(x,2)))
Call ScriviFile(filerisultanzecollimazione,Stringarisultaticollimazione,False,True)
collimazionefullok = collimazionefullok + 1
End If
Next
End If
Call CloseFileHandle(filerisultanzecollimazione)
Call LanciaFile(filerisultanzecollimazione)
Next
Scrivi
Scrivi "vediamo se la rifa...."
Scrivi
Call analisicollimanti(sfilexcollimazionefull,collimazionefullok)
End Sub
Function analisicollimanti(sfilexcollimazionefull,collimazionefullok)
Dim nsorte
Dim valide
Dim y
Dim x
Dim k
Dim k2
Dim i
ReDim aruotetmp(1)
Dim sfilerisultanzexanalisicollimazione
Dim filerisultanzecollimazione
filerisultanzecollimazione = ".\risultaticollimazione.txt"
Dim Stringarisultaticollimazione
collimazionefullok = 0
filerisultanzecollimazione = ".\risultaticollimazione.txt"
Call CloseFileHandle(sfilexcollimazionefull)
ReDim numeri(90,2)
ReDim nr(90)
If FileEsistente(sfilexcollimazionefull) Then
Call Messaggio("Lettura file di testo")
ReDim aRighe(0)
Call LeggiRigheFileDiTesto(sfilexcollimazionefull,aRighe)
For k = 0 To UBound(aRighe)
If aRighe(k) <> "" Then
Call SplitByChar(aRighe(k),".",nr)
For k2 = 0 To UBound(nr)
numeri(nr(k2),1) = numeri(nr(k2),1) + 1
numeri(nr(k2),2) = nr(k2)
Next
End If
Next
Call OrdinaMatrice(numeri,- 1,1)
ColoreTesto(2)
ColoreTesto(0)
Scrivi
Scrivi
Scrivi "Questi numeri sottostanti collimano per almeno due valori..."
Scrivi
Scrivi
For x = 1 To 90
If numeri(x,1) >= 2 Then
Scrivi Format2(numeri(x,2)) & " pres. " & numeri(x,1)
Stringarisultaticollimazione =(Format2(numeri(x,2)) & " pres. " & numeri(x,1))
Call ScriviFile(filerisultanzecollimazione,Stringarisultaticollimazione,False,True)
End If
Next
Scrivi
Scrivi
Scrivi "Questi numeri sottostanti collimano per tutte le " &(UBound(aRighe) + 1) & " righe rilevate..."
Scrivi
Scrivi
For x = 1 To 90
If numeri(x,1) = UBound(aRighe) + 1 Then
Scrivi Format2(numeri(x,2)) & " pres. " & numeri(x,1)
Stringarisultaticollimazione =(Format2(numeri(x,2)) & " pres. " & numeri(x,1))
Call ScriviFile(filerisultanzecollimazione,Stringarisultaticollimazione,False,True)
collimazionefullok = collimazionefullok + 1
End If
Call Messaggio("Colonna " & i & " Ruota analizzata: " & SiglaRuota(aruotetmp(1)) & " classe " & y & " sorte " & nsorte & " valide " & valide & " collimanti 100% " & collimazionefullok)
Next
Scrivi
Scrivi "I valori collimanti al 100% sono in tutto: " & collimazionefullok
Scrivi
Scrivi
Call Scrivi("versione report con i soli numeri collimanti al 100%")
Scrivi
For x = 1 To 90
If numeri(x,1) = UBound(aRighe) + 1 Then
Scrivi Format2(numeri(x,2))
Stringarisultaticollimazione =(Format2(numeri(x,2)))
Call ScriviFile(filerisultanzecollimazione,Stringarisultaticollimazione,False,True)
collimazionefullok = collimazionefullok + 1
End If
Next
End If
Call CloseFileHandle(filerisultanzecollimazione)
Call LanciaFile(filerisultanzecollimazione)
End Functionlotto_tom75
Advanced Premium Member
Ciao mira, si certo più di una e ovviamente di classe molto contenuta. Ad ogni modo dipende da cosa intendi per sempre.. Dal 1871 o da dopo (es7440, es8117 ecc) ? Io quel genere di formazioni le chiamo abs (absolute con ra==RS=0) come sa benissimo ormai anche l'espertissima Cinzia al riguardo
lotto_tom75
Advanced Premium Member
Ovviamente... è soggettivo
Comunque...
Tolta ora dal forno...
N.r: 11 Colonna: 9 05.06.07.15.24.29.35.39.41.47.49.57.60.62.64.69.70.74.76.84.85.86.87.88.90 RA 0 RS 0 INCMAX 0 FQ 15281 Diff 0 classe 25 sorte 2 riga 636
Valore soglia raggiunto 25
Dopo appena 10 iterazioni e un tempo risicatissimo di rilevamento di meno 1 min. Ovviamente... questa è su TT (esclusa NZ) includendo anche la ruota "ladra di pronostici" al momento si scende a 22 elementi.
Il forno:
Script n. 35 tom's bakery by tom x lotto : Se il numero 32-33-34 sono la ferrari, la lamborghini e un altra super car a livello pratico di eleborazione per il sottoscritto anche questo n.35 è come minimo una porshe
. Mi ha consentito infatti di rilevare formazioni automaticamente ridotte progressivamente a partire da qualsivoglia gruppo base e su qualsiasi gruppo di ruote unite soddisfacenti qualsiasi filtro impostato all'inizio e in particolare le ormai famose abs 
Codice:
'Script n.35 tom's bakery x lotto by tom IRONBOT configurato per ricerca abs e non solo. Lo script data una soglia minima di filtro impostabili 'entrambi a piacere... rileva dopo tot iterazioni volute sempre scelte all'inizio dell'elaborazione la formazione soddisfacente i parametri di ricerca.
Option Explicit
Sub Main
Dim k
Dim Classe
Dim aCol
ReDim aNum(90)
Dim i,i2
Dim nSorte,Fine,RetRit1,QuantitaNumeriScelti,aRuoteSel,RuoteSelezionate,RetRitMax,RetIncrRitMax,RetFreq,Inizio
Dim ColTot,aRetcol
Dim valoreInizioelaborazione,valorefineelaborazione
Dim Valoresogliaraggiunto
Valoresogliaraggiunto = EstrazioneFin
Dim ruota
Dim ff
Dim numerocolonne
Dim multiplocolonne
Dim numerocolonnerandomtotale
Dim ramassimotop
Dim ramassimostandard
Dim raminimostandard
Dim Incmaxdeciso
Dim puntidipartenzadasottrarre
Dim puntiriduzioneadognipassaggio
ReDim grupponumericobaseiniziale(0)
ScegliNumeri(grupponumericobaseiniziale)
Dim diffdecisa
Dim quantestrazionidallafine
Dim filexanalisicollimanze
filexanalisicollimanze = ".\filexanalisicollimanze.txt"
Dim Iniziorange
Iniziorange = EstrazioneIni
Fine = EstrazioneFin
quantestrazionidallafine = Fine - Iniziorange
Dim counter
counter = 0
Dim casiesaminati
casiesaminati = 0
Dim casipositivi
Dim casinegativi
Dim casiattivi
casipositivi = 0
casinegativi = 0
casiattivi = 0
Dim estrazionidaanalizzare
estrazionidaanalizzare = EstrazioneFin '0 ' 315 '220 '290 '360
Dim quanteiterazioni
quanteiterazioni = CInt(InputBox("Quante iterazioni vuoi effettuare per questa analisi?",,10)) '1 ' 100))
Inizio = CInt(InputBox("Da quale estrazione vuoi partire per l'analisi?",,Iniziorange))
Fine = CInt(InputBox("Quale estrazione vuoi impostare come ultima di studio?",,Fine))
Classe = CInt(InputBox("QUALE GRUPPO NUMERICO ASSOLUTO O SEMI ASSOLUTO DI SVILUPPO",,UBound(grupponumericobaseiniziale) - 1)) '78)) 'provo a velocizzare ricerca facendola partire da una classe molto + ridotta rispetto la 73ina...
Classefinale = CInt(InputBox("QUALE CLASSE FINALE DI SVILUPPO",,40))
puntidipartenzadasottrarre = CInt(InputBox("DA QUANTI PUNTI PARTIRE IN MENO RISPETTO LA CLASSE DEL GRUPPO NUMERICO SCELTO",,1))
puntiriduzioneadognipassaggio = CInt(InputBox("QUANTI PUNTI RIDUZIONALI SOTTRARRE AD OGNI PASSAGGIO",,1))
nSorte = CInt(InputBox("QUALE SORTE DI RICERCA","sorte di ricerca",1))
ff = CInt(InputBox("QUANTE ESTRAZIONI DALLA FINE",,estrazionidaanalizzare)) 'quantestrazionidallafine + 1))
numerocolonne = CInt(InputBox("QUANTE COLONNE RANDOM ANALIZZARE (max 10000)",,500))
multiplocolonne = CInt(InputBox("FATTORE DI MOLTIPLICAZIONE COLONNE RANDOM (max 10000)",,1))
ramassimotop = CInt(InputBox("RITARDO MASSIMO TOP",,0)) ' 9000))
raminimostandard = CInt(InputBox("RITARDO MINIMO STANDARD",,0))
ramassimostandard = CInt(InputBox("RITARDO MASSIMO STANDARD",,ramassimotop))
Incmaxdeciso = CInt(InputBox("INCMAX DA CUI PARTIRE",,0))
Dim classemaxperoutput
classemaxperoutput = CInt(InputBox("CLASSE MAX X OUTPUT",,55))
ReDim aRuote(0)
RuoteSelezionate = ScegliRuote(aRuote)
Inizio = EstrazioneFin - ff
If FileEsistente(filexanalisicollimanze) Then
Call EliminaFile(filexanalisicollimanze)
End If
filexanalisicollimanze = ".\filexanalisicollimanze.txt"
Dim contaiterazioni
For contaiterazioni = 1 To quanteiterazioni
Dim sfilereportdinamico,Classedinamicaprogressiva
sfilereportdinamico = ".\risultanzadinamica.txt"
Dim filenumericoiniziale
filenumericoiniziale = ".\risultanzadinamica.txt"
If FileEsistente(filenumericoiniziale) Then
Call EliminaFile(filenumericoiniziale)
End If
filenumericoiniziale = ".\risultanzadinamica.txt"
Dim n
sfileclassedinamica = ".\classedinamica" & n & ".txt"
For n = 1 To 90
If FileEsistente(".\classedinamica" & n & ".txt") Then
Call EliminaFile(".\classedinamica" & n & ".txt")
End If
If ScriptInterrotto Then Exit For
Next
Call ScriviFile(filenumericoiniziale,StringaNumeri(grupponumericobaseiniziale))
Call CloseFileHandle(filenumericoiniziale)
Dim aRuoteTmp
Dim sfile
Dim sFiles
Dim aLunghette
Dim sFiletxt
Dim contatore
Dim c,alunghetta
numerocolonnerandomtotale = numerocolonne * multiplocolonne
valoreInizioelaborazione = 1
valorefineelaborazione = numerocolonnerandomtotale '...
' ReDim aRuote(0)
' RuoteSelezionate = ScegliRuote(aRuote)
Call Messaggio("Lettura file di testo")
ReDim aRighe(0)
sFiletxt = ".\risultanzadinamica.txt"
LeggiRigheFileDiTesto sFiletxt,aRighe
For k = 0 To UBound(aRighe)
If aRighe(k) <> "" Then
ReDim aSelNum(0)
Call SplitByChar("." & aRighe(k),".",aNum)
End If
Next
sFiletxt = ".\risultanzadinamica.txt"
Dim partida
Dim Classefinale
partida = Classe - puntidipartenzadasottrarre
Scrivi "Analizzatore lunghette desiderate di gruppo numerico desiderato",1,1,1,5,3
Scrivi "per sorte desiderata in quantità di colonne Random desiderate (max 100 mln)",1,1,1,5,3
Scrivi
Scrivi
Scrivi "By Lotto_tom75 - Numeri Lotto Team",1,1,1,4,2
Scrivi
Call Scrivi("Sviluppo Combinazioni del gruppo numerico assoluto o semi assoluto di classe " & Classe & " a partire dalla Classe ridotta " & partida)
Call Scrivi(" per la sorte di... " & NomeSorte(nSorte),1,1,2,4,4) ' size 5
Scrivi
Scrivi "Totale colonne elaborate: " & numerocolonnerandomtotale,0,0,1,4,5
Scrivi
Scrivi "Totale estrazioni elaborate: " & ff,0,0,1,4,5
Scrivi
Scrivi
Scrivi "Estrazione inizio... " & GetInfoEstrazione(Iniziorange) & " Estrazione fine... " & GetInfoEstrazione(EstrazioneFin) '& " estrazione intermedia di analisi " & idestrazione
Scrivi
For k = 1 To RuoteSelezionate
Call Scrivi("Scelta ruota " & NomeRuota(aRuote(k)) & " - " & SiglaRuota(aRuote(k)))
Next
Scrivi
Scrivi
Scrivi "RA massimo impostato con scrittura su file e alert... RA= " & ramassimotop
Scrivi
Scrivi "RA medio impostato con scrittura su file e output... RA= " & ramassimostandard
Scrivi
Scrivi "Incmax da cui partire... Incmax= " & Incmaxdeciso
Scrivi
Call Scrivi
Call Scrivi("Elaborazione con archivio aggiornato al: " & giorno(EstrazioneFin) & "-" & Mese(EstrazioneFin) & "-" & Anno(EstrazioneFin))
Call Scrivi
Dim idestrazione
For idestrazione = Inizio To Fine
For i2 = partida To Classefinale Step - puntiriduzioneadognipassaggio
ReDim aNum(0)
Call Messaggio("Lettura file di testo")
ReDim aRighe(0)
sFiletxt = ".\risultanzadinamica.txt"
LeggiRigheFileDiTesto sFiletxt,aRighe
For k = 0 To UBound(aRighe)
If aRighe(k) <> "" Then
ReDim aSelNum(0)
Call SplitByChar("." & aRighe(k),".",aNum)
End If
Next
For i = valoreInizioelaborazione To valorefineelaborazione
Dim NomeRuotaNome
If RuoteSelezionate > 1 Then
NomeRuotaNome = "ruote decise unite"
Else
NomeRuotaNome = SiglaRuota(aRuote(1)) '& SiglaRuota(aRuote(2))
End If
Call Messaggio("c" & i2 & " " & StringaNumeri(aRuote) & " s" & nSorte & " v " & counter & " " & Iniziorange & "-" & idestrazione & " rm " & raminimostandard & " es " & Fine - Inizio & " it " & contaiterazioni & " crt " & crt & " csi " & casiesaminati & " cs+ " & casipositivi & " cs- " & casinegativi & " csa " & casiattivi)
Call GetColonnaCasuale(i2,aRetcol,aNum)
Call StatisticaFormazioneTurbo(aRetcol,aRuote,nSorte,RetRit1,RetRitMax,RetIncrRitMax,RetFreq,Iniziorange,idestrazione)
Call AvanzamentoElab(1,valorefineelaborazione,i)
Dim Diff
Diff = RetRitMax - RetRit1
If(RetRit1 >= raminimostandard And RetRit1 <= ramassimotop And RetRitMax <= ramassimotop And Diff = 0 And RetIncrRitMax = 0) Then
If i2 < Valoresogliaraggiunto And i2 <= classemaxperoutput Then
Valoresogliaraggiunto = i2
End If
Call Scrivi("N.r: " & StringaNumeri(aRuote) & " Colonna: " & i & " " & StringaNumeri(aRetcol,,True) & " RA " & RetRit1 & " RS " & RetRitMax & " INCMAX " & RetIncrRitMax & " FQ " & RetFreq & " Diff " & Diff & " classe " & i2 & " sorte " & nSorte & " riga " & counter)
counter = counter + 1
Dim reportlunghettadoc
sfilereportdinamico = ".\risultanzadinamica.txt"
Dim sfileclassedinamica
sfileclassedinamica = ".\classedinamica" '& i2 & ".txt"
reportlunghettadoc = StringaNumeri(aRetcol,,True)
If FileEsistente(sfilereportdinamico) Then
Call EliminaFile(sfilereportdinamico)
End If
sfilereportdinamico = ".\risultanzadinamica.txt"
If FileEsistente(sfileclassedinamica) Then
Call EliminaFile(sfileclassedinamica)
End If
sfileclassedinamica = ".\classedinamica" & i2 & ".txt"
Call ScriviFile(sfilereportdinamico,reportlunghettadoc,False,True)
Call ScriviFile(sfileclassedinamica,reportlunghettadoc,False,True)
Call CloseFileHandle(sfilereportdinamico)
Call CloseFileHandle(sfileclassedinamica)
If i2 = Classefinale Or i2 = Classefinale + 1 Or i2 = Classefinale + 2 Or i2 = Classefinale + 3 Or i2 = Classefinale + 4 Or i2 = Classefinale + 5 Then
Call ScriviFile(filexanalisicollimanze,reportlunghettadoc,False,True)
Call CloseFileHandle(filexanalisicollimanze)
Dim sortediverifica
Dim esito
Dim entrocolpi
Dim alcolponumero
Dim estratti
Dim estrazionediuscita
Dim vettorediverifica
sortediverifica = 2
entrocolpi = 296 '270
Dim crt ' colpi restanti teorici
crt = entrocolpi -(EstrazioneFin - idestrazione)
Dim numerodicrtmaxvoluti
numerodicrtmaxvoluti = estrazionidaanalizzare - entrocolpi
Call SplitByChar(reportlunghettadoc,".",vettorediverifica)
Call VerificaEsito(vettorediverifica,aRuote,idestrazione + 1,sortediverifica,entrocolpi,,esito,alcolponumero,estratti,estrazionediuscita)
If esito <> "" Then
casipositivi = casipositivi + 1
Else
Call Scrivi("N.r: " & StringaNumeri(aRuote) & " Colonna: " & i & " " & StringaNumeri(aRetcol,,True) & " RA " & RetRit1 & " RS " & RetRitMax & " INCMAX " & RetIncrRitMax & " FQ " & RetFreq & " Diff " & Diff & " classe " & i2 & " sorte " & nSorte & " riga " & counter)
Scrivi "<font color=red><strong>NO non si è avuto alcun sfaldamento per adesso...</strong></font>"
If crt > 0 Then
casiattivi = casiattivi + 1
Else
casinegativi = casinegativi + 1
End If
Scrivi
Call Scrivi("<font color=green><strong>Colpi restanti teorici (CRT) : " & crt & "</strong></font>")
Scrivi
Call Scrivi("Tempo trascorso: " & TempoTrascorso)
Exit For
End If
End If
Call Messaggio("T R O V A T A! alla riga " & i)
Exit For
End If
If ScriptInterrotto Then Exit For
Next ' x il numero di ricerche volute x ogni sotto classe esaminata
If ScriptInterrotto Then Exit For
If ScriptInterrotto Then Exit For
Next ' x i2
sfilereportdinamico = ".\risultanzadinamica.txt"
If FileEsistente(sfilereportdinamico) Then
Call EliminaFile(sfilereportdinamico)
End If
sfilereportdinamico = ".\risultanzadinamica.txt"
Call ScriviFile(sfilereportdinamico,StringaNumeri(grupponumericobaseiniziale))
Call CloseFileHandle(sfilereportdinamico)
casiesaminati = casiesaminati + 1
If ScriptInterrotto Or crt >= numerodicrtmaxvoluti Then Exit For
Next ' x idestrazione
If ScriptInterrotto Or crt < 0 Then Exit For : Scrivi "<font color=red>necessario aumento dei colpi di ricerca o la rivisitazione della stessa</font>"
Next ' x iterazioni
Scrivi
Scrivi
Scrivi "<font size=5 color=red>Valore soglia raggiunto " & Valoresogliaraggiunto & "</font>"
Scrivi
End Sub
Function ScegliFiletxt(sDir)
sDir = "./"
Dim i
ReDim aV(0)
Call ElencoFileInDirectory(sDir,aV,".txt")
i = ScegliOpzioneMenu(aV,,"Scegli il file txt desiderato")
ScegliFiletxt = ".\risultanzadinamica.txt"
Call Scrivi("file" & i)
End Function
adispo2000
Super Member >PLATINUM<
No Alien
Il file txt si riferisce a qualsiasi tuo eventuale file txt che contenga nelle sue poche o molte righe un qualsiasi gruppo di formazioni numeriche intervallate dal carattere punto.
Allegati
lotto_tom75
Advanced Premium Member
Sei di poche parole eh?
Ad ogni modo "hai copiato un pò di righe di troppo..." prova a rimuovere quelle che ti ho evidenziato nel rettangolo rosso e vedrai che ti funziona
Ad ogni modo "hai copiato un pò di righe di troppo..." prova a rimuovere quelle che ti ho evidenziato nel rettangolo rosso e vedrai che ti funziona
Alien.
Advanced Premium Member
Ciao,scusa ma dove si trova l'archivio millionday nel web, grazie.Script n. 16 x millionday - analisi iper veloce xE in classe 1 grazie alla speciale classe di sviluppo HSS.ClsHighSpeedStat. Script realizzato inizialmente dal grande scripter magia per il lotto inglese UK 49 e da me riadattato per il più italico millionday
Codice:Option Explicit 'tom's bakery script n. 16 x millionday. Script del mitico scripter magia x il lotto 49uk da me riadattato per millionday 'ATTENZIONE PER USARE HSS.ClsHighSpeedStat ' Dim clsHSS ' Sub Main Dim Ini,Fin,Tot Dim k,sRecord Dim IniStart,FinEnd Dim bSvilVeloce '------------------------------------------------------------------------------------------------------------ ' 'FUNZIONA CON L'ARHIVIO .TXT Dim sFileArchivio 'PER USARE FUNCTION FT sFileArchivio = ScegliFile(".\",".txt","archiviomillionday.txt") ' Archivio Million Day " ' GetDirectoryAppData & "Archivio Million Day" 'PER USARE FUNCTION FT If MsgBox("Sviluppo veloce ? ",vbQuestion + vbYesNo) = vbYes Then bSvilVeloce = True End If If ApriBaseDatiFT(sFileArchivio,5,",",55) Then 'PER USARE FUNCTION FT ' 'FUNZIONA CON L'ARHIVIO .CSV '------------------------------------------------------------------------------------------------------------ 'ATTENZIONE PER USARE HSS.ClsHighSpeedStat ' If bSvilVeloce Then Set clsHSS = CreateObject("HSS.ClsHighSpeedStat") 'Call clsHSS.Init(sFileArchivio,09,".") Call clsHSS.Init(sFileArchivio,09,",",07) MsgBox clsHSS.GetClasseTxt End If ' ' '------------------------------------------------------------------------------------------------------------ IniStart = Timer Ini = 1 Fin = EstrazioniArchivioFT Tot = Fin - Ini + 01 Scrivi " Statistica dal " & DataEstrazioneFT(Ini) & " al " & DataEstrazioneFT(Fin) & " ",1,0,6 Scrivi " Totale Estrazioni " & Format2(EstrazioniRicercaFT) & " ",1,- 1,4 Scrivi sRecord = "L'archivio letto va da " & DataEstrazioneFT(Ini) & " a " & DataEstrazioneFT(Fin) '& Format2(vbCrLf) sRecord = sRecord & "e si compone di " & Format2(EstrazioniRicercaFT) & " estrazioni " '& Format2(vbCrLf) sRecord = sRecord & "di seguito la lista dei Ritardi,Frequenze ed Indici di Convenienza " & Format2(vbCrLf) Call Scrivi(sRecord) ReDim aTitoli(04) aTitoli(01) = " Numero " aTitoli(02) = " Ritardo " aTitoli(03) = " Frequenza " aTitoli(04) = " Indice Convenienza " Call InitTabella(aTitoli,1,,,5) For k = 01 To 55 Call Messaggio(k) Call AvanzamentoElab(01,55,k) ReDim aValori(04) aValori(01) = Format2(k) If bSvilVeloce Then '------------------------------------------------------------------------------------ 'ATTENZIONE PER USARE HSS.ClsHighSpeedStat ' aValori(02) = clsHSS.EstrattoRitardoTxt(k,Ini,Fin) 'PER USARE HSS.ClsHighSpeedStat aValori(03) = clsHSS.EstrattoFrequenzaTxt(k,Ini,Fin) 'PER USARE HSS.ClsHighSpeedStat Else' '------------------------------------------------------------------------------------ ' aValori(02) = EstrattoRitardoFT(k,Ini,Fin) 'PER USARE FUNCTION FT aValori(03) = EstrattoFrequenzaFT(k,Ini,Fin) 'PER USARE FUNCTION FT ' '------------------------------------------------------------------------------------ End If aValori(04) = Round(((aValori(03) / Tot) * aValori(02)),02) Call AddRigaTabella(aValori) If k = 01 Or k = 08 Or k = 15 Or k = 22 Or k = 29 Or k = 36 Or k = 43 Then Call(SetColoreCella(01,RGB(255,255,0))):End If If k = 02 Or k = 09 Or k = 16 Or k = 23 Or k = 30 Or k = 37 Or k = 44 Then Call(SetColoreCella(01,RGB(255,255,0))):End If If k = 03 Or k = 10 Or k = 17 Or k = 24 Or k = 31 Or k = 38 Or k = 45 Then Call(SetColoreCella(01,RGB(255,255,0))):End If If k = 04 Or k = 11 Or k = 18 Or k = 25 Or k = 32 Or k = 39 Or k = 46 Then Call(SetColoreCella(01,RGB(255,255,0))):End If If k = 05 Or k = 12 Or k = 19 Or k = 26 Or k = 33 Or k = 40 Or k = 47 Then Call(SetColoreCella(01,RGB(255,255,0))):End If If k = 06 Or k = 13 Or k = 20 Or k = 27 Or k = 34 Or k = 41 Or k = 48 Then Call(SetColoreCella(01,RGB(255,255,0))):End If If k = 07 Or k = 14 Or k = 21 Or k = 28 Or k = 35 Or k = 42 Or k = 49 Then Call(SetColoreCella(01,RGB(255,255,0))):End If If k = 50 Or k = 51 Or k = 52 Or k = 53 Or k = 54 Or k = 55 Then Call(SetColoreCella(01,RGB(255,255,0))):End If Next Call CreaTabella(04) End If FinEnd = Timer Call Scrivi("Tempo di elaborazione : " & FormattaSecondi((FinEnd + 01) - IniStart)) Set clsHSS = Nothing End Sub Function FormattaSecondi(s) 'Questa Function trasforma il numero di secondi passato come parametro in una stringa ' passando i secondi si ottengono ore minuti e secondi in formato hh:mm:ss ' s ---> Numero di secondi da formattare ' ritorna una stringa il cui formato è hh:mm:ss (la function non funziona se in totale abbiamo piu di 99 ore ) Dim hh Dim Mm Dim Ss Dim TimeStr hh = s \ 3600 Mm =(s Mod 3600) \ 60 Ss = s -((hh * 3600) +(Mm * 60)) TimeStr = Format2(hh) & ":" & Format2(Mm) & ":" & Format2(Ss) FormattaSecondi = TimeStr End Function
Per essere utilizzato correttamente l'archivio millionday nel relativo file txt deve avere la seguente struttura... :
1,07/02/2018,16,7,43,44,51
ovvero...
numeroestrazioneprogressivo , dataestrazioneintervallatadabarraspaziatrice , i 5 numeri intervallati ognuno dal carattere virgola.
Alien.
Advanced Premium Member
errore premuto tasto errato. sorryQUESTO è proprio "carino" avete messo anche la "segretaria" che ti parla e dice nulla ecc.si ma poi sparisce tutto e torna qua su ced dal suo "padrone"
lotto_tom75
Advanced Premium Member
lotto_tom75
Advanced Premium Member
Script n. 36 tom's bakery x lotto by luigib - rileva fq 0 x la sorte e classe volute su quante e quali ruote nel periodo temporale desiderato
Codice:
Option Explicit
'Script n36 tom's bakery x lotto by luigib - rileva fq 0 x la sorte e classe volute su quante e quali 'ruote nel periodo temporale desiderato
Class clsCombinazione
Private aNum
Private aRuote
Private mFrequenza
Private mSorte
Private mFine,mInizio
Public Property Get Frequenza
Frequenza = mFrequenza
End Property
Public Property Get Sorte
Sorte = mSorte
End Property
Public Property Get EstrazioneInizio
EstrazioneInizio = mInizio
End Property
Public Property Get EstrazioneFine
EstrazioneFine = mFine
End Property
Function GetNumeri()
GetNumeri = aNum
End Function
Function GetRuote()
GetRuote = aRuote
End Function
Function GetQuantitaRuote
GetQuantitaRuote = UBound(aRuote)
End Function
Sub AggiungiRuota(r)
Dim i
i = UBound(aRuote) + 1
ReDim Preserve aRuote(i)
aRuote(i) = r
End Sub
Function GetStringaRuote
Dim k,s
s = ""
For k = 1 To UBound(aRuote)
s = s & SiglaRuota(aRuote(k)) & "."
Next
GetStringaRuote = RimuoviLastChr(s,".")
End Function
Sub SetDati(aN,aR,Sorte,Inizio,Fine)
aNum = aN
aRuote = aR
mSorte = Sorte
mInizio = Inizio
mFine = Fine
End Sub
Sub CalcolaFrequenza(aN,aR,nSorte,EstrIni,EstrFin)
aNum = aN
aRuote = aR
mSorte = nSorte
mInizio = EstrIni
mFine = EstrFin
mFrequenza = SerieFreqTurbo(mInizio,mFine,aNum,aRuote,mSorte)
End Sub
End Class
Sub Main
Dim r,k
Dim aNumeri,nNumSel,aCol,nColonneSvil
ReDim aRuote(1)
Dim nClasse,nSorte,nColonneTot
Dim CollLunghette
Dim clsComb
Dim Inizio,Fine
Dim mFreqMinima
nClasse = CInt(InputBox("classe",,2))
nSorte = CInt(InputBox("sorte",,2))
mFreqMinima = 0
Inizio = EstrazioneIni
Fine = EstrazioneFin
Set CollLunghette = GetNewCollection
nNumSel = ScegliNumeri(aNumeri)
nColonneSvil = 0
If nNumSel >= nClasse Then
nColonneTot = InitSviluppoIntegrale(aNumeri,nClasse)
Do While GetCombSviluppo(aCol)
For r = 1 To 12
If r <> 11 Then
aRuote(1) = r
Set clsComb = New clsCombinazione
Call clsComb.CalcolaFrequenza(aCol,aRuote,nSorte,Inizio,Fine)
If clsComb.Frequenza <= mFreqMinima Then
Call AddFormazioneTrovata(clsComb,CollLunghette)
End If
End If
If ScriptInterrotto Then Exit For
Next
nColonneSvil = nColonneSvil + 1
If nColonneSvil Mod 100 = 0 Then
Call Messaggio("classe " & nClasse & " sorte " & nSorte & " Tt " & TempoTrascorso)
Call AvanzamentoElab(0,nColonneTot,nColonneSvil)
If ScriptInterrotto Then Exit Do
Call DoEventsEx
End If
Loop
Call AvanzamentoElab(0,nColonneTot,nColonneSvil)
Scrivi "Analisi da "
Scrivi "Inizio : " & GetInfoEstrazione(Inizio)
Scrivi "Fine : " & GetInfoEstrazione(Fine)
Scrivi "Numero estrazioni " & Fine - Inizio
Scrivi "Numeri : " & StringaNumeri(aNumeri)
Scrivi "Sviluppo in classe " & nClasse
Scrivi "Sorte " & NomeSorte(nSorte)
Scrivi "Elenco delle combinazioni presenti con frequenza minore uguale a " & mFreqMinima
Scrivi
Dim aTitoli
aTitoli = Array("","Combinazione","Q Ruote","Ruote")
Call InitTabella(aTitoli,vbYellow)
ReDim aValori(3)
For Each clsComb In CollLunghette
aValori(1) = StringaNumeri(clsComb.GetNumeri,,True)
aValori(2) = clsComb.GetQuantitaRuote
aValori(3) = clsComb.GetStringaRuote
Call AddRigaTabella(aValori)
Next
Call CreaTabella(2)
End If
Scrivi
Scrivi "Tt " & TempoTrascorso
Scrivi
End Sub
Sub AddFormazioneTrovata(clsComb,coll)
Dim sKey
Dim clsCombTmp
sKey = "key" & StringaNumeri(clsComb.GetNumeri,".",True)
Set clsCombTmp = GetItemColl(sKey,coll)
If clsCombTmp Is Nothing Then
Set clsCombTmp = New clsCombinazione
Call clsCombTmp.SetDati(clsComb.GetNumeri,clsComb.GetRuote,clsComb.Sorte,clsComb.EstrazioneInizio,clsComb.EstrazioneFine)
Call coll.Add(clsCombTmp,sKey)
Else
Dim aR
aR = clsComb.GetRuote
Call clsCombTmp.AggiungiRuota(aR(1))
End If
End Sub
Function GetItemColl(sKey,Coll)
On Error Resume Next
Set GetItemColl = Coll(sKey)
If Err <> 0 Then
Set GetItemColl = Nothing
Err.Clear
End If
End FunctionBuongiorno a tutti, ultimamente ho realizzato tecniche per il Millionday, vorrei comunicarvi che l'archivio
ha delle estrazioni mancanti, 26 agosto 2022, 06 settembre 2022, 30 settembre 2022 .
Spero siano risistemate per chi usa il suddetto archivio.
Grazie
ha delle estrazioni mancanti, 26 agosto 2022, 06 settembre 2022, 30 settembre 2022 .
Spero siano risistemate per chi usa il suddetto archivio.
Grazie
Ultima estrazione Lotto
-
Estrazione del lotto
sabato 23 novembre 2024Bari3380865225Cagliari6757590580Firenze3132588877Genova4039233681Milano2858452538Napoli2082234457Palermo7656886231Roma1281597472Torino4653724523Venezia0412426420Nazionale6344781055Estrazione Simbolotto
Torino
4342123922
