Ciao Bep allora mi sono dedicato a questa tua idea e ho fatto uno script.
I tempi sono piu che accettabili ,pochi secondi .. davvero inaspettato..
sempre che io abbia fatto bene....
passo alla descrizione dello script.
premessa :
Abbiamo detto che vogliamo analizzare i gruppi di frequenza per ambo
ovvero quei gruppi che contengono gli ambi ad una tale frequenza.
Tutti gli ambi con freq 1 appartengono al gruppo di freq 1
tutti quelli con freqenza X appartengono al gruppo X ogni volta che
un nuovo ambo esce si alterano i valori statistici di quel gruppo
a cui esso appatrtiene.
Ogni gruppo gestisce una frequenza specifica ,io ho previsto da 0 a 300
che per gli ambbi mi sembra un valore addirttura esagerato.
descrizione script.
lo script usa due matrici :
la prima matrice aAmbi contiene i 4005 ambi possibili , prima del
ciclo che analizza le estrazioni gli ambi di questa matrice verranno sottoposti
a calcolo della frequenza sicche ognuno dei 4005 elementi della matrice
memorizza la frequenza di quell'ambo ancora prima dell'analisi estrazioni.
precisamente nel range che va dalla prima estrazione valida dell'archivio
(a discrezuione io ho impostato il 1945) fino all'estrazione precedente
a quella di inizio range
la seconda matrice aGruppi serve per gestire i valori statistici di ciascun
gruppo, io ho previsto 301 gruppi (da 0 a 300) per ogni gruppo calcoliamo
ritardo , ritardomax ,ritardo min , frequenza.
Questa matrice si modifica durante il range di analisi estrazioni
c'è un primo ciclo che scorre le estrazioni del range
ad ogni passaggio verranno estratti i numeri di quell'estrazione per quella ruota
(lo script gestisce una ruota sola io ho preimpostato BARI)
quei numeri usciti daranno luogo a 10 ambi che otterremo sviluppando in classe 2
il vettore dei numeri estratti.
Onuno di questi 10 ambi lo individuiamo nella matrice degli ambi quindi possiamo
leggere che frequenza aveva prima di questa uscita corrente.
la frequenza che aveva identifica il gruppo a cui apparteneva pertanto
andiamo a calcolare i valori statistici di quel gruppo che avendo visto l'uscita di un ambo
dovra prima di azzerare il suo ritardo valutare il ritardo che aveva per vedere se
supera i ritarsi min e max ed eventualmente aggiornarli ,
fatto questo il ritardo del gruppo si azzera e la sua frequenza si incrementa
terminato l'aggiornamento dei 10 ambi usciti dobbiamo incrementare il ritardo
per quei gruppi che non hanno visto la sortita di nessun ambo.
fatto tutto questo si analizza la prossima estrazione e si ripete cosi
via fino alla fine del range
al termien mostra i gruppi con i valori statistici.
per avere una tabella piu corta ho impostato che mostra solo i gruppi la cui
frequenza sia maggiore di 0 ma è facile da modificare remmando l'if.
non so vedi un po se lo script fa quello che dovrebeb fare ...ciao
Codice:
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)
' 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
For idEstr = nInizio To nFine
' 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)
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 = ""
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 , "/")
End Function
Sub AggiornaValoriGruppi(idEstr,aNum,aGruppi,aAmbi)
ReDim aCol(2)
Dim idAmbo
Dim k
Dim nFrqPrec
ReDim aBFreqUscite (UBound(aGruppi))
' 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)
' 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
' azzera il ritardo essendo uscito un ambo del gruppo <nFrqPrec>
aGruppi(nFrqPrec,cRit) =0
Loop
' 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 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
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
Grande beppignello 
Seguo... 
