Option Explicit
Sub Main
' rilevamento terzine consecutive isocrone continue e loro statistica posizionale relativa per estratto x ricerca di micro_ ; listato by tom script versione 13
' questa versione 13 permette di analizzare tutte le ruote e tutte le posizioni rilevando anche il valore minore di differenza posizionale isocrona continua per terzine consecutive...
' in questa nuova versione è possibile scegliere anche di rilevare per ogni singola elaborazione un tipo di terzina fissa "custom" a proprio piacere...
' formata da qualsiasi numero e in qualsiasi ordinamento di immissione... ; Oltre al tipo di terzina fissa in questa versione 13 è possibile cambiare la distanza degli elementi cercati e quindi trovare anche altri tipi di terzine omogenee tipo simmetriche (distanza 30) , a distanza 10 ecc...
' come ulteriori upgrades sono state implementate le possibilità di sceglere le ruote volute e l'opzione x poter analizzare una sola posizione o tutte e 5. E' stata altresì aggiunta
' l verifica della presenza di casi multipli o meno con gli stessi valori di differenza posizionale minima. Infine nel riassuntino finale della soluzione teoricamente ottimale
' per differenza minima posizionale riscontrata adesso si possono vedere anche i relativi parametri di analisi.
' per quanto riguarda i tempi di elaborazione per un benchmark test di 5 posizioni con visualizzazione totale di tutte le estrazioni e su tutte le ruote x le ultime 10mila estrazioni impiega ca 9 min.
Dim es
Dim Inizio
Dim fine
Dim ruota
Dim numeroestrazioni
Dim contaes
Dim terzinedoctrovate
numeroestrazioni = CInt(InputBox("Quante ultime estrazioni esaminare?",,369))
Dim Posizionevoluta
Dim variabiledicontrollo
Dim aruota(1)
Dim aposizione(1)
variabiledicontrollo = "0"
Dim Differenzaposizionale
Dim Differenzaposizionaleminima
Dim ruotacondifferenzaposizionaleminima
Dim Posizionecondifferenzaposizionaleminima
Dim Formazionecondifferenzaposizionaleminima
Dim parametridellaformazionecondifferenzaposizionaleminima
Dim verificapresenzacasivaloriminimiugualimultipli
Differenzaposizionaleminima = EstrazioneFin
'Posizionevoluta = CInt(InputBox("Posizione da esaminare?",,1))
Dim vuoivederetutteleestrazioniosololeterzinedocxilfiltro
vuoivederetutteleestrazioniosololeterzinedocxilfiltro = InputBox("Vuoi vedere tutte le estrazioni per eventuale verifica di ricerca (v) o solo le terzine doc x il filtro (f) ?",,"v")
Dim vuoirilevareterzineconsecutiveocustom
vuoirilevareterzineconsecutiveocustom = InputBox("Vuoi rilevare terzine a distanza fissa (f) o terzine personalizzate (p) ?",,"f")
If vuoirilevareterzineconsecutiveocustom = "p" Then
Dim Valore1terzina
Dim Valore2terzina
Dim Valore3terzina
Valore1terzina = CInt(InputBox("primo valore della terzina ",,1))
Valore2terzina = CInt(InputBox("secondo valore della terzina ",,2))
Valore3terzina = CInt(InputBox("terzo valore della terzina ",,3))
Else
Dim qualedistanzatraglielementi
qualedistanzatraglielementi = CInt(InputBox("Quale distanza tra gli elementi delle terzine? Es. 30 x terzine simmetriche, 1 x quelle consecutive ecc...",,1))
End If
'ruota = ScegliRuota
'aruota(1) = ruota
ReDim aruoteselezionate(0)
ScegliRuote(aruoteselezionate)
Dim Posizionesingolaotutteleposizioni
Dim daPosizione1
Dim finoaPosizione5
Posizionesingolaotutteleposizioni = InputBox("Vuoi analizzare soltanto una posizione (u) o tutte e cinque (t) ?",,"t")
If Posizionesingolaotutteleposizioni = "u" Then
Posizionevoluta = CInt(InputBox("Quale posizione analizzare?",,3))
aposizione(1) = Posizionevoluta
daPosizione1 = Posizionevoluta
finoaPosizione5 = Posizionevoluta
Else
daPosizione1 = 1
finoaPosizione5 = 5
End If
Dim ritp,ritmaxp,Incmaxp,freqp
Dim sortediricercaposizionale
sortediricercaposizionale = 1
fine = EstrazioneFin
Inizio = EstrazioneFin - numeroestrazioni
contaes = 0
terzinedoctrovate = 0 ' Inizializza il conteggio delle terzine trovate
Scrivi "Elaborazione con archivio aggiornato al " & GetInfoEstrazione(EstrazioneFin)
Scrivi "Periodo analizzato " & GetInfoEstrazione(Inizio) & " - " & GetInfoEstrazione(fine)
Scrivi "Numero ultime estrazioni analizzate " & numeroestrazioni
Scrivi "Ruota analizzata " & StringaRuote(aruoteselezionate)
If Posizionesingolaotutteleposizioni = "u" Then
Scrivi "Posizione esaminata " & StringaNumeri(Posizionevoluta)
Else
Scrivi "Posizioni esaminate da 1 a 5 "
End If
Scrivi "Sorte posizionale di studio " & sortediricercaposizionale
Scrivi "Tipo di formazioni isocrone continue rilevate e analizzate: <b>terzine di tipo omogenee (es. simmetriche, consecutive) o custom (numeri personalizzati x una sola terzina)</b> "
Scrivi "Modalità di visualizzazione output : solo terzine doc (f) o tutte le estrazioni del range temporale voluto (v) : " & vuoivederetutteleestrazioniosololeterzinedocxilfiltro
Scrivi
For es = Inizio To fine - 2
contaes = contaes + 1
ReDim vettoreterzina(2)
For ruota = 1 To UBound(aruoteselezionate)
If ruota = 11 Then
ruota = 12
'aruota(1) = 12
aruota(1) = aruoteselezionate(ruota)
End If
aruota(1) = aruoteselezionate(ruota)
For Posizionevoluta = daPosizione1 To finoaPosizione5
aposizione(1) = Posizionevoluta
vettoreterzina(0) = CleanAndConvertToInt(Estratto(es,ruota,Posizionevoluta))
vettoreterzina(1) = CleanAndConvertToInt(Estratto(es + 1,ruota,Posizionevoluta))
vettoreterzina(2) = CleanAndConvertToInt(Estratto(es + 2,ruota,Posizionevoluta))
If vuoivederetutteleestrazioniosololeterzinedocxilfiltro = "v" Then
Scrivi "n.es " & GetInfoEstrazione(es) & " x posizione " & Posizionevoluta & " estratti " & StringaEstratti(es,ruota,".") ' < decommentare questa riga se si vuole verificare che lo script rilevi correttamente i numeri In Posizione voluta In Base alle tre estrazioni consecutive
End If
If Not IsNumeric(vettoreterzina(0)) Or Not IsNumeric(vettoreterzina(1)) Or Not IsNumeric(vettoreterzina(2)) Then
' Non è possibile convertire uno o più elementi in numeri interi
' Ignora questa iterazione
Exit For
End If
Call BubbleSort(vettoreterzina)
If vuoirilevareterzineconsecutiveocustom = "f" Then
If vettoreterzina(0) + qualedistanzatraglielementi = vettoreterzina(1) And _
vettoreterzina(1) + qualedistanzatraglielementi = vettoreterzina(2) Then
' Analizza qui la terzina consecutiva
' Scrivi "Terzina consecutiva trovata! Elementi: " & vettoreterzina(0) & ", " & vettoreterzina(1) & ", " & vettoreterzina(2)
variabiledicontrollo = "1"
terzinedoctrovate = terzinedoctrovate + 1
End If
'
If variabiledicontrollo = "1" Then
Scrivi "<b>Terzina consecutiva trovata! Elementi: " & vettoreterzina(0) & ", " & vettoreterzina(1) & ", " & vettoreterzina(2) & "</b>"
Scrivi "parametri statistici relativi alla posizione... " & Posizionevoluta & " e alla ruota " & NomeRuota(aruota(1))
Call StatisticaFormazioneTurbo(vettoreterzina,aruota,sortediricercaposizionale,ritp,ritmaxp,Incmaxp,freqp,Inizio,fine,,aposizione)
Scrivi "p : " & StringaNumeri(aposizione) & " ritp " & ritp & " ritmaxp " & ritmaxp & " incmaxp " & Incmaxp & " freqp " & freqp,,,,vbRed
Differenzaposizionale = ritmaxp - ritp
'
Scrivi "differenza posizionale relativa " & Differenzaposizionale
'
If Differenzaposizionale < Differenzaposizionaleminima Then
Differenzaposizionaleminima = Differenzaposizionale
ruotacondifferenzaposizionaleminima = NomeRuota(aruota(1))
Posizionecondifferenzaposizionaleminima = StringaNumeri(aposizione)
Formazionecondifferenzaposizionaleminima = StringaNumeri(vettoreterzina)
parametridellaformazionecondifferenzaposizionaleminima = "p : " & StringaNumeri(aposizione) & " ritp " & ritp & " ritmaxp " & ritmaxp & " incmaxp " & Incmaxp & " freqp " & freqp
verificapresenzacasivaloriminimiugualimultipli = 0
End If
If Differenzaposizionale = Differenzaposizionaleminima Then
verificapresenzacasivaloriminimiugualimultipli = verificapresenzacasivaloriminimiugualimultipli + 1
End If
variabiledicontrollo = "0"
Else
variabiledicontrollo = "0"
End If
Else
'rilevamento terzine di tipo "custom"
Scrivi "hai scelto di rilevare e analizzare terzine di tipo custom ",,,,vbRed
Scrivi "primo valore terzina da ricercare " & Valore1terzina,,,,vbBlue
Scrivi "secondo valore terzina da ricercare " & Valore2terzina,,,,vbBlue
Scrivi "terzo valore terzina da ricercare " & Valore3terzina,,,,vbBlue
If vettoreterzina(0) = Valore1terzina And _
vettoreterzina(1) = Valore2terzina And _
vettoreterzina(2) = Valore3terzina Or _
vettoreterzina(1) = Valore1terzina And _
vettoreterzina(2) = Valore2terzina And _
vettoreterzina(0) = Valore3terzina Or _
vettoreterzina(2) = Valore1terzina And _
vettoreterzina(1) = Valore3terzina And _
vettoreterzina(0) = Valore2terzina Then
' Analizza qui la terzina consecutiva
' Scrivi "Terzina consecutiva trovata! Elementi: " & vettoreterzina(0) & ", " & vettoreterzina(1) & ", " & vettoreterzina(2)
variabiledicontrollo = "1"
terzinedoctrovate = terzinedoctrovate + 1
End If
'
If variabiledicontrollo = "1" Then
Scrivi "<b>Terzina CUSTOM trovata! Elementi: " & vettoreterzina(0) & ", " & vettoreterzina(1) & ", " & vettoreterzina(2) & "</b>"
Scrivi "parametri statistici relativi alla posizione... " & Posizionevoluta & " e alla ruota " & NomeRuota(aruota(1))
Call StatisticaFormazioneTurbo(vettoreterzina,aruota,sortediricercaposizionale,ritp,ritmaxp,Incmaxp,freqp,Inizio,fine,,aposizione)
Scrivi "p : " & StringaNumeri(aposizione) & " ritp " & ritp & " ritmaxp " & ritmaxp & " incmaxp " & Incmaxp & " freqp " & freqp,,,,vbRed
Differenzaposizionale = ritmaxp - ritp
'
Scrivi "differenza posizionale relativa " & Differenzaposizionale
'
If Differenzaposizionale < Differenzaposizionaleminima Then
Differenzaposizionaleminima = Differenzaposizionale
ruotacondifferenzaposizionaleminima = NomeRuota(aruota(1))
Posizionecondifferenzaposizionaleminima = StringaNumeri(aposizione)
Formazionecondifferenzaposizionaleminima = StringaNumeri(vettoreterzina)
End If
variabiledicontrollo = "0"
Else
variabiledicontrollo = "0"
End If
End If
Messaggio "n. terzine doc trovate... " & terzinedoctrovate & " r " & NomeRuota(aruota(1)) & " p " & aposizione(1) & " diffpm " & Differenzaposizionaleminima
If ScriptInterrotto Then Exit For
Next ' x posizionevoluta
If ScriptInterrotto Then Exit For
Next ' x ruota
Call AvanzamentoElab(1,fine - 2,es)
If ScriptInterrotto Then Exit For
Next ' x es
Scrivi
Scrivi "Totale terzine isocrone determinate continue rispettanti il filtro voluto trovate: " & terzinedoctrovate
Scrivi
Scrivi "Differenza posizionale minima " & Differenzaposizionaleminima
Scrivi "Ruota con differenza posizionale minima " & ruotacondifferenzaposizionaleminima
Scrivi "Posizione con differenza posizionale minima " & Posizionecondifferenzaposizionaleminima
Scrivi "Formazione con differenza posizionale minima " & Formazionecondifferenzaposizionaleminima
Scrivi "Parametri della formazione con differenza posizionale minima " & parametridellaformazionecondifferenzaposizionaleminima
Scrivi "Numero di formazioni con gli stessi valori minimi di differenza posizionale " & verificapresenzacasivaloriminimiugualimultipli-1
Scrivi
Scrivi "Tempo trascorso " & TempoTrascorso
End Sub
Function CleanAndConvertToInt(Str)
' Rimuovi eventuali spazi o caratteri non numerici dalla stringa
Dim cleanedStr
cleanedStr = Replace(Str," ","")
cleanedStr = Replace(cleanedStr,".","")
' Converte la stringa in intero se possibile
If IsNumeric(cleanedStr) Then
CleanAndConvertToInt = CInt(cleanedStr)
Else
CleanAndConvertToInt = Str ' Restituisci la stringa originale se non è un numero
End If
End Function
Sub BubbleSort(arr)
Dim n,i,j,temp
n = UBound(arr)
For i = 0 To n - 1
For j = 0 To n - i - 1
If arr(j) > arr(j + 1) Then
temp = arr(j)
arr(j) = arr(j + 1)
arr(j + 1) = temp
End If
Next
Next
End Sub
) con ordinamatriceturbo ma i tempi sono pressochè identici... e inoltre con questa modifica non so perchè ma non mi considererebbe più tre estrazioni ma solo 2. Per quanto riguarda l'opzione del file txt ci avevo già pensato ma, volendo micro_ poter analizzare tutti i tipi possibili di terzine seppur uno alla volta, il file txt di base dovrebbe comunque contenerle tutte e 117480 e non so se così facendo sia più rapido che generarle dall'unico archivio e confrontarle in run time...
