Option Explicit
Sub Main
Dim Ini
Dim sFileCompleta
Dim idAlg
sFileCompleta = GetDirectoryAppData & "ArchivioPensy\PENSY.txt"
If ApriBaseDatiFT(sFileCompleta,05,",",30) Then
Ini = ScegliInizio
idAlg = ScegliAlgoritmo
Select Case idAlg
Case 0
Call LanciaAlgoritmoSommativo(Ini)
Case 1
Call AlgoritmoRipetizionePosiazioneAcolpo(Ini)
Case 2
Call RipetizioneCoppiaAColpo(Ini)
End Select
End If
End Sub
Sub LanciaAlgoritmoSommativo(Ini)
'Lo script è solo un abbazzo va Corretto
' non si garantisce che i calcoli restituiti siano corretti
' I risultati restituiti non sono previsioni
Dim sFileCompleta
Dim Fin,idEstr
Dim pos,E,iAdattatore
Dim Freq,Rit,RitMax,Incr
Dim nAlg,idSviluppo
Dim uE,uNum,ttNum,sorte
Dim T1,T2,nTotEstr
Fin = EstrazioniArchivioFT
sorte = 1
nTotEstr = Fin - Ini
nAlg = 30*5*(Fin - Ini)' lo calcolo per valorizzare progress barr
Call GetTestoTab
idSviluppo = 0
T1 = Timer
For iAdattatore = 1 To 30
For pos = 1 To 5
' azzero le variabili per ogni estratto
Rit = 0
RitMax = 0
Freq = 0
Incr = 0
' ciclo sino alla penultima estrazione per valorizzare l ultimo ritardo a colpo
For idEstr = Ini To Fin - 1
idSviluppo = idSviluppo + 1
If idEstr = Fin - 1 Then
Call Messaggio("StoElaborando: " & nTotEstr & "Estr.[Alg( pos: " & pos & "+Adat. " & iAdattatore & ")]")
Call AvanzamentoElab(1,nAlg,idSviluppo)
End If
If ScriptInterrotto Then Exit For
E = EstrattoFT(idEstr,pos)
ttNum = FuoriX(E + iAdattatore,30)
If PosizioneFT(idEstr + 1,ttNum) > 0 Then
Rit = 0
Incr = 0
Freq = Freq + 1
Else
Rit = Rit + 1
If Rit > RitMax Then
RitMax = Rit
Incr = Incr + 1
End If
End If
Next
uE = EstrattoFT(Fin,pos)
uNum = FuoriX(uE + iAdattatore,30)
If ScriptInterrotto Then Exit For
ReDim aTab(8)
Call GetTabalella(aTab,pos,iAdattatore,Rit,RitMax,Incr,Freq,uNum)
Call AddRigaTabella(aTab)
Next
Next
T2 = Timer
Call ScriviTesto(Ini,Fin,nTotEstr,T2,T1,sorte)
Call CreaTabellaOrdinabile
End Sub
Sub GetTestoTab
Dim aTitoli
aTitoli = Array("","Posizione","Adatt","Rit","RitMax","IncrRit","ScartoRit","Freq","Numero")
Call InitTabella(aTitoli)
End Sub
Sub GetTabalella(aTab,Pos,iAdattatore,Rit,RitMax,Incr,Freq,Num)
aTab(1) = "P_" & Pos
aTab(2) = "+" & iAdattatore
aTab(3) = Rit
aTab(4) = RitMax
aTab(5) = Incr
aTab(6) = RitMax - Rit
aTab(7) = Freq
aTab(8) = Num
End Sub
Function FormattaSecondi(s)
Dim HH
Dim MM
Dim SS
Dim strTime
HH = s\3600
MM =(s Mod 3600)\60
SS = s -(HH*3600 + MM*60)
FormattaSecondi = Format2(HH) & " : " & Format2(MM) & " : " & Format2(SS)
End Function
Function ScegliInizio()
ReDim aV(EstrazioniArchivioFT)
Dim k
For k = 1 To UBound(aV)
aV(k) = GetInfoEstrazioneFT(k)
Next
ScegliInizio = ScegliOpzioneMenu(aV,1,"Inizio Ricerca")
End Function
Sub AlgoritmoRipetizionePosiazioneAcolpo(Ini)
'Lo script è solo un abbazzo va Corretto
' non si garantisce che i calcoli restituiti siano corretti
' I risultati restituiti non sono previsioni
Dim sFileCompleta
Dim nTotEstr,Fin,idEstr
Dim pos,E,iAdattatore
Dim Freq,Rit,RitMax,Incr
Dim nAlg,idSviluppo
Dim uE,uNum,ttNum
Dim T1,T2,sorte
sorte = 1
Fin = EstrazioniArchivioFT
nTotEstr = Fin - Ini
nAlg = 5*((Fin - 1) - Ini)
Call GetTestoTab1
T1 = Timer
idSviluppo = 0
For pos = 1 To 5
' azzero le variabili per ogni estratto
Rit = 0
RitMax = 0
Freq = 0
Incr = 0
' ciclo sino alla penultima estrazione per valorizzare l ultimo ritardo a colpo
For idEstr = Ini To Fin - 1
idSviluppo = idSviluppo + 1
If idEstr = Fin - 1 Then
Call Messaggio("StoElaborando: " & nTotEstr & " Estr.[Alg( pos: " & pos & ")]")
Call AvanzamentoElab(1,nAlg,idSviluppo)
End If
If ScriptInterrotto Then Exit For
ttNum = EstrattoFT(idEstr,pos)
' Calcolo ultimo metodo
'Verifico se c'è ripetizione a colpo
If PosizioneFT(idEstr + 1,ttNum) > 0 Then
Rit = 0
Incr = 0
Freq = Freq + 1
Else
Rit = Rit + 1
' questa Formula è da controllare
' se ritardo Max e Incrementi sono
'calcolati correttamente
If Rit > RitMax Then
RitMax = Rit
Incr = Incr + 1
End If
End If
Next
uNum = EstrattoFT(Fin,pos)
If ScriptInterrotto Then Exit For
ReDim aTab(7)
Call GetTabalella1(aTab,pos,Rit,RitMax,Incr,Freq,uNum)
Call AddRigaTabella(aTab)
Next
T2 = Timer
Call ScriviTesto(Ini,Fin,nTotEstr,T2,T1,sorte)
Call CreaTabellaOrdinabile
End Sub
Sub GetTestoTab1
Dim aTitoli
aTitoli = Array("","Posizione","Rit","RitMax","IncrRit","ScartoRit","Freq","Numero")
Call InitTabella(aTitoli)
End Sub
Sub GetTabalella1(aTab,Pos,Rit,RitMax,Incr,Freq,Num)
aTab(1) = Pos
aTab(2) = Rit
aTab(3) = RitMax
aTab(4) = Incr
aTab(5) = RitMax - Rit
aTab(6) = Freq
aTab(7) = Num
End Sub
Function ScegliAlgoritmo
Dim aAlg
aAlg = Array("AlgoritmoRipetizioneSommativo_aColpo","RipetizionePosizione_aColpo","Ripetizione Coppia a Colpo")
ScegliAlgoritmo = ScegliOpzioneMenu(aAlg,0,"SelezionaRoutine")
End Function
Sub RipetizioneCoppiaAColpo(Ini)
'Lo script è solo un abbazzo va Corretto
' non si garantisce che i calcoli restituiti siano corretti
' I risultati restituiti non sono previsioni
Dim sFileCompleta
Dim Fin,idEstr
Dim pos1,pos2,E,iAdattatore
Dim Freq,Rit,RitMax,Incr
Dim nAlg,idSviluppo
Dim sNum,nTotEstr
Dim sorte
Dim T1,T2
ReDim aNum(2)
T1 = Timer
' scegliRange non ce nel help ho la versione 1.5.71
Fin = EstrazioniArchivioFT
nTotEstr = Fin - Ini
sorte = Sceglisorte
nAlg = 21*((Fin - 1) - Ini)
Call GetTestoTab1
idSviluppo = 0
For pos1 = 1 To 4
For pos2 = pos1 + 1 To 5
' azzero le variabili per ogni estratto
Rit = 0
RitMax = 0
Freq = 0
Incr = 0
' ciclo sino alla penultima estrazione per valorizzare l ultimo ritardo a colpo
For idEstr = Ini To Fin - 1
idSviluppo = idSviluppo + 1
If idEstr Mod 1500 = 0 Then
Call Messaggio("StoElaborando: idestr=" & idEstr & " pos: " & pos1 & "-" & pos2)
Call AvanzamentoElab(1,nAlg,idSviluppo)
End If
If ScriptInterrotto Then Exit For
aNum(1) = EstrattoFT(idEstr,pos1)
aNum(2) = EstrattoFT(idEstr,pos2)
' Calcolo ultimo metodo
'Verifico se c'è ripetizione a colpo
If SerieFreqFT(idEstr + 1,idEstr + 1,aNum,sorte) > 0 Then
Rit = 0
Incr = 0
Freq = Freq + 1
Else
Rit = Rit + 1
' questa Formula è da controllare
' se ritardo Max e Incrementi sono
'calcolati correttamente
If Rit > RitMax Then
RitMax = Rit
Incr = Incr + 1
End If
End If
Next
aNum(1) = EstrattoFT(Fin,pos1)
aNum(2) = EstrattoFT(Fin,pos2)
sNum = StringaNumeri(aNum,,True)
If ScriptInterrotto Then Exit For
ReDim aTab(7)
Call GetTabalella1(aTab,pos1 & "-" & pos2,Rit,RitMax,Incr,Freq,sNum)
Call AddRigaTabella(aTab)
Next
Next
T2 = Timer
Call ScriviTesto(Ini,Fin,nTotEstr,T2,T1,sorte)
Call CreaTabellaOrdinabile
End Sub
Function Sceglisorte
Dim aSorte
aSorte = Array("Estratto","Ambo")
Sceglisorte = ScegliOpzioneMenu(aSorte,0,"SelezionaEsito") + 1
End Function
Function ScriviTesto(Ini,Fin,nTotEstr,T2,T1,sorte)
Scrivi FormatSpace(" Il Gioco è vietato ai minori di anni 18,puo comportare grave dipendenze patologiche ",86),True,True,,vbRed,3
Scrivi FormatSpace(" PER CHI GIOCA , FARLO SOLO SE E' LEGALE ,E, DOVE E' LEGALE ",86),True,True,,vbRed,3
Scrivi FormatSpace(" LO SCRIPT RESTITUISCE DATI STATISTICI (da verificare sempre) NON CONSIGLIA PREVISIONI",85),True,True,,vbRed,3
Scrivi
Scrivi "Range Statistico : " & GetInfoEstrazioneFT(Ini) & "-" & GetInfoEstrazioneFT(Fin)
Scrivi "Estrazioni Esaminate : " & nTotEstr
Scrivi "Tempo elaborazione : " & FormattaSecondi((T2 + 1) - T1)
Scrivi "Sorte Analizzata : " & NomeSorte(sorte)
End Function