Novità

SpeedTest & SpeedUp

Joe91

Advanced Member >PLATINUM PLUS<
Codice:
'Script per il Test di SerieFreqTurbo di Rubino / SpeedTest By Joe
'Richiede Spaziometria 1.4.0
Option Explicit
Sub Main
 Dim r1,q,qq,es,p,pp,r2,w1,a3,a4,t,k
 t = Timer
 Scrivi "Usando SerieFreqTurbo, questo script, in un campione di 100 Estrazioni (8500-8599) ...",1
 ReDim a(2)
 ReDim ruota(2)
 For es = 8500 To 8599
  For r1 = 1 To 9
   For q = 1 To 4
    For qq = q + 1 To 5
     a(1) = Format2(Estratto(es,r1,q))
     a(2) = Format2(Estratto(es,r1,qq))
     For r2 = r1 + 1 To 10
      ReDim ruota(2)
      ruota(1) = r1
      ruota(2) = r2
      For p = 1 To 4
       For pp = p + 1 To 5
        a3 = Format2(Estratto(es,r2,p))
        a4 = Format2(Estratto(es,r2,pp))
        If a3 = a(1) And a4 = a(2) Or a3 = a(2) And a4 = a(1) Then
         w1 = SerieFreq(es,es,a,ruota,2)
         If w1 > 1 Then
          'Scrivi es & "...." & a(1) & " " & a(2) & " Trovato..." & w1
          k = k + 1
         End If
        End If
       Next
      Next
     Next
    Next
   Next
  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

'Usando' SerieFreqTurbo, questo script, in un campione di 100 Estrazioni (8500-8599) ...
'Trova 121 Ambi Bivalenti.
'Con un Tempo di Elaborazione : 18.98047
'Velocità di ricerca : 6.374974 Ambi/Secondo

L'output inserito come esempio nella parte finale dello script varia,

in funzione, delle caretteristiche, del PC su cui viene esegito.

E'pertanto gradita la conferma di performance migliori ottenibili con PC più veloci.

:) Grazie.
 
ciao ecco l'output sul mio pc un modesto dual core da 1.9 ghz che ormai ha qualche anno

Immagine.JPG
 
ad ogni modo in questo script la mggior parte del lavoro lo fa lo script stesso e non la funzione SerieFreq pertanto non si nota un tempo di sviluppo con differenze cosi nette usando le 2 funzioni differenti.
Nello script comunque mi sembra ci sia SerieFreq non SerieFreqTurbo
 
infatti , la funzione serifreq in questo caso riceve il comando di analaizzare una sola estrazione , (rangemin = rangemax) e come se dicessero di fare una gara di corsa ad un vecchietto e ad un atleta pero la regola della gara è che si deve fare solo la distanza di un passo
,è chiaro che i due arriveranno quasi nello stesso istante :-) dovendo allungare solo un piede.. eheheh Ciao
 
Ultima modifica di un moderatore:
non saprei , io l'archivio l'ho sostitito ... e ora col setup dovrebbe venire quello giusto.
Se io ho gli stessi risultati di Joe allora m i sa che qualcosa non va quando fai ll'installazione.
Dopo l'installazione il programma chiede se si vogliono sostituuire i propri archivi con quelli del setup ..
 
Buon Giorno a tutti,

Innanzi tutto Vi ringrazio per la collaborazione ...

e si ... ho scelto questo script, perchè permette si "aprire" a molte considerazioni.

Luigi ha già ... "mangiato la foglia" ed anticipato molte delle considerazioni presenti e future. Rubino pure.

Prima: quando si parla di frequenze sono importantissimi Inizio/Fine altrimenti i conti non tornano,

e quindi che le numerazioni e gli archivi siano uguali.

E qui confermo quanto ha scritto Luigi. L'archivio di Rubino mantiene la vecchia numerazione (+1)...

rispetto a quello che è l'archivio "standard" di Spaziometria delle versioni recenti.

Forse quelle successive alla 1.3.75 Ma non ricordo il numero di versione esatto.

Per il resto è evidente che intendo dare un esempio di come si potrà velocizzare ... questo script.

:)
 
