| Buongiorno a tutti, come promesso ho ripescato lo script (non mio!), sviluppato in modo eccellente da Rosanna, che saluto, sperando passi a fare un giro. Option Explicit
Sub Main
'S_A_001_Ammortizzatore_Ritardi_Tab_AB_13.01.16_per_lottoced_Turbo_Stat
'http://forum.lottoced.com/forum/lottoced/area-download/1898364-ammortizzatori-del-ritardo/page5
'ATTENZIONE: questo listato gira su SpazioMetria dalla versione 1.5.75 in su <====
Dim e,r,i,y,n,co,conta,contaes,k,kk,ris,RP,RC,capilista
Dim ini,fin,inizio,dInizio,p,p2,p3,p4,NuRitAtt,NuRitPre
Dim TB(10,4)' tabella che contiene i dati e attuale
Dim TBp(10,4)' tabella che contiene i dati es precedente
Dim A(10),B(10) ' vettore per i valori della scala A e B attuale
Dim Ap(10,2),Bp(10)'Matrice per i valori della scala Aprecedente e vettore per la scala B precedente
Dim At(10),Bt(10)' vettore per memorizzare temporaneamente le posizioni sortite
Dim aSortite(10) ' vettore per memorizzare le ruote con sortite di capilista
Dim tSortiti
Dim nStatA(3,10,10)' matrice statistica fre + max + Rit att Posizione/segnalatori scala A
fin = EstrazioneFin
ini = 10350'3950 'inizio ricerca
'Promemoria: 3950 inizio archivio senza buchi (non partire da 3949 perchè lo script contempla sempre una es precedente)
contaes = 0 'contatore estrazioni valide statistica (dalla scala A completa)
'----------------------------------inizializzo la matrice nStat
For i = 1 To 3
nStatA(i,0,0) = 0
For p = 1 To 10
For p2 = 1 To 10
nStatA(i,p,p2) = 0
Next
Next
Next
'-----------------------------------riempio la tabella dati passati sulla es di partenza: (ini-1)
For r = 1 To 10
n = PiuRitardatario(ini - 1,r)
RP = RitPosPR(r,ini - 1)
RC = RitardoEstrattoTurbo(n,ini - 1,r)
If NumCapilista(ini - 1,r) > 1 Then
co = 0
For i = 1 To 90
If RitardoEstrattoTurbo(i,ini - 1,r) = RC Then
co = co + 1
If co = 1 Then ris = Format2(i)
If co > 1 Then ris = ris & "." & Format2(i)
End If
Next
Else ris = Format2(n)
End If
TBp(r,1) = r
TBp(r,2) = ris' Numeri/o Più Ritardatari/o
TBp(r,3) = RP ' ritardo di posizione
TBp(r,4) = RC 'ritardo cronologico
Next
Call OrdinaMatriceTurbo(TBp,- 1,"3,4")
For r = 1 To 10
Ap(r,1) = Ap(r,1) - TBp(r,1)' memorizzo valori negativi sulla scala A iniziale (mi serve per controllarne la compilazione)
Ap(r,2) = Ap(r,1) ' inizializzo anche la seconda colonna con gli stessi valori della prima
Next
'---------------------------------------------output dati iniziali/pregressi
Call Scrivi
Call Scrivi(DataEstrazione(ini - 1) & "[" & ini - 1 & "]")
Call Scrivi("PO - RU - NU ---- RC -- RP - Ap")
For p = 1 To 10
Call Scrivi(Format2(p) & Space(3) & SiglaRuota(TBp(p,1)) & Space(3) & FormatSpace(TBp(p,2),6) & Space(2) & FormatSpace(TBp(p,4) + 1,3,1)_
& Space(3) & FormatSpace(TBp(p,3),3,1) & Space(4) & Ap(p,1) & Space(4) & Bp(p))
Next
'----------------------------------scansiono l'archivio elaborando i dati ad ogni estrazione(e)
For e = ini To fin
If ScriptInterrotto Then Exit Sub
Call AvanzamentoElab(ini,fin,e)
'----------------------------calcolo l'estrazione in cui la scala A è completa
If inizio = 0 Then
conta = 0
For p = 1 To 10
If Ap(p,1) > 0 Then conta = conta + 1
If conta = 10 Then
inizio = 1
dInizio = e
Call Scrivi
Call Scrivi("====================== SCALA A COMPLETA =============================")
Exit For
End If
Next
End If
If inizio = 1 Then ' dalla scala A completa inizio a fare la statistica.1^ cosa gestisco il ritardo incrementandolo di 1 ad ogni es
contaes = contaes + 1
For i = 1 To 10
For y = 1 To 10
nStatA(3,i,y) = nStatA(3,i,y) + 1
Next
Next
End If
'---------------------------------------------------------------------------------------------------------
Call Scrivi
Call Scrivi(DataEstrazione(e) & "[" & e & "] " & contaes)
Call Scrivi("PO - RU - NU ---- RC -- RP -- A -- B")
For r = 1 To 10 'ad ogni estrazione travaso sulla TBp i dati di TB
'A(r) = Ap(r)
If e > ini Then 'la TBp mi serve per tenere conto della situazione all'es precedente
TBp(r,1) = TB(r,1) 'ruota
TBp(r,2) = TB(r,2) 'numero/i capolista
TBp(r,3) = TB(r,3) 'RP
TBp(r,4) = TB(r,4) 'RC
End If
aSortite(r) = 0
tSortiti = 0
At(r) = 0
Bt(r) = 0
Next
For r = 1 To 10 ' poi per ogni ruota verifico i dati e riempio la Tabella per poterla ordinare
Call Messaggio(e & " " & r)
n = PiuRitardatario(e,r)' Numero Più Ritardatario attuale
NuRitPre = PiuRitardatario(e - 1,r) 'idem dell'es precedente
RP = RitPosPR(r,e)
RC = RitardoEstrattoTurbo(n,e,r)
If NumCapilista(e,r) > 1 Then
co = 0
For i = 1 To 90
If RitardoEstrattoTurbo(i,e,r) = RC Then
co = co + 1
If co = 1 Then ris = Format2(i)
If co > 1 Then ris = ris & "." & Format2(i)
End If
Next
Else ris = Format2(n)
End If
TB(r,1) = r
TB(r,2) = ris' Numeri/o Più Ritardatari/o
TB(r,3) = RP ' ritardo di posizione
TB(r,4) = RC 'ritardo cronologico
'-----------------------------------controllo sortite capilista e iniziale azzeramento posizioni cadute sulla scala A pregressa
If NumCapilista(e - 1,r) = 1 And n <> NuRitPre Then ' se c'era un solo capolista e il più Ritardatario è diverso da quello dell'es precedente
Call ColoreTesto(2) ' aggiorno i valori
Call Scrivi(SiglaRuota(r) & " uscito -> " & NuRitPre,,0)
For p = 1 To 10 ' scorro le posizioni della TB
If TBp(p,1) = r Then 'appena trovo corrispondenza tra le ruote TB PREC
'---------------------- step per scala B
If inizio = 1 Then
For p3 = 1 To 10
If Ap(p3,1) = p Then 'verifico la posizione della scala A sortita
For p4 = 1 To 10 '
If B(p4) = p3 Then Bp(p4) = 0 ' verifico se ce n'erano già le azzero
Next
Bt(r) = p3
End If
Next
End If
'-----------------------aggiornamento statistica scala A. Qui è necessario disporre della seconda colonna di Ap
'perchè sulla prima in taluni casi di multisortite i valori dei selettori vengono azzerati per permettere la
'corretta movimentazione della scala A
If inizio = 1 Then
nStatA(1,p,Ap(p,2)) = nStatA(1,p,Ap(p,2)) + 1 'aggiorno la freq sortita posizi/segnalatore
If nStatA(3,p,Ap(p,2)) > nStatA(2,p,Ap(p,2)) Then nStatA(2,p,Ap(p,2)) = nStatA(3,p,Ap(p,2))'aggiorno max rit
nStatA(3,p,Ap(p,2)) = 0 ' azzero il rit
End If
'--------------------------step valorizzazione scala A
For p2 = 1 To 10
If Ap(p2,1) = p Then Ap(p2,1) = 0 ' verifico che non si siano prec casi con quella posizione altrimenti la azzero
Next
Call Scrivi(" posizione precedente " & p & " con segnalatore " & Ap(p,2))
Call ColoreTesto(0)
At(r) = p ' memorizzo sul vettore tale posizione
aSortite(r) = 1
tSortiti = tSortiti + 1
'------------------------fine step scala A
End If
Next
Else '--------------------------altrimenti in caso di più capilista...mostro nell'output quello sortito
If NumCapilista(e - 1,r) > 1 And NumCapilista(e,r) = 1 Then
For i = 1 To 5
If RitardoEstrattoTurbo(Estratto(e,r,i),e - 1,r) = RitardoEstrattoTurbo(NuRitPre,e - 1,r) Then
Call ColoreTesto(2)
Call Scrivi(SiglaRuota(r) & " uscito 1 dei capilista -> " & Estratto(e,r,i))
End If
Next
Call ColoreTesto(0)
End If
End If
Next
Call OrdinaMatriceTurbo(TB,- 1,"3,4")
'-----------------------------------aggiornamento scala A definitiva 1^ parte
If tSortiti = 0 Then
For p = 1 To 10 ' se non ci sono state sortite di capilista la scala A non varia
A(p) = Ap(p,1)
Next
Else
k = 11 - tSortiti
For p = 10 To 1 Step - 1' scorro la tabB al contrario
If Ap(p,1) <> 0 Then
k = k - 1
If k = 0 Then Exit For
A(k) = Ap(p,1)
End If
Next
End If
'----------------------------------aggiungo i nuovi usciti sulla scala A 2^ parte
kk = 10 - tSortiti
For r = 1 To 10
If aSortite(TB(r,1)) = 1 Then
kk = kk + 1
A(kk) = At(TB(r,1))
End If
Next
'----------------------------aggiornamento scala B 1^ parte (da quando la scala A è completa)
If inizio = 1 Then
If tSortiti = 0 Then
For p = 1 To 10 ' se non ci sono state sortite di capilista la scala B non varia
B(p) = Bp(p)
Next
Else
k = 11 - tSortiti
For p = 10 To 1 Step - 1' scorro la tabB al contrario
If Bp(p) <> 0 Then
k = k - 1
If k = 0 Then Exit For
B(k) = Bp(p)
End If
Next
End If
'----------------------aggiungo i nuovi usciti scala B 2^ parte
kk = 10 - tSortiti
For r = 1 To 10
If aSortite(TB(r,1)) = 1 Then
kk = kk + 1
B(kk) = Bt(TB(r,1))
End If
Next
End If
'-------------------output
For p = 1 To 10
Call Scrivi(Format2(p) & Space(3) & SiglaRuota(TB(p,1)) & Space(3) & FormatSpace(TB(p,2),6) & Space(2) & FormatSpace(TB(p,4) + 1,3,1)_
& Space(3) & FormatSpace(TB(p,3),3,1) & Space(2) & FormatSpace(A(p),3,1) & Space(2) & FormatSpace(B(p),3,1))
Next
'-----------------aggiorno le scale A B pregresse con i valori delle ultime scale A B appena aggiornate
For p = 1 To 10
Ap(p,1) = A(p)
Ap(p,2) = A(p)' la seconda colonna serve per le statistiche in quando sulla prima in taluni casi certe pos vengno azzerate durante la movimentazione scala
Bp(p) = B(p)
Next
Next
'-----------------Output statistica
Call Scrivi
Call Scrivi("=======================================================================")
Call Scrivi
Call Scrivi("AMMORTIZZATORI DEI RITARDI da studio di SEVERO",1)
Call Scrivi("STATISTICA FRE - MAX - ATT POSIZIONI(blu) SEGNALATORI (rosso) SCALA A",1)
Call Scrivi("dal " & DataEstrazione(dInizio) & " al " & DataEstrazione(EstrazioneFin) & " estrazioni valide: " & contaes,1)
Call Scrivi
For p = 1 To 3
If p = 1 Then Call Scrivi("FR",1,False)
If p = 2 Then Call Scrivi("MX",1,False)
If p = 3 Then Call Scrivi("RT",1,False)
For i = 1 To 10
Call ColoreTesto(2)
Call Scrivi(FormatSpace(i,6,1),1,False)
If i = 10 Then Call Scrivi
Next
For i = 1 To 10
Call ColoreTesto(1)
Call Scrivi(FormatSpace(i,2,1),1,False)
Call ColoreTesto(0)
For y = 1 To 10
Call Scrivi(FormatSpace(nStatA(p,i,y),6,1),,False)
If y = 10 Then Call Scrivi
Next
Next
Scrivi
Next
Call Scrivi("Legenda: FR=frequenza di sortita MX=Max Rit Sto RT= ritardo attuale")
End Sub
'-----------------------------------FUNZIONE Numeri capilista
Function NumCapilista(e,r)
Dim F_piurit,F_rit,F_i
F_piurit = PiuRitardatario(e,r)
F_rit = RitardoEstrattoTurbo(F_piurit,e,r)
NumCapilista = 0
For F_i = 1 To 90
If RitardoEstrattoTurbo(F_i,e,r) = F_rit Then NumCapilista = NumCapilista + 1
Next
End Function
'-----------------------------------FUNZIONE Ritardo di posizione capilista
Function RitPosPR(r,e)
Dim F_n,F_np,F_rit,F_ritp,F_es,F_co
F_co = 0
For F_es = e To e - 500 Step - 1
F_n = PiuRitardatario(F_es,r)
F_rit = RitardoEstrattoTurbo(F_n,F_es,r)
F_np = PiuRitardatario(F_es - 1,r)
F_ritp = RitardoEstrattoTurbo(F_np,F_es - 1,r)
If F_rit = F_ritp + 1 Then
F_co = F_co + 1
Else Exit For
End If
Next
RitPosPR = F_co
End Function Il meccanismo di base mi sembra sia lo stesso. A step forse possiamo evolvere lo script, passando dall'estratto più ritardato di ogni ruota all'ambo più ritardato. Saluti |
