Option Explicit
Sub Main
Call ApriBaseDatiFT("C:\Documents and Settings\Mike58\Dati applicazioni\SpazioMetria\vinciCa.txt",5,",",40)
Dim Ini,Fin,nEstr,es,k,x,r,nValore,idOrd,TipOrd,Ctr,z
Dim DevStd,disCeb,ScaCeb
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 = EstrazioniArchivioFT
If ImpostaParametri(nNumeri,nCombinazione,nSorte,Ctr,idOrd,TipOrd,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","RitMed","RitSto","IncR.s","DevStd","disCeb","ScaCeb99%","GEN","FEB","MAR","APR","MAG","GIU","LUG","AGO","Set","OTT","NOV","DIC")
InitTabella aTitolo,RGB(108,194,243),,3,vbWhite', "Consolas"
'conto le estrazioni utili
nEstr = ContaEstrazioni(Ini,Fin,r)
nValore = Round(CicloTeorico(nCombinazione,nSorte,CInt(Ctr)),2)' ctr= 1 (=1R);=10(=TT)
freqTeorica = Round(Dividi(nEstr,nValore),2)
'aColonne = SviluppoIntegrale(nNumeri,nCombinazione) ' sviluppo i l'array dei numeri scelti ,nella combinazione scelta
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,nSorte,Ini,Fin,z)
Loop
Next
Call ResetEstrazioniAttive(z,Ini,Fin)
k = 0
nColTotSvil = InitSviluppoIntegrale(nNumeri,nCombinazione)
Do While GetCombSviluppo(aNumeri)
k = k + 1
'For k = 1 To UBound(aColonne) ' ciclo per leggere la colonna k della matrice aColonne
's = "" ' dichiaro la stringa combinazione vuota
Messaggio "Elaborazione in corso id sviluppo: " & k
AvanzamentoElab 1,nColTotSvil,k
If ScriptInterrotto Then Exit Do
s = StringaNumeri(aNumeri,,True)
Call StatisticaFormazioneFT(aNumeri,nSorte,ritardo,ritardomax,IncrRitMax,Frequenza,Ini,Fin)
FreqTot = Frequenza
' funzione per calcolare il ritardo globale della formazione
' questo è un espediente che ho dovuto analizzare visto la frequenza mese
RitMese = TrovaRitardoMese(aNumeri,nSorte,Ini,Fin,"TUTTI")
Scarto = Round(FreqTot - freqTeorica,2)
' richiamo la funzione elenca ritardi, per poter attingere alla marice che elenca i ritardi voce:( aRetRitardi)
Call ElencoRitardiFT(aNumeri,nSorte,Ini,Fin,aRetRitardi,aRetIdEstr)
' scritta funzione per calcolare il ritardo medio della formazione
RitMed = RitardoMedio(aRetRitardi)
' scritta funzione per calcolo deviazione standard della funzione
'
DevStd = CalcolaDeviazioneStd(aRetRitardi)
disCeb = Round(RitMed +(10*DevStd),2)
ScaCeb = Round(disCeb - RitMese,2)
s = RimuoviLastChr(s,".")
ReDim aRisultato(23)
Call AlimetaArrayRisultato(aRisultato,k,s,FreqTot,Scarto,RitMese,RitMed,ritardomax,IncrRitMax,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")
'se decidessi di ordinare il mese? legge il primo colore? No Legge l'ultima istruzione
Call SetColoreCella(CInt(idOrd),RGB(221,255,230),2)
Call SetColoreCella(Mese(EstrazioniArchivioFT) + 11,RGB(215,215,255),2)
Loop
Scrivi FormatSpace("script By I Legend per lottoCed's amici",150,- 1)
Scrivi
Scrivi "Tabella Statistica per formazioni libere" & " ",1,,RGB(252,227,143),,5
Scrivi
Scrivi "Range Ricerca Estrazioni dal :{" & DataEstrazioneFT(Ini) & " } al : {" & DataEstrazioneFT(Fin) & "}",1,,,,3
Scrivi "Estrazioni Totali Analizzati :{" & nEstr & "}",1,,,,3
Scrivi "Numeri di ricerca :{" & StringaNumeri(nNumeri) & "}",1,,,,3
Scrivi "Sviluppo numeri in :{" & k - 1 & " " & 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 "Ordinamento colonna num :{" & aTitolo(idOrd) & "}",1,,,,3
Scrivi "Ordino Colonna in modo :{" & TipOrd & "}",1,,,,3
Scrivi
Call SetTableWidth("100%")
'If TipOrd = 1 Then Call AddRigaTabella(aTitolo,RGB(108,194,243),,3,vbWhite)',"Consolas")
Call CreaTabella(idOrd,TipOrd,0)
'If ScriptInterrotto Then Exit Sub
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,RitMed,ritardomax,IncrRitMax,DevStd,disCeb,ScaCeb,Gen,Feb,Mar,Apr,Mag,Giu,Lug,Ago,Stt,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) = RitMed ' ritardo medio
aRisultato(7) = ritardomax ' ritardo storico
aRisultato(8) = IncrRitMax ' incremento ritardo storico
aRisultato(9) = DevStd ' deviazione standard
aRisultato(10) = disCeb 'disegualianza di cebicev
aRisultato(11) = ScaCeb ' scarto tra valore ipotizzato e valore del ritardo reale
aRisultato(12) = Gen 'Gennaio ' frequenza per mese
aRisultato(13) = Feb'Gennaio ' frequenza per mese
aRisultato(14) = Mar 'Gennaio ' frequenza per mese
aRisultato(15) = Apr 'Gennaio ' frequenza per mese
aRisultato(16) = Mag 'Gennaio ' frequenza per mese
aRisultato(17) = Giu 'Gennaio ' frequenza per mese
aRisultato(18) = Lug 'Gennaio ' frequenza per mese
aRisultato(19) = Ago 'Gennaio ' frequenza per mese
aRisultato(20) = Stt 'Gennaio ' frequenza per mese
aRisultato(21) = Ott 'Gennaio ' frequenza per mese
aRisultato(22) = Nov 'Gennaio ' frequenza per mese
aRisultato(23) = Dic 'Gennaio ' frequenza per mese
End Sub
Function ImpostaParametri(aNumeri,nCombinazione,nSorte,Ctr,idOrd,TipOrd,Ini)
Dim bRet
Ini = InizioArchivio(1)
If Ini > 0 Then
Call ScegliNumeri(aNumeri)
If IsArray(aNumeri) Then
nCombinazione = ScegliCombinazione
If nCombinazione > 0 Then
nSorte = SelEsito
If nSorte > 0 Then
'If nCombinazione < nSorte Then MsgBox "hai inserito Un Valore errato riscrivi ": nSorte = CInt(SelEsito)
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
idOrd = Ordinamento ' seleziono la colonna che voglio ordinare
If idOrd > 0 Then
TipOrd = TipoOrdinamento ' Crescente o decrescente
bRet = True ' per default torna true
End If
End If
End If
End If
End If
'End If
'End If
ImpostaParametri = bRet
End Function
Function TrovaFrequenzaMese(aNumeri,nSorte,Ini,fin,nMese)
Dim k
Dim FreqMese
FreqMese = SerieFreqFT(Ini,fin,aNumeri,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 ImpostaEstrazioneFT(k,True)
Else
Call ImpostaEstrazioneFT(k,False)
End If
Next
End If
End Sub
Sub ResetEstrazioniAttive(nMese,Ini,fin)
Dim k
For k = Ini To fin
Call ImpostaEstrazioneFT(k,True)
Next
End Sub
Function TrovaRitardoMese(aNumeri,nSorte,Ini,fin,nMese)
Dim k
Dim RitMese
If nMese <> "TUTTI" Then
Call ImpostaEstrazioniAttivePerMese(nMese,Ini,fin)
End If
RitMese = SerieRitardoFT(Ini,fin,aNumeri,nSorte)
TrovaRitardoMese = RitMese
End Function
Function NomeCombinazione(a)
Dim ris
Select Case a
Case 1
ris = "Estratti"
Case 2
ris = "Ambi"
Case 3
ris = "Terzine"
Case 4
ris = "Quartine"
Case 5
ris = "Cinquine"
End Select
NomeCombinazione = ris
End Function
Function Ordinamento
Dim Ord
Dim ret
Dim aTitolo
' gli array partono sempre da 0
aTitolo = Array(0,0,0,"freq","Scarto","Rit","RitMed","RitSto","IncR.s","DevStd","disCeb","ScaCeb99%","GEN","FEB","MAR","APR","MAG","GIU","LUG","AGO","Set","OTT","NOV","DIC")
ret = ScegliOpzioneMenu(aTitolo,3,"Seleziona Ordinamento per la colonna :")
' serve per gestire il tasto annulla
If ret >= 0 Then
Ord = ret
Else
Ord = ret
End If
Ordinamento = Ord
End Function
Function TipoOrdinamento
Dim Ord
Dim ret
Dim aTitolo
aTitolo = Array("","Crescente","DeCrescente")
ret = ScegliOpzioneMenu(aTitolo,1,"Seleziona Tipo di Ordinamento :")
' serve per gestire il tasto annulla
If ret >= 0 Then
If ret = 1 Then Ord = 1 : Else Ord = - 1
Else
Ord = ret
End If
TipoOrdinamento = Ord
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(EstrazioniArchivioFT)
For es = nInizio To EstrazioniArchivioFT 'EstrazioneFin
aVoci(es) = DataEstrazioneFT(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
Conta = Conta + 1
'If SommaEstratti(es,r) >= 15 Then
Next
ContaEstrazioni = Conta
End Function
)
