Ciao Mike , la funzione proposta di ricercare gli ambi bivalenti si presta bene anche ad una soluzione che abbia approccio tramite le collection.
Naturalmente prima di mostrare lo script che assolve allo stesso compito ma che fa uso delle collection
è necessario introdurre i concetti di base.Questi cconcetti constano della spiegazione delle collection e delle classi,
niente di difficile stai tranquillo.
Provo ad introdurre i vari concetti
cose'è una collection ?
Una collection è un contenitore di oggetti , all'interno del contenitore ogni oggetto si puo identificare con una chiave che poi consentira di recuperarlo velocemente.
Gli oggetti in una collection si possono enumerare col ciclo
For ... Each
Le collection si possono usare in vbscript ? E quindi anche in lottoDesk ?
La risposta è SI , il vbscript puo tranquillamente usare le collection quindi anche lottodesk puo farlo
il problema è che il vbscript sebbene le possa usare senza alcun problema non puo crearle da solo e qui interviene
la differenza tra Spaziometria e Lottodesk , gli autori di quest'ultimo non hano pensato a quanto poteva
essere utile inserire una funzione che restituisse una normalissima collection di vb e vi garantisco che implementare
una simile funzione era banalissimo , vedremo poi come aggirare l'ostacolo per poter usare le collection anche in lottoddesk visto che comunque il loro utilizzo risolve spesso dei problemi
Cos'è un classe ?
Una classe è la definizione di un oggetto che puo avere delle proprieta e dei metodi
le proprieta sono le variabili pubbliche della classe
i metodi sono le funzioni pubbliche della classe
una clase puo contenere quante proprieta vogliamo e altrettanti metodi dipende da noi.
le classi sono usate per memorizzare in un unica variabile dei valori complesssi e dato che
le classi dispongono dei metodi è possibile crearne di appositi che manipolino al volo
le proprieta per fornire dati calcolati che in quel momento ci servono.
facciamo subito un esempio di codice
Abbiamo visto che le colllection sono dei contenitori ,
ebbene ammettiamo che io voglia inserire nel contenitore una certa quantita
di oggetti ognuno che identifichi una persona , che me ne fornisca nome , data di nasicita e relativa età
come se volessimo creare una specie di rubrica .
1) La prima cosa da fare è definire la nostra classe che conterra i valori della persona
Abbiamo detto che vogliamo memorizzare il nome e la data di nascita mentre
l'età non è possibile memorizzarla in quanto cambia in funzione di quando eseguiamo lo script.
Pertanto Nome e Data di nascita saranno due variabili perche si possono memorizzare cosi come sono
Età invece sara una funzione della classe che calcolera l'età della persona in quel momento percioe Eta sara un metodo della classe.
Bene definiamo la classe , ciò si puo fare tranquillamente in vbscript e quindi anche in lottodesk
una volta definita la classe andiamo a istanzare una nova colllection ovvero un nuovo contenitore
per inserirci dentro gli oggetti che vorremo
poi inizieremo a creare gli oggetti persona e ad inserirli dentro
poi inseriamo altri 2 oggetti persona per altre 2 persone
quando abbiamo finito di alimentare la collection possiamo ciclare sugli oggetti in essa contenuti
oppure possiamo idendificare un oggetto preciso attraverso la chiave
bene questo è lo script di esempio per familiarizzare con le classi e le collection
in questo script sono espressi tutti i concetti che servono per capire lo script che seguirà
di cui abbiamo parlato all'inizio e cioè quello che trova gli ambi bivalenti con
questo approccio delle collection.
questo è lo script di esempio per familiarizzare con classi e collection
Codice:
Option Explicit
' definizione della classe Persona
Class clsPersona
Dim Nome
Dim DataNascita
Function Eta ' questa funzione calcola l'eta della persona
Eta = Int((DateDiff("d",DataNascita,Now)/365))
End Function
End Class
Sub Main
Dim cPersona ' variabile che sara istanziata con l'oggetto clsPersona
Dim CollPersone ' collection che conterra tutti gli oggetti cPersona
Set CollPersone = GetNewCollection ' istanzia la collection
' istanzio un nuovo oggetto clsPersona per inserire un nuovo nome
Set cPersona = New clsPersona
' valorizzo le proprieta dell'oggetto
cPersona.Nome = "Antonio"
cPersona.DataNascita = "30/01/1970"
' inserisco l'oggetto nella collection con la chiave corrsipondente al suo nome
CollPersone.add cPersona,cPersona.Nome
' aggiungo altre persone ===========================================
Set cPersona = New clsPersona
cPersona.Nome = "Mario"
cPersona.DataNascita = "10/10/1965"
CollPersone.add cPersona,cPersona.Nome
Set cPersona = New clsPersona
cPersona.Nome = "Francesco"
cPersona.DataNascita = "15/07/1975"
CollPersone.add cPersona,cPersona.Nome
'====================================================================
' esempio di ciclo for each sugli elementi contenuti nella collection
Call Scrivi("Esempio di ciclo for each nella collection",True)
For Each cPersona In CollPersone
Call Scrivi(cPersona.Nome & " ha " & cPersona.eta & " anni")
Next
Call Scrivi
Call Scrivi
' esempio di estrazione di un elemento preciso contenuto nella collection
Call Scrivi("Esempio di lettura di elemento specifico nella collection",True)
Set cPersona = CollPersone("Mario")
Call Scrivi(cPersona.Nome & " ha " & cPersona.eta & " anni")
End Sub
questo che segue invece e lo script che trova gli ambi bivalenti , come noterete bisogna scrivere parecchio codice
, lo faccaimo solo a scopo didattico visto che per questo problema degli ambi bivalenti abbiamo individuato gia soluzioni piu compatte ed efficienti.
Riguardo le performance l'algoritmo si difende bene anche se come detto abbiamo gia visto altre soluzioni.
Usare le classi e le collection comunque consente di gestire statistiche con dati complessi che se si dovessoro realizzare a forza di semplici array darebbero luogo ad un codice indecifrabile e sicuramente piu difficile da scrivere
Vanno usate ovviamente quando servono in altri casi gli array bastano e avanzano ma questo rientra nella regola
la funzione giusta la momento giusto