Codice:
Option Explicit
  Sub Main
  Dim r1,q,qq,es,p,pp,r2,w1,A(4),ruota(2),K,T
T=Timer
  For  es = 8500 To 8599
 'Scrivi String (40,"-")

  For r1 = 1 To 9 : ruota(1) = r1
   For q = 1 To 4
    For qq = q + 1 To 5
     A(1) = Estratto(es,r1,q)
     A(2) = Estratto(es,r1,qq)
      For r2 = r1 + 1 To 10 : ruota(2) = r2
       For p = 1 To 4
        For pp = p + 1 To 5
         A(3) = Estratto(es,r2,p)
         A(4) = Estratto(es,r2,pp)
          If (A(3) = A(1) And A(4) = A(2)) Or (A(3) = A(2) And A(4) = A(1)) Then
  K=K+1
           'w1 = SerieFreqTurbo (es, es, a, ruota, 2)
           'If  w1 = 2 Then
            Scrivi FormatSpace (K,3,1) & ")  " & es & "...." & Format2(A(1)) & " " & Format2(A(2)) & " Trovato... " & SiglaRuota(r1) & "-"& SiglaRuota(r2)'" & w1
           'End If
          End If
        Next
       Next
      Next
     Next
    Next
   Next
  Next 
Scrivi Timer-T & " Secondi"
 End Sub

Questo è il primo livello di ottimizzazione dello script.

Si noterà come in metà del tempo con queste modifiche

sia possibile anche elencare i risultati ed il calcolo delle ruote in cui sono presenti gli Ambi.

:)
 
ciao Joe , ottimizzazione per ottimizazione la soluzione mia prevede l'uso di una funzione specifica presente nel linguaggio spazioscript
preposta alllo scopo che serve.
Ineffetti se non le uso io le mie creazioni :-) ... in questa versione ovviamente non si fa in tempo a premere esegui che il risultato gia appare.
Ad ogni modo studiare i metodi per ottimizzare e rendere piu veloce il codice è un arte.. molto buona l'idea di studiarci su.

Codice:
Sub Main
	Dim aN(2)
	Dim aRuote(10)
	For k = 1 To 10
		aRuote(k) = k
	Next
	For es = 8500 To 8599
		If GetAmbiUguali(es,CollAmbiTrovati,aRuote) > 0 Then
			For Each clsCoppia In CollAmbiTrovati
				aN(1) = clsCoppia.clsNumero(1).Numero
				aN(2) = clsCoppia.clsNumero(2).Numero
				w1 = SerieFreqTurbo(es,es,aN,aRuote,2)
				nTrov = nTrov + 1
				Scrivi FormatSpace(nTrov,3,1) & ")  " & es & "...." & Format2(aN(1)) & " " & Format2(aN(2)) & " Trovato... " & SiglaRuota(clsCoppia.clsNumero(1).Ruota) & "-" & SiglaRuota(clsCoppia.clsNumero(3).Ruota) & " " & w1
			Next
		End If
	Next
End Sub
 
Ultima modifica di un moderatore:
Buon Giorno a Tutti.

La versione che vi propongo ed è quanto avevo in mente, non è una riscrittura, vera e propria,

come quella di Rubino e di Luigi, ma è "solo" la semplificazione dell'algoritmo originale.

Con essa si raggiungono comunque velocità di elaborazione nell'ordine di 40/50 volte quella iniziale.

Quanto scritto da Luigi è sicuramente di velocità ancora 10 volte superiore a questa da me proposta,

e ciò, rende possibile il contegggio in tutto l'archivio ... in qualche secondo.

Un risultato difficilmente superabile.

Da Guinnes dei primati.

COMPLIMENTI.

:)

Codice:
'SpeedUp By Joe

Option Explicit
Sub Main
 Dim es,r1,r2,p1,p2,e1,e2,k,t
 t = Timer
 For es = 8500 To 8599
  For r1 = 1 To 9
   For p1 = 1 To 4 : e1 = Estratto(es,r1,p1)
    For p2 = p1 + 1 To 5 : e2 = Estratto(es,r1,p2)
     For r2 = r1 + 1 To 10
      If Posizione(es,r2,e1) > 0 And Posizione(es,r2,e2) > 0 Then
       k = k + 1
       Scrivi es & "...." & Format2(e1) & " " & Format2(e2) & " Trovato... " & SiglaRuota(r1) & "-" & SiglaRuota(r2)
       Scrivi String(40,"-") & " " & k

      End If
     Next
    Next
   Next
  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

