Follow along with the video below to see how to install our site as a web app on your home screen.
Nota: This feature may not be available in some browsers.
i legend;n2133239 ha scritto:Ciao a bari se non ho fatto errori ho trovato 62 settimo con 9 presenze
a Firenze c'è anche una settimana con 10 presenze.
Ciao a tutti
eheheh .Capito Nikor si attende il tuo parere .... ciao ...
RUOTA:BARI
Formazione P Fr Rc Rmx
02.16.20.59.77.84.89 9 09 00 03
03.04.16.20.73.77.89 9 09 00 03
03.04.20.45.73.77.84 9 16 00 03
03.04.20.47.73.77.84 9 13 00 03
03.04.20.57.73.77.84 9 13 00 03
03.04.20.73.77.80.84 9 13 00 03
03.15.40.52.54.58.84 9 09 01 03
03.16.40.59.77.84.87 9 11 00 03
03.16.45.51.75.77.89 9 09 00 03
03.20.25.59.60.76.77 9 09 00 03
03.22.40.49.54.84.87 9 09 01 03
03.40.45.59.77.87.89 9 09 00 04
03.49.54.59.74.77.84 9 11 00 03
03.49.54.59.77.80.84 9 11 00 02
03.49.54.59.77.84.85 9 11 00 03
03.54.58.59.77.84.87 9 11 00 03
04.15.20.25.73.77.84 9 09 00 03
04.15.20.73.77.84.89 9 09 00 03
04.16.20.73.77.84.89 9 11 00 03
04.20.22.73.77.84.89 9 09 00 03
04.20.25.27.73.77.84 9 09 00 03
04.20.25.45.73.77.84 9 11 00 03
04.20.25.52.73.77.84 9 09 00 03
04.20.25.60.76.77.84 9 09 00 05
04.20.25.73.76.77.84 9 09 00 03
04.20.25.73.77.80.84 9 09 00 03
04.20.40.73.77.84.89 9 09 00 03
04.20.45.72.73.77.84 9 11 00 03
04.20.45.73.77.84.89 9 11 00 03
04.20.47.73.77.84.89 9 09 00 03
04.20.57.73.77.84.89 9 09 00 03
04.20.72.73.77.80.84 9 09 00 03
04.20.73.77.80.84.89 9 09 00 03
04.40.45.77.84.87.89 9 09 00 04
11.16.20.73.77.84.89 9 09 00 03
15.16.20.25.73.77.84 9 09 02 03
16.20.45.59.77.84.89 9 11 00 03
16.20.45.73.77.84.89 9 11 02 03
16.20.47.73.77.84.89 9 09 02 03
16.20.51.73.77.84.89 9 11 00 03
16.20.57.73.77.84.89 9 09 02 03
16.20.59.60.77.84.89 9 09 00 03
16.20.59.69.77.84.89 9 09 00 03
16.20.59.73.77.84.89 9 11 00 03
16.20.59.77.80.84.89 9 09 00 03
16.20.73.77.80.84.89 9 09 02 03
16.40.45.59.77.84.87 9 09 00 03
16.45.51.59.77.84.89 9 11 00 03
16.45.51.75.77.84.89 9 11 00 03
16.45.59.77.84.87.89 9 09 00 03
20.22.54.59.77.84.89 9 09 00 03
20.22.54.73.77.84.89 9 09 02 03
20.25.52.54.73.77.84 9 09 02 03
20.25.59.60.76.77.84 9 09 00 03
20.25.60.75.76.77.84 9 09 02 03
22.45.49.54.77.84.89 9 09 03 02
22.45.51.54.77.84.89 9 09 00 05
22.45.54.59.77.84.89 9 09 00 03
22.49.54.59.77.84.89 9 09 00 03
25.45.51.52.54.77.84 9 09 00 02
40.45.59.77.84.87.89 9 09 00 04
40.45.75.77.84.87.89 9 09 01 03
45.49.54.59.74.77.84 9 09 00 02
45.49.54.59.77.84.85 9 09 00 02
45.49.54.59.77.84.89 9 09 00 02
45.54.58.59.77.84.87 9 09 00 03
tempo elaborazione:Ruota : Firenze
Formazione P Fr Rc Rmx
01.30.42.51.62.77.78 9 09 02 02
01.42.44.51.52.62.77 9 11 02 03
01.42.44.52.55.62.77 9 09 02 03
01.42.44.52.56.62.77 9 09 02 03
01.42.44.52.62.77.84 9 09 02 03
05.09.16.42.59.62.77 9 11 05 02
05.11.16.42.44.59.77 9 11 04 02
05.11.16.42.59.62.77 9 11 05 02
05.16.42.59.60.62.77 9 11 05 02
05.16.42.59.60.77.90 9 09 01 05
05.16.42.59.62.73.77 9 11 05 02
05.16.42.60.62.77.90 9 09 01 03
06.11.16.42.44.62.77 9 11 04 02
06.11.16.42.44.64.77 9 09 04 02
06.13.16.42.44.62.77 9 11 04 03
06.13.27.42.44.62.77 9 09 04 03
06.13.42.44.59.62.77 9 11 04 03
06.13.42.44.62.77.79 9 09 04 03
06.16.42.60.62.77.90 9 09 01 03
07.11.16.44.59.76.77 9 09 04 02
09.42.44.60.62.77.90 9 09 01 03
11.12.42.44.60.62.77 9 09 01 02
11.16.27.42.44.62.77 9 11 04 02
11.16.34.44.59.76.77 9 09 04 02
11.16.42.44.47.59.77 9 09 04 02
11.16.42.44.59.61.77 9 09 04 02
11.16.42.44.59.62.77 9 13 04 02
11.16.42.44.59.72.77 9 09 04 02
11.16.42.44.59.75.77 9 09 04 02
11.16.42.44.59.76.77 9 11 04 02
11.16.42.44.59.77.87 9 09 04 02
11.16.42.44.62.77.79 9 11 04 02
11.16.44.57.59.76.77 9 09 04 02
11.34.42.44.60.62.77 9 11 01 02
11.37.42.44.60.62.77 9 09 04 02
11.37.42.44.62.73.77 9 09 04 02
11.42.44.60.62.65.77 9 09 04 02
11.42.44.60.62.71.77 9 09 01 02
11.42.44.60.62.73.77 9 11 04 02
[B]11.42.44.60.62.77.90 10 10 01 02[/B]
11.42.44.62.73.77.90 9 09 04 02
12.16.37.42.60.62.77 9 09 01 03
12.30.42.44.52.62.77 9 09 03 02
12.37.42.44.60.62.77 9 09 01 03
12.37.42.44.62.77.90 9 09 01 03
12.42.44.60.62.73.77 9 09 01 03
12.42.60.62.73.77.78 9 09 01 03
13.42.44.60.62.73.77 9 09 04 02
13.42.44.60.62.77.90 9 09 01 03
16.27.42.60.62.77.90 9 09 01 03
16.34.42.59.60.62.76 9 09 01 03
16.34.44.59.60.76.77 9 09 01 04
16.42.44.59.60.77.90 9 09 01 04
16.42.44.60.62.77.90 9 11 01 03
16.42.51.60.62.77.90 9 09 01 03
16.42.59.60.62.76.90 9 09 01 03
16.42.59.60.62.77.90 9 11 01 03
16.42.60.62.77.79.90 9 09 01 03
16.42.60.62.77.86.90 9 09 01 03
16.44.59.60.76.77.90 9 09 01 04
18.42.44.60.62.73.77 9 09 04 02
18.42.44.60.62.77.90 9 09 01 03
23.30.42.44.52.62.77 9 11 03 02
30.37.42.44.52.62.77 9 09 03 02
30.37.42.44.62.65.77 9 09 03 02
30.42.44.52.62.77.78 9 11 03 02
34.42.44.60.62.73.77 9 11 01 03
37.42.44.52.62.65.77 9 09 03 03
42.44.52.60.62.65.77 9 09 03 03
42.44.52.60.62.73.77 9 09 04 02
42.44.52.60.62.77.90 9 09 01 03
42.44.52.62.65.73.77 9 09 03 03
42.44.52.62.65.77.90 9 09 03 03
42.44.60.62.71.73.77 9 09 01 03
42.44.60.62.73.77.90 9 11 01 03
tempo elaborazione:
LuigiB;n2133378 ha scritto:
Nikor;n2133341 ha scritto:
joe;n2133379 ha scritto:Pare si possa far di meglio ...
... ma bisogna stare nella stanza dei bottoni.
Esserci confusione sulle date delle estrazioni ... eppoi non dimenticare che ...
c'è chi disse che in certe occasioni «A pensar male del prossimo si fa peccato ma si indovina»'?
Parole papali papali di cui s'ha ricordo.
Se fosse così, 10 Ambi sarebbero meglio di 11 e direttamente 20. Ed Oltre ...
LuigiB;n2133407 ha scritto:
Option Explicit
Class clsCombinazione
Private aNum
Private aBNum
Private mFrequenze
Private mPresenze
Private mClasse
Private mKey
Private aIdEstr
Private nTrov
Private Sub Class_Initialize()
mFrequenze = 0
mPresenze = 0
ReDim aBnum(90)
End Sub
Public Property Get Classe
Classe = mClasse
End Property
Public Property Let Classe(v)
mClasse = v
End Property
Public Property Get ArrayNum
ArrayNum = aNum
End Property
Public Property Get Key
Key = mKey
End Property
Public Property Let Key(v)
mKey = v
End Property
Public Property Get Presenze
Presenze = mPresenze
End Property
Public Property Get Frequenze
Frequenze = mFrequenze
End Property
Public Property Get Combinazione
Combinazione = StringaNumeri(aNum,,True)
End Property
Sub IncrementaFrequenze
mFrequenze = mFrequenze + 1
End Sub
Sub SetNumeri(aNumTmp)
Dim k
aNum = aNumTmp
For k = 1 To UBound(aNum)
aBNum(aNum(k)) = True
Next
End Sub
Sub CalcolaFrequenza(aRuote,nSorte,nIni,nFin)
mFrequenze = SerieFreqTurbo(nIni,nFin,aNum,aRuote,nSorte)
End Sub
Sub CalcolaPresenze(aRuote,nSorte,Inizio,Fine)
Dim k,r,e,nPunti,aNumRuota,nPresenze
Dim aB
nPresenze = 0
For k = Inizio To Fine
For r = 1 To UBound(aRuote)
Call GetArrayNumeriRuota(k,aRuote(r),aNumRuota)
nPunti = 0
For e = 1 To 5
If aBNum(aNumRuota(e)) Then
nPunti = nPunti + 1
End If
Next
If nPunti >= nSorte Then
nPresenze = nPresenze + 1
End If
Next
Next
mPresenze = nPresenze
End Sub
Sub AddIdEstr(v)
nTrov = nTrov + 1
ReDim Preserve aIdEstr(nTrov)
aIdEstr(nTrov) = v
End Sub
End Class
Sub Main
Dim nEstrDaUSare,nClasse,nSorte,CollLunghette,nIni,nFin
nEstrDaUSare = 18
nClasse = 7
nSorte = 2
ReDim aRuote(1)
aRuote(1) = FI_
nIni =(EstrazioneFin - nEstrDaUSare) + 1
nFin = EstrazioneFin
Set CollLunghette = GetCollLunghettaMigliori(nIni,nFin,nClasse,nSorte,aRuote)
Call AlimentaTabOutput(CollLunghette,aRuote,nClasse,nSorte)
MsgBox TempoTrascorso
End Sub
Sub AlimentaTabOutput(CollLunghette,aRuote,nClasse,nSorte)
Dim av,cLung
Scrivi "Ruote : " & StringaRuote(aRuote)
Scrivi "Classe : " & nClasse
Scrivi "Sorte : " & nSorte
av = Array("","Lunghetta","Frequenza","Presenza")
Call InitTabella(av)
For Each cLung In CollLunghette
av(1) = cLung.Combinazione
av(2) = cLung.Frequenze
av(3) = cLung.Presenze
Call AddRigaTabella(av)
Next
Call CreaTabella
End Sub
Function GetCollLunghettaMigliori(Inizio,Fine,nClasse,nSorte,aRuote)
Dim CollComb,cComb
Dim CollLung,cLung
Dim k,j,e
Dim nFatte,nDaFare
Dim nRetFrequenze
Dim sKey
ReDim aCol(nSorte)
ReDim abNumValidi(90)
Set CollComb = GetNewCollection
Set CollLung = GetNewCollection
' alimento una collection con tutte le combinazioni di classe <nSorte> che si
' formano con le cinquine comprese nel range interessato
' di ogni singola combinazione si calcolano le frequenze
For k = Inizio To Fine
For j = 1 To UBound(aRuote)
ReDim aNum(0)
Call GetArrayNumeriRuota(k,aRuote(j),aNum)
For e = 1 To 5
abNumValidi(aNum(e)) = True
Next
Call OrdinaMatrice(aNum,1)
Call InitSviluppoIntegrale(aNum,nSorte)
Do While GetCombSviluppo(aCol)
sKey = "k" & StringaNumeri(aCol,,True)
If GetItemCollection(CollComb,sKey,cComb) Then
cComb.IncrementaFrequenze
Else
Set cComb = New clsCombinazione
cComb.Classe = nSorte
cComb.SetNumeri(aCol)
cComb.key = sKey
cComb.IncrementaFrequenze
Call AddItemColl(CollComb,cComb,sKey)
End If
Loop
Next
Call AvanzamentoElab(Inizio,Fine,k)
Next
Call AvanzamentoElab(Inizio,Fine,Inizio)
' ordino la collection contenente tutte le combinazioni di classe <nSorte> per il valore frequenza
Call OrdinaItemCollection(CollComb,"Frequenze","Key")
' da ognuna delle combinazioni base scasturirà una lunghetta quindi ciclo su tutte
' le combinazioni base presenti nella collection e per ciascuna costruirò una lunghetta
nDaFare = CollComb.count
nFatte = 0
For Each cComb In CollComb
ReDim aRetCol(nClasse)
' ottiene la lunghetta "migliore" che contiene la combinazione base
If GetLung(cComb,aRetCol,nRetFrequenze,CollComb,Inizio,Fine,aRuote,nSorte,nClasse,abNumValidi) Then
' aggiungo la lunghetta trovata in una nuova collection
Set cLung = New clsCombinazione
cLung.Classe = nClasse
Call OrdinaMatrice(aRetCol,1)
cLung.SetNumeri(aRetCol)
sKey = "k" & StringaNumeri(aRetCol,,True)
Call cLung.CalcolaFrequenza(aRuote,nSorte,Inizio,Fine)
Call cLung.CalcolaPresenze(aRuote,nSorte,Inizio,Fine)
Call AddItemInColl(cLung,sKey,CollLung)
End If
nFatte = nFatte + 1
If nFatte Mod 10 = 0 Then
Call AvanzamentoElab(1,nDaFare,nFatte)
If ScriptInterrotto Then Exit For
DoEventsEx
End If
Next
' ordino la collection delle lunghette trovate per poi mostrarle in output
Call OrdinaItemCollection(CollLung,"Presenze")
Set GetCollLunghettaMigliori = CollLung
End Function
Sub AddItemInColl(cItem,sKey,Coll)
On Error Resume Next
Coll.Add cItem,sKey
If Err <> 0 Then Err.Clear
End Sub
Function GetLung(cComb,aRetCol,nRetPres,collComb,Inizio,Fine,aRuote,nSorte,nClasse,abNumValidi)
' a partire dalla combinazione base costruisce la lunghetta migliore (piu prolifica per presenze)
Dim nPos,n,nPresMax,nNum,nPresTmp,k,aNumBase
Dim aNumDaSvil,nQtNumDaSvil,aColDaPrendere,bFound
ReDim aBUsati(90)
Dim objSvil
Dim sKey
Dim cCombTmp
Dim nClasseSvilTmp
' inizializzo un nuovo motore di sviluppo
Set objSvil = GetMotoreSviluppoIntegrale
' leggo i numeri della combinazione base
aNumBase = cComb.ArrayNum
For k = 1 To cComb.Classe
aRetCol(k) = aNumBase(k)
aBUsati(aRetCol(k)) = True
Next
' faccio in clclo che dura fino a quando la lunghetta non arriva a contenere la quantità
' di numeri voluta
' la lunghetta parte con i numeri della combinazione base
' i numeri vengono aggiunti sviluppandoli con combinazioni di classe <nSorte>
' al termine del ciclo do sia avrà la combinazione migliore da aggiungere
' alla lunghetta base
' il giro continua finche la lunghetta non raggiunge la quantita di numeri voluti
nPos = cComb.Classe
Do While nPos < nClasse
' calcolo la classe per sviluppare le combinazioni da testare insieme ai numeri gia presenti
' nella lunghetta
' se possibile la classe di sviluppo è pari a <nSorte> senno viene calcolata e assume un valore inferiore
If nClasse - nPos >= nSorte Then
nClasseSvilTmp = nSorte
Else
nClasseSvilTmp = nClasse - nPos
End If
' predispongo la lunghetta per accogliere i numeri che otterremo dallo sviluppo
ReDim Preserve aRetCol(nPos + nClasseSvilTmp)
' individuo i numeri da sviluppare i quali devono avere la c aratteristica sia di essere usciti
' nelle estrazioni coinvolte dal range sia di non essere gia presenti nella lunghetta stessa
ReDim aNumDaSvil(90)
nQtNumDaSvil = 0
For n = 1 To 90
If Not(aBUsati(n)) Then
If abNumValidi(n) Then
nQtNumDaSvil = nQtNumDaSvil + 1
aNumDaSvil(nQtNumDaSvil) = n
End If
End If
Next
ReDim Preserve aNumDaSvil(nQtNumDaSvil)
' inizio a sviluppare le combinazioni da testare insieme ai numeri della lunghetta
ReDim aCol(nClasseSvilTmp)
bFound = False
Call objSvil.InitSviluppoIntegrale(aNumDaSvil,nClasseSvilTmp)
Do While objSvil.GetCombSviluppo(aCol)
' nelle opportune posizioni dell'array della lunghetta pongo i numeri della combinazione sviluppata
For k = 1 To nClasseSvilTmp
aRetCol(nPos + k) = aCol(k)
Next
' calcolo le presenze della lunghetta
nPresTmp = Presenze(aRetCol,Inizio,Fine,aRuote,nSorte)
' se le presenze calcolate sono >= a quelle gia inidviduate allora
' devo tenere traccia della combinazione da prendere per inserirla
' nella lunghetta all'uscita del ciclo
If nPresTmp >= nPresMax Then
aColDaPrendere = aCol
nPresMax = nPresTmp
bFound = True
End If
Loop
' se ho trovato una combinazione da poter inserire nella lunghetta
' procedo ad inserirla e tengo traccia della nuova dimensione (quantita dei numeri)
' della lunghetta
' se non ho trovato niente è inutile continuare esce
If bFound Then
For k = 1 To nClasseSvilTmp
aRetCol(nPos + k) = aColDaPrendere(k)
aBUsati(aColDaPrendere(k)) = True
Next
nPos = nPos + nClasseSvilTmp
Else
Exit Do
End If
Loop
' se la lunghetta ha raggiunto la dimesnione prevista la funzione torna true
If nPos = nClasse Then
GetLung = True
Else
GetLung = False
End If
End Function
Sub AlimentaNumValidi(aCol,Inizio,Fine,aRuote,abNumValidi)
' funzione usata per test non nello script
ReDim abNumValidi(90)
ReDim aNumRuota(5)
Dim idEstr,e,r
For idEstr = Inizio To Fine
For r = 1 To UBound(aRuote)
Call GetArrayNumeriRuota(idEstr,aRuote(r),aNumRuota)
If PuntiSuArray(aNumRuota,aCol) > 1 Then
For e = 1 To 5
abNumValidi(aNumRuota(e)) = True
Next
End If
Next
Next
End Sub
Function Presenze(aColDaSvilTmp,Inizio,Fine,aRuote,Sorte)
' calcola le presenze di una lunghetta
Dim k,r,e,nPunti,aNumRuota,nPresenze
Dim aB
nPresenze = 0
aB = ArrayNumeriToBool(aColDaSvilTmp)
For k = Inizio To Fine
For r = 1 To UBound(aRuote)
Call GetArrayNumeriRuota(k,aRuote(r),aNumRuota)
nPunti = 0
For e = 1 To 5
If aB(aNumRuota(e)) Then
nPunti = nPunti + 1
End If
Next
If nPunti >= Sorte Then
nPresenze = nPresenze + 1
End If
Next
Next
Presenze = nPresenze
End FunctionOption Explicit
Class clsCombinazione
Private aNum
Private aBNum
Private mFrequenze
Private mPresenze
Private mClasse
Private mKey
Private aIdEstr
Private nTrov
Private Sub Class_Initialize()
mFrequenze = 0
mPresenze = 0
ReDim aBnum(90)
End Sub
Public Property Get Classe
Classe = mClasse
End Property
Public Property Let Classe(v)
mClasse = v
End Property
Public Property Get ArrayNum
ArrayNum = aNum
End Property
Public Property Get Key
Key = mKey
End Property
Public Property Let Key(v)
mKey = v
End Property
Public Property Get Presenze
Presenze = mPresenze
End Property
Public Property Get Frequenze
Frequenze = mFrequenze
End Property
Public Property Get Combinazione
Combinazione = StringaNumeri(aNum,,True)
End Property
Sub IncrementaFrequenze
mFrequenze = mFrequenze + 1
End Sub
Sub SetNumeri(aNumTmp)
Dim k
aNum = aNumTmp
For k = 1 To UBound(aNum)
aBNum(aNum(k)) = True
Next
End Sub
Sub CalcolaFrequenza(aRuote,nSorte,nIni,nFin)
mFrequenze = SerieFreqTurbo(nIni,nFin,aNum,aRuote,nSorte)
End Sub
Sub CalcolaPresenze(aRuote,nSorte,Inizio,Fine)
Dim k,r,e,nPunti,aNumRuota,nPresenze
Dim aB
nPresenze = 0
For k = Inizio To Fine
For r = 1 To UBound(aRuote)
Call GetArrayNumeriRuota(k,aRuote(r),aNumRuota)
nPunti = 0
For e = 1 To 5
If aBNum(aNumRuota(e)) Then
nPunti = nPunti + 1
End If
Next
If nPunti >= nSorte Then
nPresenze = nPresenze + 1
End If
Next
Next
mPresenze = nPresenze
End Sub
Sub AddIdEstr(v)
nTrov = nTrov + 1
ReDim Preserve aIdEstr(nTrov)
aIdEstr(nTrov) = v
End Sub
End Class
Private aEstrattiBool
Sub Main
Dim nEstrDaUSare,nClasse,nSorte,CollLunghette,nIni,nFin, k
nEstrDaUSare = 18
nClasse = 7
nSorte = 2
' ReDim aRuote(10)
' For k = 1 To 10
' aRuote (k) = k
' Next
ReDim aRuote(1)
aRuote(1) = FI_
nIni =(EstrazioneFin - nEstrDaUSare) + 1
nFin = EstrazioneFin
Set CollLunghette = GetCollLunghettaMigliori(nIni,nFin,nClasse,nSorte,aRuote,nEstrDaUSare)
Call AlimentaTabOutput(CollLunghette,aRuote,nClasse,nSorte)
MsgBox TempoTrascorso
End Sub
Sub AlimentaTabOutput(CollLunghette,aRuote,nClasse,nSorte)
Dim av,cLung
Scrivi "Ruote : " & StringaRuote(aRuote)
Scrivi "Classe : " & nClasse
Scrivi "Sorte : " & nSorte
av = Array("","Lunghetta","Frequenza","Presenza")
Call InitTabella(av)
For Each cLung In CollLunghette
av(1) = cLung.Combinazione
av(2) = cLung.Frequenze
av(3) = cLung.Presenze
Call AddRigaTabella(av)
Next
Call CreaTabella
End Sub
Function GetCollLunghettaMigliori(Inizio,Fine,nClasse,nSorte,aRuote ,nEstrUsate)
Dim CollComb,cComb
Dim CollLung,cLung
Dim k,j,e
Dim nFatte,nDaFare
Dim nRetFrequenze
Dim sKey
ReDim aCol(nSorte)
ReDim abNumValidi(90)
ReDim aEstrattiBool (nEstrUsate , 12 , 90)
Call AlimentaArrayEstrattiBool( aEstrattiBool , Inizio , Fine , aRuote )
Set CollComb = GetNewCollection
Set CollLung = GetNewCollection
' alimento una collection con tutte le combinazioni di classe <nSorte> che si
' formano con le cinquine comprese nel range interessato
' di ogni singola combinazione si calcolano le frequenze
For k = Inizio To Fine
For j = 1 To UBound(aRuote)
ReDim aNum(0)
Call GetArrayNumeriRuota(k,aRuote(j),aNum)
For e = 1 To 5
abNumValidi(aNum(e)) = True
Next
Call OrdinaMatrice(aNum,1)
Call InitSviluppoIntegrale(aNum,nSorte)
Do While GetCombSviluppo(aCol)
sKey = "k" & StringaNumeri(aCol,,True)
If GetItemCollection(CollComb,sKey,cComb) Then
cComb.IncrementaFrequenze
Else
Set cComb = New clsCombinazione
cComb.Classe = nSorte
cComb.SetNumeri(aCol)
cComb.key = sKey
cComb.IncrementaFrequenze
Call AddItemColl(CollComb,cComb,sKey)
End If
Loop
Next
Call AvanzamentoElab(Inizio,Fine,k)
Next
Call AvanzamentoElab(Inizio,Fine,Inizio)
' ordino la collection contenente tutte le combinazioni di classe <nSorte> per il valore frequenza
Call OrdinaItemCollection(CollComb,"Frequenze","Key")
' da ognuna delle combinazioni base scasturirà una lunghetta quindi ciclo su tutte
' le combinazioni base presenti nella collection e per ciascuna costruirò una lunghetta
nDaFare = CollComb.count
nFatte = 0
For Each cComb In CollComb
ReDim aRetCol(nClasse)
' ottiene la lunghetta "migliore" che contiene la combinazione base
If GetLung(cComb ,aRetCol,nRetFrequenze,CollComb,Inizio,Fine,aRuote,nSorte,nClasse,abNumValidi ,nEstrUsate ) Then
' aggiungo la lunghetta trovata in una nuova collection
Set cLung = New clsCombinazione
cLung.Classe = nClasse
Call OrdinaMatrice(aRetCol,1)
cLung.SetNumeri(aRetCol)
sKey = "k" & StringaNumeri(aRetCol,,True)
Call cLung.CalcolaFrequenza(aRuote,nSorte,Inizio,Fine)
Call cLung.CalcolaPresenze(aRuote,nSorte,Inizio,Fine)
Call AddItemInColl(cLung,sKey,CollLung)
End If
nFatte = nFatte + 1
If nFatte Mod 10 = 0 Then
Call AvanzamentoElab(1,nDaFare,nFatte)
If ScriptInterrotto Then Exit For
DoEventsEx
End If
Next
' ordino la collection delle lunghette trovate per poi mostrarle in output
Call OrdinaItemCollection(CollLung,"Presenze")
Set GetCollLunghettaMigliori = CollLung
End Function
Sub AlimentaArrayEstrattiBool( aEstrattiBool , Inizio , Fine , aRuote )
Dim idEstr , i , r , e
ReDim aNum(5)
For idEstr = Inizio To Fine
i = i +1
For r = 1 To UBound (aRuote)
Call GetArrayNumeriRuota ( idEstr , aRuote(r) , aNum )
For e = 1 To 5
aEstrattiBool(i , aRuote(r) , aNum (e)) = True
Next
Next
Next
End Sub
Sub AddItemInColl(cItem,sKey,Coll)
On Error Resume Next
Coll.Add cItem,sKey
If Err <> 0 Then Err.Clear
End Sub
Function GetLung(cComb,aRetCol,nRetPres,collComb,Inizio,Fine,aRuote,nSorte,nClasse,abNumValidi , nQtEstrUsate)
' a partire dalla combinazione base costruisce la lunghetta migliore (piu prolifica per presenze)
Dim nPos,n,nPresMax,nNum,nPresTmp,k,aNumBase
Dim aNumDaSvil,nQtNumDaSvil,aColDaPrendere,bFound
ReDim aBUsati(90)
Dim objSvil
Dim sKey
Dim cCombTmp
Dim nClasseSvilTmp
' inizializzo un nuovo motore di sviluppo
Set objSvil = GetMotoreSviluppoIntegrale
' leggo i numeri della combinazione base
aNumBase = cComb.ArrayNum
For k = 1 To cComb.Classe
aRetCol(k) = aNumBase(k)
aBUsati(aRetCol(k)) = True
Next
' faccio in clclo che dura fino a quando la lunghetta non arriva a contenere la quantità
' di numeri voluta
' la lunghetta parte con i numeri della combinazione base
' i numeri vengono aggiunti sviluppandoli con combinazioni di classe <nSorte>
' al termine del ciclo do sia avrà la combinazione migliore da aggiungere
' alla lunghetta base
' il giro continua finche la lunghetta non raggiunge la quantita di numeri voluti
nPos = cComb.Classe
Do While nPos < nClasse
' calcolo la classe per sviluppare le combinazioni da testare insieme ai numeri gia presenti
' nella lunghetta
' se possibile la classe di sviluppo è pari a <nSorte> senno viene calcolata e assume un valore inferiore
If nClasse - nPos >= nSorte Then
nClasseSvilTmp = nSorte
Else
nClasseSvilTmp = nClasse - nPos
End If
' predispongo la lunghetta per accogliere i numeri che otterremo dallo sviluppo
ReDim Preserve aRetCol(nPos + nClasseSvilTmp)
' individuo i numeri da sviluppare i quali devono avere la c aratteristica sia di essere usciti
' nelle estrazioni coinvolte dal range sia di non essere gia presenti nella lunghetta stessa
ReDim aNumDaSvil(90)
nQtNumDaSvil = 0
For n = 1 To 90
If Not(aBUsati(n)) Then
If abNumValidi(n) Then
nQtNumDaSvil = nQtNumDaSvil + 1
aNumDaSvil(nQtNumDaSvil) = n
End If
End If
Next
ReDim Preserve aNumDaSvil(nQtNumDaSvil)
' inizio a sviluppare le combinazioni da testare insieme ai numeri della lunghetta
ReDim aCol(nClasseSvilTmp)
bFound = False
Call objSvil.InitSviluppoIntegrale(aNumDaSvil,nClasseSvilTmp)
Do While objSvil.GetCombSviluppo(aCol)
' nelle opportune posizioni dell'array della lunghetta pongo i numeri della combinazione sviluppata
For k = 1 To nClasseSvilTmp
aRetCol(nPos + k) = aCol(k)
Next
' calcolo le presenze della lunghetta
nPresTmp = Presenze(aRetCol, nQtEstrUsate, UBound(aRetCol) ,aRuote,nSorte)
' se le presenze calcolate sono >= a quelle gia inidviduate allora
' devo tenere traccia della combinazione da prendere per inserirla
' nella lunghetta all'uscita del ciclo
If nPresTmp >= nPresMax Then
aColDaPrendere = aCol
nPresMax = nPresTmp
bFound = True
End If
Loop
' se ho trovato una combinazione da poter inserire nella lunghetta
' procedo ad inserirla e tengo traccia della nuova dimensione (quantita dei numeri)
' della lunghetta
' se non ho trovato niente è inutile continuare esce
If bFound Then
For k = 1 To nClasseSvilTmp
aRetCol(nPos + k) = aColDaPrendere(k)
aBUsati(aColDaPrendere(k)) = True
Next
nPos = nPos + nClasseSvilTmp
Else
Exit Do
End If
Loop
' se la lunghetta ha raggiunto la dimesnione prevista la funzione torna true
If nPos = nClasse Then
GetLung = True
Else
GetLung = False
End If
End Function
Sub AlimentaNumValidi(aCol,Inizio,Fine,aRuote,abNumValidi)
' funzione usata per test non nello script
ReDim abNumValidi(90)
ReDim aNumRuota(5)
Dim idEstr,e,r
For idEstr = Inizio To Fine
For r = 1 To UBound(aRuote)
Call GetArrayNumeriRuota(idEstr,aRuote(r),aNumRuota)
If PuntiSuArray(aNumRuota,aCol) > 1 Then
For e = 1 To 5
abNumValidi(aNumRuota(e)) = True
Next
End If
Next
Next
End Sub
Function Presenze(aColDaSvilTmp,nQtEstrUsate, nClasseLunghetta,aRuote,Sorte)
' calcola le presenze di una lunghetta
Dim k,r,e,nPunti,aNumRuota,nPresenze
' Dim aB
nPresenze = 0
' aB = ArrayNumeriToBool(aColDaSvilTmp)
For k = 1 To nQtEstrUsate
For r = 1 To UBound(aRuote)
' Call GetArrayNumeriRuota(k,aRuote(r),aNumRuota)
nPunti = 0
For e = 1 To nClasseLunghetta
If aEstrattiBool (k, aRuote(r),aColDaSvilTmp(e) ) Then
nPunti = nPunti + 1
End If
Next
If nPunti >= Sorte Then
nPresenze = nPresenze + 1
End If
Next
Next
Presenze = nPresenze
End Function
