Option Explicit
' posizione indice nella matrice aGruppi
Const cFrq = 0
Const cRit = 1
Const cRitMax = 2
Const cRitMin = 3
' valore minimo assurdo per il calcolo del rit min
Const cRitMinIniziale = 100000
Sub Main
Dim aGruppi(300,3) ' freq , rit , ritmax , ritmin
Dim aAmbi(4005,2)
Dim nPrimaEstrValida,nInizio,nFine
Dim idEstr,nRuota
ReDim aNumRuota(0)
Dim nEstrAna
' la prima estr valida è quella dalla quale si parte per il calcolo
' preventivo della frequenza di tutti gli ambi
' il calcolo preventivo è fatto sul range identificato da
' nPrimaEstrValida <---> (nInizio-1)
nPrimaEstrValida = DataEstrToIdEstr(5,1,1945)
nInizio = EstrazioneIni
nFine = EstrazioneFin
nRuota = BA_
' inizializza array gruppi (ritardi minimi / ritardo)
Call InitRitardiMinGruppi(aGruppi)
' calcola le frequenze iniziali degli ambi
Call CalcolaFrequenzeIniziali(aAmbi,nPrimaEstrValida,nInizio - 1,nRuota)
'inizia il ciclo di analisi delle estrazioni
nEstrAna =0
For idEstr = nInizio To nFine
nEstrAna = nEstrAna +1
Call Messaggio ("estrazione " & idEstr)
' per ogni estrazione estrae il vettore dei numeri usciti
Call GetArrayNumeriRuota(idEstr,nRuota,aNumRuota)
' i numeri usciti danno luogo a 10 ambi ogni ambo uscito incrementa la sua frequenza
' quindi andiamo a gestire anche il calcolo delle frequenze dei vari gruppi
Call AggiornaValoriGruppi(idEstr,aNumRuota,aGruppi,aAmbi,nEstrAna)
Call AvanzamentoElab(nInizio,nFine,idEstr )
If ScriptInterrotto Then Exit For
Next
' output in tabella
Call CreaTabGruppi(aGruppi,aAmbi)
End Sub
Sub CreaTabGruppi(aGruppi,aAmbi)
Dim k
ReDim aV(7)
aV(1) = " GruppoFrq "
aV(2) = " Ritardo "
aV(3) = " RitardoMax "
aV(4) = " RitardoMin "
aV(5) = " Frequenza "
aV(6) = " Quantita "
aV(7) = " Ambi "
Call InitTabella(aV)
For k = 0 To UBound(aGruppi)
If aGruppi(k,cFrq) > 0 Then
aV(1) = k
aV(2) = aGruppi(k,cRit)
aV(3) = aGruppi(k,cRitMax)
aV(4) = aGruppi(k,cRitMin)
aV(5) = aGruppi(k,cFrq)
aV(7) = GetAmbiDellaFrq(k,aAmbi,aV(6))
Call AddRigaTabella(aV)
End If
Next
Call CreaTabella
End Sub
Function GetAmbiDellaFrq(nFrq,aAmbi,nRetQ)
Dim k
Dim sRet
Dim t
sRet = "<pre>"
t = 0
For k = 1 To UBound(aAmbi)
If aAmbi(k,2) = nFrq Then
t = t + 1
sRet = sRet & aAmbi(k,0) & "-" & aAmbi(k,1) & "/"
If t Mod 10 = 0 Then sRet = RimuoviLastChr(sRet,"/") & vbCrLf
End If
Next
nRetQ = t
GetAmbiDellaFrq = RimuoviLastChr(sRet,"/") & "</pre>"
End Function
Sub AggiornaValoriGruppi(idEstr,aNum,aGruppi,aAmbi ,nEstrAna)
ReDim aCol(2)
Dim idAmbo
Dim k
Dim nFrqPrec
ReDim aBFreqUscite(UBound(aGruppi))
Dim nRitMxPrima , nRitMinPrima
Call Scrivi ("Estrazione : " & idEstr & " Estrazioni Analizzate : " & nEstrAna)
ReDim aV(10)
aV (1) = " Estr "
aV (1) = " Ambo "
aV (2) = " GrProv "
aV (3) = " GrDest "
aV (4) = " Frq Prima "
aV (5) = " Frq Dopo "
aV (6) = " Rit Prima "
aV (7) = " RitMx Prima "
aV (8) = " RitMx Dopo "
aV (9) = " RitMin Prima "
aV (10) = " RitMin Dopo "
Call InitTabella (aV)
' importante prima di sviluppare in ambi ordinare il vettore in mododo crescente
' altrimenti non funziona la Function <PosRecordAmbi>
Call OrdinaMatrice(aNum,1)
' inizia lo sviluppo in ambi dei 5 numeri della ruota
Call InitSviluppoIntegrale(aNum,2)
Do While GetCombSviluppo(aCol)
'ottiene l'indice dell'ambo tramite un 'appositafunzione
' per poter individuare in modo diretto l'elemento
' della matrice aAmbi che si riferisce all'ambo corrente
idAmbo = PosizioneRecordAmbi(aCol(1),aCol(2))
' legge la freq attuale (ovvwero la precedente) prima dell'uscita corrente dell'estrazione <idEstr>
' il valore ottenuto indica il gruoppo di frequenza nel quale è sortito l'ambo
nFrqPrec = aAmbi(idAmbo,2)
' memorizzo i ritardi min e max precedenti a questa uscita
nRitMxPrima = aGruppi (nFrqPrec , cRitMax)
nRitMinPrima = Iif (aGruppi (nFrqPrec , cRitMin) = cRitMinIniziale , "-" ,aGruppi (nFrqPrec , cRitMin))
' aggiornamento frequenza ambo uscito nell'array degli ambi
' in pratica incrementa la frequenza
aAmbi(idAmbo,2) = aAmbi(idAmbo,2) + 1
' memorizzo che è uscita la frequenza <nFrqPrec>
' ovvero è uscito un ambo del gruppo <nFrqPrec>
' serve per non incrementare i ritardi del gruppo
aBFreqUscite(nFrqPrec) = True
' incrementa la frequenza del gruppo
aGruppi(nFrqPrec,cFrq) = aGruppi(nFrqPrec,cFrq) + 1
' calcola rit max del gruppo
If aGruppi(nFrqPrec,cRit) > aGruppi(nFrqPrec,cRitMax) Then
aGruppi(nFrqPrec,cRitMax) = aGruppi(nFrqPrec,cRit)
End If
' calcola rt min del gruppo
If aGruppi(nFrqPrec,cRit) < aGruppi(nFrqPrec,cRitMin) Then
aGruppi(nFrqPrec,cRitMin) = aGruppi(nFrqPrec,cRit)
End If
' scrive evoluzione ambo
Call ScriviSituazioneAmbo (idEstr , idAmbo , aAmbi , nFrqPrec ,aGruppi ,nRitMxPrima , nRitMinPrima)
' azzera il ritardo essendo uscito un ambo del gruppo <nFrqPrec>
aGruppi(nFrqPrec,cRit) = 0
Loop
Call CreaTabella
' incrementa il ritardo dei gruppi che non hanno visto la sortita di un ambo in essi contenuti
For k = 0 To UBound(aGruppi)
If Not aBFreqUscite(k) Then
aGruppi(k,cRit) = aGruppi(k,cRit) + 1
End If
Next
End Sub
Sub ScriviSituazioneAmbo (idestr , idAmbo , aAmbi , nFrqPrec , aGruppi ,nRitMxPrima , nRitMinPrima)
ReDim aV(10)
aV(1) = aAmbi(idAmbo , 0) & "-" & aAmbi(idAmbo , 1)
aV(2) = nFrqPrec
aV(3) = nFrqPrec +1
aV(4) = aGruppi(nFrqPrec , cFrq) -1
aV(5) = aGruppi(nFrqPrec , cFrq)
aV(6) = aGruppi(nFrqPrec , cRit)
aV(7) = nRitMxPrima
aV(8) = aGruppi(nFrqPrec , cRitMax)
aV(9) = nRitMinPrima
aV(10) = aGruppi (nFrqPrec , cRitMin)
Call AddRigaTabella ( aV )
End Sub
Sub CalcolaFrequenzeIniziali(aAmbi,PrimaEstrValida,PrimaEstranalisi,nRuota)
Dim aNum
ReDim aCol(2)
ReDim aRuota(1)
Dim i
' calcola la frquenza di tutti gli ambi nel range precedente a quello di analisi
i = 0
aRuota(1) = nRuota
aNum = GetNumPerSviluppo
Call InitSviluppoIntegrale(aNum,2)
Do While GetCombSviluppo(aCol)
i = i + 1
aAmbi(i,0) = aCol(1) ' memorizzo l'ambo (primo num)
aAmbi(i,1) = aCol(2) ' Secondo num
aAmbi(i,2) = SerieFreqTurbo(PrimaEstrValida,PrimaEstranalisi,aCol,aRuota,2)
' solo per test
'Call Scrivi (StringaNumeri(aCol) & " freq " & aAmbi(i,2) )
Loop
End Sub
Sub InitRitardiMinGruppi(aGruppi)
Dim k
For k = 0 To UBound(aGruppi)
aGruppi(k,cRitMin) = cRitMinIniziale
aGruppi(k,cRit) = 0
aGruppi(k,cRitMax) = 0
aGruppi(k,cFrq) = 0
Next
End Sub
Function PosizioneRecordAmbi(n1,n2)
' funzione a cui passando due numeri si ottiene la posizione (l'indice)
' nell'array ambi
' per esempio se passo 1 ,2 ottengo 1
' per esempio se passo 89 , 90 ottengo 4005
Dim nBase
Dim s
Dim k '
If n1 = 1 Then
PosizioneRecordAmbi = n2 - 1
Else
nBase = 89
For k = 1 To n1 - 1
s = s + nBase
nBase = nBase - 1
Next
PosizioneRecordAmbi = s +(n2 - n1)
End If
End Function
