i legend
Premium Member
Buona serata a tutti:
x Vincenzo , grazie per la verifica dei risultati, se ci dovessero essere bugs segnalateli
X Tom ciao , ecco lo script con gli incrementi puoi anche aumentarli per vederne quanti ne vuoi
x Luigi: ciao luigi spero di aver sistemato tutto, potresti per favore dargli un occhiata per vedere di non aver rovinato la tua funzione te ?
grazie per la fiducia e la pazienza che mi dimostri
questo è il codice
P.S:
In questo script ci sono delle utilissime funzioni di statistica regalateci dal grandissimo Luigi, fatene tesoro ed utilizzatele anche per vostri script. E' bello cimentarsi, lo suggerisco anche come stimolo per le celluline grigie,
Grazie a tutti i miei maestri
x Vincenzo , grazie per la verifica dei risultati, se ci dovessero essere bugs segnalateli
X Tom ciao , ecco lo script con gli incrementi puoi anche aumentarli per vederne quanti ne vuoi
x Luigi: ciao luigi spero di aver sistemato tutto, potresti per favore dargli un occhiata per vedere di non aver rovinato la tua funzione te ?
grazie per la fiducia e la pazienza che mi dimostri
questo è il codice
Codice:
Option Explicit
Sub Main
' Si prega sempre di verificare e confrontare i risultatiottenuti dallo script con altre fonti
' per verificarne la correttezza
' se si dovessero verificare bugs segnalarli per le opportune correzioni.
'
Dim Ini,Fin,nEstr,es,k,x,r,nValore,idOrd,TipOrd,Ctr,z
Dim r1,n1,qRit,conta1
Dim scartoRit,Gen,Feb,Mar,Apr,Mag,Giu,Lug,Ago,Sett,Ott,Nov,Dic
Dim IdMax,aRetDiff,Conta,aIncr,Sincrementi,qIncr,y
Dim DevStd,disCeb,ScaCeb,aRitardi
Dim nColTotSvil
Dim s,e,ritardo,ritardomax,IncrRitMax,RitMed,RitMese
Dim Frequenza,freqTeorica,FreqMese,freq,FreqTot,Scarto
Dim nNumeri,aColonne
ReDim aNumeri(0)
Dim aRu(1)
Dim nCombinazione,nSorte,nCiclo
Dim aTitolo
ReDim aRetRitardi(0)
ReDim aRetIdEstr(0)
Fin = EstrazioneFin
qRit = 10 ' elenco ultimi N_Ritardi
qIncr = 5 ' elenco ultimi N_incrementi
If ImpostaParametri(nNumeri,nCombinazione,nSorte,Ctr,idOrd,TipOrd,aRu,r,Ini) = False Then
MsgBox "Parametri non corretti",vbCritical
Exit Sub
End If
'Imposto i titoli delle colonne della tabella statistica
aTitolo = Array("","ID","Comb","freq","Scarto","Rit","aRitardi","RitMed","RitSto","IncR.s","aIncrementi","ScartoRit","DevStd","disCeb","ScaCeb99%","Gen ","Feb","Mar","Apr","Mag","Giu","Lug","Ago","Set","Ott","Nov","Dic")
InitTabella aTitolo,RGB(108,194,243),,3,vbWhite', "Consolas"
nEstr = ContaEstrazioni(Ini,Fin,r)
nValore = Round(CicloTeorico(nCombinazione,nSorte,CInt(Ctr)),2)' ctr= 1 (=1R);=10(=TT)
freqTeorica = Round(Dividi(nEstr,nValore),2)
ReDim aColSviluppo(0)
nColTotSvil = Combinazioni(UBound(nNumeri),nCombinazione)
ReDim nMese(nColTotSvil,12)
For z = 1 To 12
Call ImpostaEstrazioniAttivePerMese(z,Ini,Fin)
nColTotSvil = InitSviluppoIntegrale(nNumeri,nCombinazione)
k = 0
Do While GetCombSviluppo(aColSviluppo)
k = k + 1
nMese(k,z) = TrovaFrequenzaMese(aColSviluppo,aRu,nSorte,Ini,Fin,z)
Loop
Next
Call ResetEstrazioniAttive(z,Ini,Fin)
k = 0
nColTotSvil = InitSviluppoIntegrale(nNumeri,nCombinazione)
Do While GetCombSviluppo(aNumeri)
k = k + 1
Messaggio "Elaborazione in corso id sviluppo: " & k
AvanzamentoElab 1,nColTotSvil,k
If ScriptInterrotto Then Exit Do
s = StringaNumeri(aNumeri,,True)
Call StatisticaFormazioneTurbo(aNumeri,aRu,nSorte,ritardo,ritardomax,IncrRitMax,Frequenza,Ini,Fin)
FreqTot = Frequenza
RitMese = TrovaRitardoMese(aNumeri,aRu,nSorte,Ini,Fin,"TUTTI")
Scarto = Round(FreqTot - freqTeorica,2)
scartoRit = Round(ritardomax - ritardo,2)
Call ElencoRitardiTurbo(aNumeri,aRu,nSorte,Ini,Fin,aRetRitardi,aRetIdEstr)
r1 = ""
conta1 = 0
For n1 = UBound(aRetRitardi) - 1 To LBound(aRetRitardi) Step - 1
conta1 = conta1 + 1
If conta1 <= qRit Then
r1 = FormattaStringa(aRetRitardi(n1),"000") & "." & r1
Else
Exit For
End If
Next
r1 = RimuoviLastChr(r1,".")
aRitardi = r1
RitMed = RitardoMedio(aRetRitardi)
DevStd = CalcolaDeviazioneStd(aRetRitardi)
disCeb = Round(RitMed +(10*DevStd),2)
ScaCeb = Round(disCeb - RitMese,2)
Call GetArrayDiffRitMax(aRetRitardi,aRetDiff)
IdMax = UBound(aRetRitardi) - 1
Sincrementi = ""
Conta = 0
For y = 1 To UBound(aRetDiff)
Conta = Conta + 1
If Conta <= qIncr Then
Sincrementi = FormattaStringa(aRetDiff(y),"000") & "." & Sincrementi
IdMax = IdMax - 1
Else
Exit For
End If
Next
Sincrementi = RimuoviLastChr(Sincrementi,".")
aIncr = Sincrementi
s = RimuoviLastChr(s,".")
ReDim aRisultato(26)
Call AlimetaArrayRisultato(aRisultato,k,s,FreqTot,Scarto,RitMese,aRitardi,RitMed,ritardomax,IncrRitMax,aIncr,scartoRit,DevStd,disCeb,ScaCeb,nMese(k,1),nMese(k,2),nMese(k,3),nMese(k,4),nMese(k,5),nMese(k,6),nMese(k,7),nMese(k,8),nMese(k,9),nMese(k,10),nMese(k,11),nMese(k,12))
Call AddRigaTabella(aRisultato,,,3,RGB(0,0,0))',"Consolas")
Call SetColoreCella(2,RGB(215,215,255),2)
Loop
Scrivi FormatSpace("script By I Legend per lottoCed's amici",10,- 1)
Scrivi
Scrivi "Tabella Statistica per formazioni libere" & " ",1,,RGB(252,227,143),,5
Scrivi
Scrivi "Range Ricerca Estrazioni dal :{" & DataEstrazione(Ini) & " } al : {" & DataEstrazione(Fin) & "}",1,,,,3
Scrivi "Estrazioni Totali Analizzati :{" & nEstr & "}",1,,,,3
Scrivi "Numeri di ricerca :{" & StringaNumeri(nNumeri) & "}",1,,,,3
Scrivi "Sviluppo numeri in :{" & k & " " & NomeCombinazione(nCombinazione) & "}",1,,,,3
Scrivi "Analesi combinazione per :{" & NomeSorte(nSorte) & "}",1,,,,3
Scrivi "Ciclo Teorico :{" & nValore & "}",1,,,,3
Scrivi "Frequenza Teorica :{" & freqTeorica & "}",1,,,,3
Scrivi "Ruota di ricerca :{" & NomeRuota(aRu(1)) & "}",1,,,,3
Scrivi
Call CreaTabellaOrdinabile()
End Sub
' riporto qui di seguito tutte le funzioni utilizzate
' per la sub main
' ovviamente possono essere ottimizzate
Sub AlimetaArrayRisultato(aRisultato,k,s,FreqTot,Scarto,RitMese,aRitardi,RitMed,ritardomax,IncrRitMax,aIncr,scartoRit,DevStd,disCeb,ScaCeb,Gen,Feb,Mar,Apr,Mag,Giu,Lug,Ago,Sett,Ott,Nov,Dic)
aRisultato(1) = k ' id
aRisultato(2) = s ' combinazioni analizzate
aRisultato(3) = FreqTot'frequenza combinazione
aRisultato(4) = Scarto ' differenza freq.reeale e differenza teorica
aRisultato(5) = RitMese ' ritardo cronologico
aRisultato(6) = aRitardi
aRisultato(7) = RitMed ' ritardo medio
aRisultato(8) = ritardomax ' ritardo storico
aRisultato(9) = IncrRitMax ' incremento ritardo storico
aRisultato(10) = aIncr
aRisultato(11) = scartoRit
aRisultato(12) = DevStd ' deviazione standard
aRisultato(13) = disCeb 'disegualianza di cebicev
aRisultato(14) = ScaCeb ' scarto tra valore ipotizzato e valore del ritardo reale
aRisultato(15) = Gen
aRisultato(16) = Feb
aRisultato(17) = Mar
aRisultato(18) = Apr
aRisultato(19) = Mag
aRisultato(20) = Giu
aRisultato(21) = Lug
aRisultato(22) = Ago
aRisultato(23) = Sett
aRisultato(24) = Ott
aRisultato(25) = Nov
aRisultato(26) = Dic
End Sub
Function ImpostaParametri(aNumeri,nCombinazione,nSorte,Ctr,idOrd,TipOrd,aRu,Ruota,Ini)
Dim bRet
Ini = InizioArchivio(3914)
If Ini > 0 Then
Call ScegliNumeri(aNumeri)
If IsArray(aNumeri) Then
nCombinazione = ScegliCombinazione
If nCombinazione > 0 Then
nSorte = SelEsito
If nSorte > 0 Then
Do While nCombinazione < nSorte
MsgBox "hai inserito Un Valore errato riscrivi ": nSorte = CInt(SelEsito)
If nSorte = - 1 Then Exit Do
Loop
If nSorte > 0 Then
Ruota = SelRuota ' funziona per selezionare la ruota statistica su tutte o solo per una ruota
If Ruota > 0 Then
aRu(1) = Ruota
If Ruota = 11 Then
Ctr = 10
Else
Ctr = 1 ' valore utilizzato per calcolo del ciclo teorico
End If
bRet = True ' per default torna true
End If
End If
End If
End If
End If
End If
ImpostaParametri = bRet
End Function
Function TrovaFrequenzaMese(aNumeri,aRu,nSorte,Ini,fin,nMese)
Dim k
Dim FreqMese
FreqMese = SerieFreqTurbo(Ini,fin,aNumeri,aRu,nSorte)
TrovaFrequenzaMese = FreqMese
End Function
Sub ImpostaEstrazioniAttivePerMese(nMese,Ini,fin)
Dim k
If nMese = "TUTTI" Then
Call ResetEstrazioniAttive(nMese,Ini,fin)
Else
For k = Ini To fin
If Mese(k) = nMese Then
Call ImpostaEstrazione(k,True)
Else
Call ImpostaEstrazione(k,False)
End If
Next
End If
End Sub
Sub ResetEstrazioniAttive(nMese,Ini,fin)
Dim k
For k = Ini To fin
Call ImpostaEstrazione(k,True)
Next
End Sub
Function TrovaRitardoMese(aNumeri,aRu,nSorte,Ini,fin,nMese)
Dim k
Dim RitMese
If nMese <> "TUTTI" Then
Call ImpostaEstrazioniAttivePerMese(nMese,Ini,fin)
End If
RitMese = SerieRitardoTurbo(Ini,fin,aNumeri,aRu,nSorte)
TrovaRitardoMese = RitMese
End Function
Function NomeCombinazione(a)
Dim aVoci
aVoci = Array("","Estratti","Ambi","Terzine","Quartine","Cinquine")
NomeCombinazione = aVoci(a)
End Function
Function ScegliCombinazione
Dim ret
Dim aVoci
' gli array partono sempre da 0
aVoci = Array("","Estratti","Ambi","Terzine","Quartine","Cinquine")
ret = ScegliOpzioneMenu(aVoci,3," Combina i numeri In :")
' serve per gestire il tasto annulla
ScegliCombinazione = ret
End Function
Function SelEsito
Dim ret
Dim aVoci
' gli array partono sempre da 0
aVoci = Array("","Estratto","Ambo","Terno","Quaterna","Cinquina")
ret = ScegliOpzioneMenu(aVoci,2," Analesi per Sorte di : ")
SelEsito = ret
End Function
Function SelRuota
Dim ret
Dim aVoci
' gli Array partono sempre da 0
aVoci = Array("","BARI","CAGLIARI","FIRENZE","GENOVA","MILANO","NAPOLI","PALERMO","ROMA","TORINO","VENEZIA","TUTTE","NAZIONALE")
ret = ScegliOpzioneMenu(aVoci,1," Analizza Ruota di : ")
SelRuota = ret
End Function
Function InizioArchivio(nInizio)
Dim es
Dim ret
ReDim aVoci(EstrazioneFin)
For es = nInizio To EstrazioneFin
aVoci(es) = DataEstrazione(es)
Next
ret = ScegliOpzioneMenu(aVoci,nInizio,"Inserisci Data Inizio Analisi")
InizioArchivio = ret
End Function
Function RitardoMedio(aRitardi())
Dim k
Dim nElementi
Dim nMedia
For k = 1 To UBound(aRitardi) - 1
nElementi = nElementi + 1
nMedia = nMedia + aRitardi(k)
Next
nMedia = Round(Dividi(nMedia,nElementi),2)
RitardoMedio = nMedia
End Function
Function CalcolaDeviazioneStd(aRitardi())
Dim k
Dim somRit,nMedia,nElementi,nVarianza,nSomSQVar
For k = 1 To UBound(aRitardi) - 1
nElementi = nElementi + 1
somRit = somRit + aRitardi(k)
Next
nMedia = Round(Dividi(somRit,nElementi))
For k = 1 To UBound(aRitardi) - 1
nSomSQVar = nSomSQVar +((nMedia - aRitardi(k)) ^ 2)
nVarianza = Round(Dividi(nSomSQVar,nElementi),2)
Next
CalcolaDeviazioneStd = Round(Sqr(nVarianza),2)
End Function
Function ContaEstrazioni(Ini,Fin,r)
Dim Conta,es
For es = Ini To Fin
If SommaEstratti(es,r) >= 15 Then Conta = Conta + 1
Next
ContaEstrazioni = Conta
End Function
Function GetArrayDiffRitMax(aRitardi,aRetDiff)
Dim idMax,idTmp
Dim nQDiff
Call OrdinaMatrice(aRitardi,1)
nQDiff = 0
ReDim aRetDiff(nQDiff)
idMax = UBound(aRitardi)' -1
Do While idMax > 0
idTmp = idMax - 1
If idTmp > 0 Then
nQDiff = nQDiff + 1
ReDim Preserve aRetDiff(nQDiff)
aRetDiff(nQDiff) = aRitardi(idMax) - aRitardi(idTmp)
Else
Exit Do
End If
idMax = idMax - 1
Loop
End FunctionP.S:
In questo script ci sono delle utilissime funzioni di statistica regalateci dal grandissimo Luigi, fatene tesoro ed utilizzatele anche per vostri script. E' bello cimentarsi, lo suggerisco anche come stimolo per le celluline grigie,
Grazie a tutti i miei maestri
(è stato il primo che ho centrato dopo diversi anni e solo per la gara... 
) . Adesso mi è tutto chiaro..., quasi... 