'Trova 121 Ambi Bivalenti.
'Con un Tempo di Elaborazione : 0.421875
'Velocità di ricerca : 286.8148 Ambi/Secondo[SIZE=2][COLOR=#008000][SIZE=2][COLOR=#008000]
[/COLOR][/SIZE][/COLOR][/SIZE]
 
ottima soluzione Joe , l'utilizzo della funzione Posizione sicuramente da il suo apporto.
Sempre rimanendo sull'algoritmo da te proposto si possono operare ulteriori ottimizzazioni che ora vado a spiegare
e che rendono il tuo algoritmo ancora piu veloce.

la prima riguarda la lettura dei numeri delle ruote : è meglio leggerli tutti insieme piuttosto che uno alla volta

nel tuo script facevi uso della funzione estratto che come tutti sappiamo restituisce il numero in posizione x della ruota y
tale funzione viene richiamata al'interno di 2 cicli nidificati , ora senza fare dei calcoli complicati eseguiamo
questo script semplificato e vediamo quante volte la funzione estratto verrebbe richiamata

Codice:
Sub Main
	For es = 1 To 1
		For r1 = 1 To 9
			For p1 = 1 To 4 : x = x + 1
				For p2 = p1 + 1 To 5 : xx = xx + 1
				Next
			Next
		Next
	Next
	Call Scrivi("La funzione Estratto nel ciclo p1 è richiamata : " & x & " volte")
	Call Scrivi("La funzione Estratto nel ciclo p2 è richiamata : " & xx & " volte")
End Sub

[COLOR="#FF0000"]ecco il risultato [/COLOR]

La funzione Estratto nel ciclo p1 è richiamata : 36 volte
La funzione Estratto nel ciclo p2 è richiamata : 90 volte

dato che chiamare una funzione è piu dispendioso che lavorare direttamente in memoria
con un array allora una prima strategia da applicare per velocizzare le operazioni
è quella di leggere contemporaneamente tutti i numeri dell'estrazione ES mediante la
funzione GetEstrazioneCompleta essa ci restituisce un array con i numeri di
tutte le ruote e per noi è meglio lavorare con quello.


la seconda ottimizzazione riguarda l'ottimizzazione delle condizioni nidificate : è meglio usare if nidificati che if in AND

Questa ottimizzazione si basa sulla conoscenza della logica dell'interprete del vbscript.
Quando l'interprete trova una riga del tipo :

if A = 1 and B = 2 then