.
Il codice che segue puo girare tranquillamente anche in lottodesk modificando solo un paio di righe se qualcuno è interessato poi spiego come fare
Codice:
Option Explicit
' definizione dell'oggetto clsAmbo
' questo ogetto serve per memorizzare una coppia di numeri
' per poi poterlo immettere in una collection
Class clsAmbo
Dim aBNum(90)' array contenete i flag dei 90 numeri
' ad esempio l'ambo 1-90 dara ai flag
' aBNum (1) = True
' aBNum (90) = True
' tutti gli altri elementi avranno valore False
Dim aBRuote(12) ' array contenente i flag delle ruote
' serve a memorizzare le ruote dove l'ambo è sortito
' ad esempio se fosse sortito su BA e CA si avrebbe
' aBRuote(1) = true
' aBRuote(2) = true
' tutti gli altri elementi avranno valore False
Function GetKey()
' questa funzione legge i numeri che compongono l'ambo e torna una stringa
' che li contiene , siccome servira per memorizzare una Key in una collection
' e dato che le key nelle collection devono iniziare con una lettera , alla
' stringa ottenuta si antepone la lettera convenzionale "K"
Dim k
Dim sKey
sKey = "K"
For k = 1 To 90 ' leggo i numeri nell'array dei flag e se valorizzato a true costruisco la chiave
If aBNum(k) Then
sKey = sKey & Format2(k)
End If
Next
GetKey = sKey
End Function
Function GetQuantitaRuoteUsate()
' questa funzione conteggia quante sono le ruote sulle quali l'ambo è sortito
' si basa sull'array dei flag delle ruote
Dim k
Dim nQRuote
For k = 1 To 12 ' leggo l'array dei flag e conteggio le ruote usate (quelle che hanno il flag a True)
If aBRuote(k) Then
nQRuote = nQRuote + 1
End If
Next
GetQuantitaRuoteUsate = nQRuote
End Function
Function GetStringaNumeri
' questa funzione legge i numeri dell'ambo e torna una stringa
Dim k
Dim s
For k = 1 To 90 ' ciclo sui flag dei numeri alla ricerca di quelli suati
If aBNum(k) Then' se il flag è True allora
s = s & Format2(k) & " " ' il numero è usato e lo immetto nella stringa
End If
Next
GetStringaNumeri = Trim(s)
End Function
Function GetStringaRuote
' questa funzione trorna la stringa composta dalle sigle delle ruote usate
Dim k
Dim s
For k = 1 To 12
If aBRuote(k) Then ' leggo l'array dei flag
s = s & SiglaRuota(k) & " " ' alimenta stringa ruote usate
End If
Next
GetStringaRuote = Trim(s)
End Function
End Class
Sub Main
Dim CollAmbi
Dim cAmbo
Dim es
Dim t
Dim r
Dim k
t = Timer
For es = 8500 To 8599
' per ogni estrazione reistanzio la stessa collecion che ogni volta conterra
' solo gli ambi di quella estrazione
Set CollAmbi = GetNewCollection ' ottengo la collection semplicemente chiamando la funzione apposita
For r = 1 To 10 ' inserisco nella collection gli ambi usciti sulle varie ruote
Call AlimentaAmbiRuota(es,r,CollAmbi)
Next
' cerco all'interno della collection gli ambi che sono usciti su piu di una solz ruota
For Each cAmbo In CollAmbi
If cAmbo.GetQuantitaRuoteUsate > 1 Then ' se l'ambo è uscito su piu di una ruota lo conteggio
k = k + 1
Scrivi es & "...." & cAmbo.GetStringaNumeri & " Trovato... " & cAmbo.GetStringaRuote
Scrivi String(40,"-") & " " & k
End If
Next
Next
Scrivi "Trova " & k & " Ambi Bivalenti."
ColoreTesto 2 : Scrivi "Con un Tempo di Elaborazione : " & Timer - t :
ColoreTesto 0
Scrivi "Velocità di ricerca : " & k /(Timer - t) & " Ambi/Secondo"
End Sub
Sub AlimentaAmbiRuota(idEstr,Ruota,CollAmbi)
' questa funzioen inizializza l'inserimento nella collection degli ambi di
' tutti gli ambi usciti
Dim cAmbo
Dim k,kk
Dim sKey
' ciclo sui numeri della singola ruota per sviluppare in ambi
For k = 1 To 4
For kk = k + 1 To 5
' per ogni ambo che ottengo
' istanzio un nuovo oggetto del tipo ClsAmbo
Set cAmbo = New clsAmbo
' una volta istanziato gli imposto i numeri dell'ambo
cAmbo.aBNum(Estratto(idEstr,Ruota,k)) = True
cAmbo.aBNum(Estratto(idEstr,Ruota,kk)) = True
' poi gli imposto la ruota
cAmbo.aBRuote(Ruota) = True
' ora mi serve di saper che chiave ha questo ambo per vedere se è
' gia presente nella collection
sKey = cAmbo.GetKey
' a questo punto del codice ho un oggetto del tipo clsAmbo che è contenuto
' nella variabile cAmbo
' ora attraverso una funzione passo questo oggetto cAmbo e vedo se è necessario
' inserirlo nella collection degli ambi , se non esiste verra inserito
' se gia esiste verra aggiornata la nuova ruota su cui è uscito
' tutto questo lo fara la seguente funzione
Call AddItemInCollAmbi(Ruota,cAmbo,CollAmbi,sKey)
Next
Next
End Sub
Sub AddItemInCollAmbi(Ruota,cAmbo,CollAmbi,sKey)
' questa funzione inserisce nella collection degli ambi il nuovo ambo
' attribuendogli una chiave
On Error Resume Next
Dim cAmboTmp
' per prima cosa provo a vedere se l'ambo è gia presente nella collection
' e questo lo faccio provando a leggere all'interno della stessa
' l'oggetto con la chiave che so
Set cAmboTmp = CollAmbi(sKey)
' se l'ambo era gia presente (ovviamente perche era gia uscito su una ruota precedente)
' la funzione non dara errore , altrimenti se l'oggetto cercato
' con quella chiave non è presente scaturira un errore che noi
' intercettiamo e gestiamo
If Err <> 0 Then ' se l'errore è diverso da 0 vuol dire che l'oggetto cercato non è stato trovato
CollAmbi.add cAmbo,sKey ' percio lo dobbiamo aggingere nella collection con la chiave che sappiamo
Else
' se invece non c'è nessun errore vul dire che l'oggetto è stato trovato
' ovvero gia era stato inserito in quanto uscito su un altra ruota precetdente
' percio dobbiamo solo aggiornare l'uscita sulla ruota corrente
cAmboTmp.aBRuote(Ruota) = True
End If
End Sub