Option Explicit
' script per Cinzia utente lotto ced
' non si garantisce la corretttezza dei dati
' lo script potrebbe essere ottimizzato ulteriormente
' caricare tutte le 4005 combinazioni di ambi porterebbe tempi di attesa molto lunghi
' i calcoli impiegherebbero troppa memoria
' o si fa il calcolo on the fly oppure si scompongono tutte le colonne in piu file di testo
' entrambe le soluzioni comportano una notevole spesa di tempo
Sub Main
Dim i,j,m,k,E
Dim nColT
Dim nConv
Dim aR(1)
Dim aAmbi(89)
Dim sConv
Dim IniRange,FinRange
IniRange = 1
FinRange = EstrazioneFin
nColT = Combinazioni(89,2)
ReDim aStat(nColT,3)
aR(1) = 11
'
' comincio eleborazioni dati
Call ResetTimer
' carico gli ambi consecutivi
Call CaricaArrayAmbiConsecutivi(aAmbi)
m = 0
' ciclo l array che contiene gli ambi in modo da accoppiarli
For i = 1 To UBound(aAmbi) - 1
If ScriptInterrotto Then Exit For
ReDim aRit(0),aIdE(0)
' lancio la funzione elenco ritardi e trovo le estrazioni in cui l ambo è presente
Call ElencoRitardiTurbo(aAmbi(i),aR,2,IniRange,FinRange,aRit,aIdE)
For j = i + 1 To UBound(aAmbi)
If ScriptInterrotto Then Exit For
' lancio la funzione per trovare gli id estrazioni in cui è presente l altra coppia di ambi da confrontare
ReDim aRit1(0),aIdE1(0)
Call ElencoRitardiTurbo(aAmbi(j),aR,2,IniRange,FinRange,aRit1,aIdE1)
m = m + 1
nConv = 0
sConv = ""
' ciclo l elenco estrazioni e verifico se queste estrazioni sono presenti anche nell altra lista
For k = 1 To UBound(aIdE1) - 1
If ScriptInterrotto Then Exit For
E = aIdE1(k)
' questa funzione sembra funzionare correttamente dalle verifiche fatte , ma non si escludono possibili errori
' presupposto fondamentale che la lista sia una lista ordinata
If RicercaElementoInLista(aIdE,E) = 1 Then ' non cambiare questa riga =1 è il risultato che la funzione da se l elemento è presente nella lista
nConv = nConv + 1
sConv = sConv & E & ";"
End If
Next
aStat(m,1) = StringaNumeri(aAmbi(i),,True) & "[ " & FormatSpace(aRit(UBound(aRit)),3) & "] - " & StringaNumeri(aAmbi(j),,True) & "[ " & FormatSpace(aRit1(UBound(aRit1)),3) & "] "
aStat(m,2) = nConv
aStat(m,3) = RimuoviLastChr(sConv,";")
Call AvanzamentoElab(1,nColT,m)
Next
Next
' ordino la matrice in modo da avere i risultati in ordine crescente
' anche gli ambi vengono ordinati
Dim aIdCol(2),aIdV(2)
aIdCol(1) = 2:aIdCol(2) = 1
aIdV(1) = 1:aIdV(2) = 1
Call OrdinaMatrice2(aStat,aIdCol,aIdV)
Scrivi TempoTrascorso
' scrivo In Output i risultati ottenuti
Dim sChrSep
For i = 1 To UBound(aStat)
For j = 1 To UBound(aStat,2)
sChrSep = " | "
If j > 2 Then sChrSep = " "
Scrivi aStat(i,j) & sChrSep,,0
Next
Scrivi
Next
End Sub
Sub CaricaArrayAmbiConsecutivi(aAmbi)
Dim n1,n2
For n1 = 1 To 89
n2 = n1 + 1
aAmbi(n1) = Array(0,n1,n2)
Next
End Sub
' ho utilizzato la funzione fix per ottenere l id colonna senza parte decimale
' spero che non vengano saltate colonne , dalle verifiche che ho fatto sembra di no
'ma potrebbero esserci dei casi o per lo meno non mi sento di escluderlo
' questo è un algoritmo di ricerca binaria in una lista
' in rete si trovano varie spiegazioni
' '
Function RicercaElementoInLista(aLista,E)
Dim Primo_
Dim Ultimo
Dim Mezzo
Dim tro
tro = - 1
Primo_ = 1
Ultimo = UBound(aLista) - 1
Do While(Primo_ <= Ultimo And tro = - 1)
Mezzo = Fix((Primo_ + Ultimo)/2)
If aLista(Mezzo) < E Then
Primo_ = Mezzo + 1
ElseIf aLista(Mezzo) = E Then
tro = 1
ElseIf aLista(Mezzo) > E Then
Ultimo = Mezzo - 1
End If
Loop
RicercaElementoInLista = tro
End Function