in realta esso (l'interprete) valuta sempre tutte e due le condizoni , cosa che non sarebbe necessaria una volta appurato che la prima condizione non risulti verificata.
Purtroppo il VB fa cosi , altri compilatori e interpreti sono piu efficenti e ottimizzano da soli il codice , invece noi
che usiamo il vb dobbiamo fare attenzione e siccome sappiamo che ogni istruzione impartita al processore
richiede un piccolo pedaggio in temini di prestazioni dobbiamo fare in modo di inviare meno comandi possibili
cosicche da rendere il codice piu efficente.
In qusti casi si usano gli if nidificati piuttosto che gli if concatentati da operatori booleani (ad esempio AND)
percio il codice :

if a = 1 then
If b =2 then
' fai qualcosa
end if
end if

è piu veloce di
if A = 1 and B = 2 then



con le semplici modifiche che ho esposto come dicevo lo script di Joe mantenendo la stessa logica va ancora
piu veloce , tuttavia per rendere piu compatto il codice che si scrive è sempre meglio usare le funzioni del linguaggio
se esse esistono e fanno gia quello che ci serve.


SCRIPT FINALE
Codice:
'SpeedUp By Joe
Option Explicit
Sub Main
	Dim es,r1,r2,p1,p2,e1,e2,k,t
	ReDim aNumEstraz(11,5)
	t = Timer
	For es = 8500 To 8599
		Call GetEstrazioneCompleta(es,aNumEstraz)
		For r1 = 1 To 9
			For p1 = 1 To 4 ': e1 = Estratto(es,r1,p1)
				For p2 = p1 + 1 To 5 ': e2 = Estratto(es,r1,p2)
					For r2 = r1 + 1 To 10
						'If Posizione(es,r2,e1) > 0 And Posizione(es,r2,e2) > 0 Then
						If Posizione(es,r2,aNumEstraz(r1,p1)) > 0 Then
							If Posizione(es,r2,aNumEstraz(r1,p2)) > 0 Then
								k = k + 1
								'Scrivi es & "...." & Format2(e1) & " " & Format2(e2) & " Trovato... " & SiglaRuota(r1) & "-" & SiglaRuota(r2)
								Scrivi es & "...." & Format2(aNumEstraz(r1,p1)) & " " & Format2(aNumEstraz(r1,p2)) & " Trovato... " & SiglaRuota(r1) & "-" & SiglaRuota(r2)
								Scrivi String(40,"-") & " " & k
							End If
						End If
					Next
				Next
			Next
		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
'Trova 121 Ambi Bivalenti.
'Con un Tempo di Elaborazione : 0.421875
'Velocità di ricerca : 286.8148 Ambi/Secondo
 
Ciao a Tutti i partecipanti di questo post, un grazie per queste mini-lezioni , molto gradite e ben vengano argomenti che in qualsiasi modo trattano la materia vbscript , per imparare c'è sempre SPAZIO....METRIA.

Per Luigi se puoi, quando vuoi, quando si presenta l'occasione, se puoi spiegare in qualche modo l'uso delle COLLECTION che come hai sempre decantato ottimizzano ancora meglio le ricerche + complesse.

Un grazie, un saluto e ancora un buon anno.

Mike
 
Ciao Mike,

si, è vero che il non imparare ... alcune cose, ci fa perdere un mucchio di tempo ...

e con questo la possibilità di espandere le nostre possibilità di ricerca, in ambiti ritenuti proibiti(vi).

Intanto ho applicato i consigli di Luigi ... ad un nuovo algoritmo che,

pur mantenendo la compatibilità (avendo solo istruzioni multipiattaforma) riduce considerevolmente il tempo di elaborazione.

Quindi un grazie grande-grande a Luigi, Maestro di importantissimi suggerimenti.

:) Buona Giornata a Tutte/i.

Codice:
[FONT=Courier New][SIZE=2][COLOR=#000000]---------------------------------------- 5202[/COLOR][/SIZE][/FONT]
[FONT=Courier New][SIZE=2][COLOR=#000000]8627....01 41 Trovato... TO-VE[/COLOR][/SIZE][/FONT]
[FONT=Courier New][SIZE=2][COLOR=#000000]---------------------------------------- 5203[/COLOR][/SIZE][/FONT]
[FONT=Courier New][SIZE=2][COLOR=#000000]8628....12 49 Trovato... FI-NA[/COLOR][/SIZE][/FONT]
[FONT=Courier New][SIZE=2][COLOR=#000000]---------------------------------------- 5204[/COLOR][/SIZE][/FONT]
[FONT=Courier New][SIZE=2][COLOR=#000000]8631....28 65 Trovato... NA-PA[/COLOR][/SIZE][/FONT]
[FONT=Courier New][SIZE=2][COLOR=#000000]---------------------------------------- 5205[/COLOR][/SIZE][/FONT]
[FONT=Courier New][SIZE=2][COLOR=#000000]Trova 5205 Ambi Bivalenti.[/COLOR][/SIZE][/FONT]
[FONT=Courier New][SIZE=2][COLOR=#ff0000]Con un Tempo di Elaborazione : 5.816406[/COLOR][/SIZE][/FONT]
[FONT=Courier New][SIZE=2][COLOR=#000000]Velocità di ricerca : 894.8824 Ambi/Secondo[/COLOR][/SIZE][/FONT]

Elabora dalla estrazione 3950 ad oggi in meno di 6 secondi.
 
Ultima modifica:
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

Immagine.png



una volta definita la classe andiamo a istanzare una nova colllection ovvero un nuovo contenitore
per inserirci dentro gli oggetti che vorremo

Immagine1.png


poi inizieremo a creare gli oggetti persona e ad inserirli dentro

Immagine2.png


poi inseriamo altri 2 oggetti persona per altre 2 persone

Immagine3.png


quando abbiamo finito di alimentare la collection possiamo ciclare sugli oggetti in essa contenuti

Immagine4.png


oppure possiamo idendificare un oggetto preciso attraverso la chiave

Immagine5.png



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
 
Ultima modifica di un moderatore:
Ciao Luigi, lezione assai complessa, devo veramente impegnarmi per fare ordine mentale e uscire dai soliti canoni.
Il 1^ esempio è chiaro ma, poi quando si entra nel mondo dei numeri tutto si complica e l'ordine mentale comincia a vacillare.
Conserverò e rileggerò attentamente il tutto per cercare di utilizzarlo quando l'dea o il progetto lo richiedono.

Per adesso e sempre tanti tanti grazie per la bravura che metti a disposizione.

Mike
 
ciao Rubino per ordinare gli oggetti di una collection c'è l'apposita funzione OrdinaItemCollection
pero gli ordinamenti sono comunque piu veloci sugli array che sulle collection percio se il caso lo richiede
si puo tenere nella collection un insieme di elementi complessi , poi creare un array che memorizzi
la chiave dell'oggetto e il valore per il quale si vuole ordinare , nell'array ci saranno tanti elementi
qunati sono gli oggetti contenuti nella collection , poi si ordina l'array e si leggono gli oggetti della collection prendendo
le chiavi dall'array ordinato.
 
presento ora uno script a beneficio dei possessori di lottodesk ,questo script gira sia su lottodesk che su spaziometria
Come ripeto l'uso delle collection e delle classi una volta acquisita la giusta padronanza dei concetti consente di scrivere codice migliore
e di risolvere problemi in modo piu elegante , talvolta (anche se ora non mi viene un esempio pratico) è addirittura piu facile risolvere un problema mediante l'ausilio di questi strumenti.
Prima di presentare lo script riepilogo alcuni concetti


1) le collection sono dei contenitori di oggetti , come fossero array pero hanno dei metodi che gli array non hanno che fanno la differenza

2) le classi sono delle definizioni di ogetti pensati da noi che raggruppano metodi e proprietà
da una classe si possono generare le sue istanze ogni istanza è un oggetto a se stante che dispone delle proprieta e metodi
che noi abbiamo definito


la logica dello script per trovare gli ambi bivalenti

Lo script sfrutta una delle proprietà delle collection e cioè quella di poter ricercare
un elemento al sui interno attraverso una chiave.
Quinddi lo script cosa fa ?
Semplicissimo
- scorre tutte le estrazioni
- ad ogni estrazione istanzia una collection
- poi costruisce gli ambi che si formano con i numeri delle 10 ruote
- ogni ambo viene inserito nella collection , in questa fase prima di essere inserito l'ambo viene prima cercato
(ed è qi che sfruttiamo la collection) dato che potrebbe essere gia presente in quanto uscita su una ruota
precedente a quella corrente (stiamo ancora dentro i l ciclo delle 10 ruote che a sua volta sta dentro quelllo dellel estrazioni)
- se l'ambo è stato trovato gli aggiungiamo la ruota corrente , se non è stato trovato lo inseriamo e anche in questo caso
settiamo la ruota su cui è uscito

- al termine del ciclo delle ruote avremo una collection che contiene tutti gli ambi usciti in quell'estrazione
(nella nostra collection ci sono gli oggetti clsambo)

- con un ciclo for each scorriamo gli oggetti clsAmbo contenuti nella collection
- ora facciamo un If e usiamo il metodo che avevamo scritto dentro la classe clsAmbo che ci torna la quantia delle ruote
se questo metodo ci torna maggiore di 1 vuol dire che l'ambo è uscito su piu di una ruota sola e quindi lo dobbiamo conteggiare
perche rispecchia le condizioni
- finito questo si passa all'estrazione successiva e si ripete tutto (ciclo esterno delle estrazioni del range)


per consentire la creazione delle collection in vb script quando non si sta lavorando con Spaziometria si istanzia un oggetto che si chiama Scripting.Dictionary ed è fornito direttamente da windows
è un equivalente delle collection anche se ha delle lievi differenze , è ovvio che il seguente script(lievemente modificato rispetto a quello che avevo gia postato) quindi puo girare sia su lottodesk che su spaziometria ... provare per credere ... ciao a tutti gli scripter :-)


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
	Dim cvbColl
	Dim sKey
	
	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
		Set CollAmbi = CreateObject("Scripting.Dictionary")
		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 sKey In CollAmbi
			Set cAmbo = CollAmbi(sKey)
			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
	
	' cerco l'ambo con la sua chiave dentro la collection 
	If CollAmbi.Exists(sKey) = False Then ' se l'ambo non esiste allora
		CollAmbi.add sKey,cAmbo 'inserisce nella collection quello passato nel parametro
	Else
		' se invece l'ambo  esiste 
		' ovvero gia era stato inserito in quanto uscito su un altra ruota precedente
		' dobbiamo solo aggiornare l'uscita sulla ruota corrente
		
		Set cAmboTmp = CollAmbi.Item(sKey) ' quindi istanziamo il nostro oggetto prendendo l'elemento
							     ' identificato da sKey all'intrerno della  collection	
							     ' lo troviamo di sicuro sappiamo gia che esiste	
		cAmboTmp.aBRuote(Ruota) = True
	End If
End Sub
 
Ciao Luigi, BuonGiorno a tutte/i.

Ho provato lo script che hai inserito al messagio #23

col vecchio L8 e funziona ... come avevi correttamente affermato e come si può verificare con la grafica a confronto.

23315872.jpg


GRAZIE, per le utilissime informazioni (e commenti) in esso contenuti e dunque per il tuo buon esempio (in ampia accezione).

:)
 
Cioa Joe, mi fa piacere che hai provato e che confermi ..

Per Rubino , in questo caso la tua memoria non fa difetto , semplicemente non esiste una funzione che faccia gia tutto quello che hai chiesto.
Si deve scrivere una funzione apposta che faccia questo...e ti diro questa ipotetica funzione potrebbe restituire proprio una collection che contenga tutte le estrazioni in cui la combinazione sia sortita...
 
che si intende per volte consecutive ? Forse che la combinazione sia sortita in due o piu estrazioni consecutive ? Altro dubbo , se io alla funzione gli passo 2 ruote questa calcolerà l'esito in contemporanea su tutte e due le ruote quindi poi non sarebbe possibile scindere le volte che è uscita da una parte e le volte che è uscita dall'altra, inoltre sono confuso perche la lista della statistica veloce non ti fornisce il dato finale che vuoi tu ma dei dati che eventualmente devono essere elaborati per ottenere cio che desideri ...
 
Ultima modifica di un moderatore:
eh vabene , solo che questa lista non ti da direttamente le informazion che vuoi ... te le devi calcolare .. percio non mi è chiaro se ti serve questa lista oppure se ti serve i l dato calcolato di cui parlavi

quante volte consecutive una combinazione è sortita su 1 ruota e quante volte su l'altra, e che consecutività ha attualmente.
 
Ultima modifica di un moderatore:

Ultima estrazione Lotto

  • Estrazione del lotto
    lunedì 04 maggio 2026
    Bari
    22
    24
    23
    33
    09
    Cagliari
    40
    15
    22
    90
    51
    Firenze
    70
    02
    71
    41
    40
    Genova
    51
    80
    25
    69
    30
    Milano
    23
    28
    89
    02
    64
    Napoli
    16
    54
    41
    08
    56
    Palermo
    18
    25
    11
    66
    36
    Roma
    28
    07
    03
    47
    76
    Torino
    72
    24
    01
    07
    70
    Venezia
    10
    80
    17
    69
    13
    Nazionale
    06
    39
    41
    42
    38
    Estrazione Simbolotto
    Milano
    18
    31
    25
    04
    14
Indietro
Alto