Quante ruote su 10 hanno freq 0 per una determinata sorte in un determinato periodo?

lotto_tom75 · 24 Maggio 2015

Chiedo ai più esperti scripters di questo forum se siano in grado di realizzare uno script che appunto riesca ad estrapolare e mostrare in output quante ruote su 10 (o 11) hanno freq 0 per un determinata sorte in un determinato periodo.

Es. (del tutto fittizio) dando in pasto allo script un gruppo numerico del tipo 1.10.15.16.23.30.32.33.40.44.56.57.67.69.70.78.85. 88.89.90

lo script dovrebbe analizzare il tutto x T in terzine su ruote separate (e questo c'è già...)
ma poi riportare in output qualcosa di questo tipo:

x T su tutte separate dal 1871 al 23-5-2015

1.10.15 fq 0 su BA.CA.FI:RO
1.10.16 fq 0 su CA.MI.VE
1.10.23 fq 0 su GE.MI.NA.PA

ecc...

per tutti i terni generabili dalla 20ina dell'esempio...

Questo per poter poi eventualmente operare una scelta tra i terni maggiormente assenti o presenti sulle singole ruote separate.

Grazie per l'attenzione

Saluti e buona domenica a tutti/e

LuigiB · 24 Maggio 2015

ciao lottotom ... vedi se funziona

Codice:

Option Explicit
Class clsCombinazione
    Private aNum
    Private aRuote
    Private mFrequenza
    Private mSorte
    Private mFine,mInizio
    Public Property Get Frequenza
        Frequenza = mFrequenza
    End Property
    Public Property Get Sorte
        Sorte = mSorte
    End Property
    Public Property Get EstrazioneInizio
        EstrazioneInizio = mInizio
    End Property
    Public Property Get EstrazioneFine
        EstrazioneFine = mFine
    End Property
    Function GetNumeri()
        GetNumeri = aNum
    End Function
    Function GetRuote()
        GetRuote = aRuote
    End Function
    Function GetQuantitaRuote
        GetQuantitaRuote  = UBound(aRuote)
    End Function
    Sub AggiungiRuota(r)
        Dim i
        i = UBound(aRuote) + 1
        ReDim Preserve aRuote(i)
        aRuote(i) = r
    End Sub
    Function GetStringaRuote
        Dim k , s
        s = ""
        For k = 1 To UBound(aRuote)
            s = s & SiglaRuota (aRuote (k)) & "."
        Next
        GetStringaRuote = RimuoviLastChr( s , ".")
    End Function
    Sub SetDati(aN,aR,Sorte,Inizio,Fine)
        aNum = aN
        aRuote = aR
        mSorte = Sorte
        mInizio = Inizio
        mFine = Fine
    End Sub
    Sub CalcolaFrequenza(aN,aR,nSorte,EstrIni,EstrFin)
        aNum = aN
        aRuote = aR
        mSorte = nSorte
        mInizio = EstrIni
        mFine = EstrFin
        mFrequenza = SerieFreqTurbo(mInizio,mFine,aNum,aRuote,mSorte)
    End Sub
End Class
Sub Main
    Dim r,k
    Dim aNumeri,nNumSel,aCol,nColonneSvil
    ReDim aRuote(1)
    Dim nClasse,nSorte,nColonneTot
    Dim CollLunghette
    Dim clsComb
    Dim Inizio,Fine
    Dim mFreqMinima
    nClasse = 3
    nSorte = 3
    mFreqMinima = 0
    Inizio = EstrazioneIni
    Fine = EstrazioneFin
    Set CollLunghette = GetNewCollection
    nNumSel = ScegliNumeri(aNumeri)
    nColonneSvil = 0
    If nNumSel >= nClasse Then
        nColonneTot = InitSviluppoIntegrale(aNumeri,nClasse)
        ' ciclo che continua fiono a quando le colonne non finiscono
        Do While GetCombSviluppo(aCol)
            For r = 1 To 12
                If r <> 11 Then
                    aRuote(1) = r
                    Set clsComb = New clsCombinazione
                    Call clsComb.CalcolaFrequenza(aCol,aRuote,nSorte,Inizio,Fine)
                    If clsComb.Frequenza <= mFreqMinima Then
                        Call AddFormazioneTrovata(clsComb,CollLunghette)
                    End If
                End If
            Next
            nColonneSvil = nColonneSvil + 1
            If nColonneSvil Mod 100 = 0 Then
                Call AvanzamentoElab(0,nColonneTot,nColonneSvil)
                If ScriptInterrotto Then Exit Do
                Call DoEventsEx
            End If
        Loop
        Call AvanzamentoElab(0,nColonneTot,nColonneSvil)
        
        Scrivi "Analisi da "
        Scrivi "Inizio : " & GetInfoEstrazione(Inizio)
        Scrivi "Fine   : " & GetInfoEstrazione(Fine)
        Scrivi "Numeri : " & StringaNumeri (aNumeri)
        Scrivi "Sviluppo in classe " & nClasse
        Scrivi "Sorte " & NomeSorte(nSorte)
        Scrivi "Elenco delle combinazioni presenti con frequenza minore uguale a " & mFreqMinima
        Scrivi
        
        Dim aTitoli
        aTitoli = Array ("" ,"Combinazione" , "Q Ruote" , "Ruote")
        Call InitTabella ( aTitoli ,vbYellow)
        ReDim aValori (3)
        
        For Each clsComb In CollLunghette
            'Call Scrivi (StringaNumeri (clsComb.GetNumeri ,,True )   & " su " & clsComb.GetStringaRuote )
            aValori (1)=StringaNumeri (clsComb.GetNumeri ,,True )
            aValori(2) = clsComb.GetQuantitaRuote
            aValori(3) = clsComb.GetStringaRuote
            Call AddRigaTabella (aValori)
        Next
        
        Call CreaTabella ( 2)
    End If
End Sub
Sub AddFormazioneTrovata(clsComb,coll)
    Dim sKey
    Dim clsCombTmp
    sKey = "key" & StringaNumeri(clsComb.GetNumeri,".",True)
    Set clsCombTmp = GetItemColl(sKey,coll)
    If clsCombTmp Is Nothing Then
        Set clsCombTmp = New clsCombinazione
        Call clsCombTmp.SetDati(clsComb.GetNumeri,clsComb.GetRuote,clsComb.Sorte,clsComb.EstrazioneInizio,clsComb.EstrazioneFine)
        Call coll.Add(clsCombTmp,sKey)
    Else
        Dim aR
        aR = clsComb.GetRuote
        Call clsCombTmp.AggiungiRuota (aR(1) )
    End If
End Sub
Function GetItemColl(sKey,Coll)
    On Error Resume Next
    Set GetItemColl = Coll(sKey)
    If Err <> 0 Then
        Set GetItemColl = Nothing
        Err.Clear
    End If
End Function

lotto_tom75 · 25 Maggio 2015

LuigiB;n1888135 ha scritto:

ciao lottotom ... vedi se funziona

Codice:

Option Explicit
Class clsCombinazione
Private aNum
Private aRuote
Private mFrequenza
Private mSorte
Private mFine,mInizio
Public Property Get Frequenza
Frequenza = mFrequenza
End Property
Public Property Get Sorte
Sorte = mSorte
End Property
Public Property Get EstrazioneInizio
EstrazioneInizio = mInizio
End Property
Public Property Get EstrazioneFine
EstrazioneFine = mFine
End Property
Function GetNumeri()
GetNumeri = aNum
End Function
Function GetRuote()
GetRuote = aRuote
End Function
Function GetQuantitaRuote
GetQuantitaRuote = UBound(aRuote)
End Function
Sub AggiungiRuota(r)
Dim i
i = UBound(aRuote) + 1
ReDim Preserve aRuote(i)
aRuote(i) = r
End Sub
Function GetStringaRuote
Dim k , s
s = ""
For k = 1 To UBound(aRuote)
s = s & SiglaRuota (aRuote (k)) & "."
Next
GetStringaRuote = RimuoviLastChr( s , ".")
End Function
Sub SetDati(aN,aR,Sorte,Inizio,Fine)
aNum = aN
aRuote = aR
mSorte = Sorte
mInizio = Inizio
mFine = Fine
End Sub
Sub CalcolaFrequenza(aN,aR,nSorte,EstrIni,EstrFin)
aNum = aN
aRuote = aR
mSorte = nSorte
mInizio = EstrIni
mFine = EstrFin
mFrequenza = SerieFreqTurbo(mInizio,mFine,aNum,aRuote,mSorte)
End Sub
End Class
Sub Main
Dim r,k
Dim aNumeri,nNumSel,aCol,nColonneSvil
ReDim aRuote(1)
Dim nClasse,nSorte,nColonneTot
Dim CollLunghette
Dim clsComb
Dim Inizio,Fine
Dim mFreqMinima
nClasse = 3
nSorte = 3
mFreqMinima = 0
Inizio = EstrazioneIni
Fine = EstrazioneFin
Set CollLunghette = GetNewCollection
nNumSel = ScegliNumeri(aNumeri)
nColonneSvil = 0
If nNumSel >= nClasse Then
nColonneTot = InitSviluppoIntegrale(aNumeri,nClasse)
' ciclo che continua fiono a quando le colonne non finiscono
Do While GetCombSviluppo(aCol)
For r = 1 To 12
If r <> 11 Then
aRuote(1) = r
Set clsComb = New clsCombinazione
Call clsComb.CalcolaFrequenza(aCol,aRuote,nSorte,Inizio,Fine)
If clsComb.Frequenza <= mFreqMinima Then
Call AddFormazioneTrovata(clsComb,CollLunghette)
End If
End If
Next
nColonneSvil = nColonneSvil + 1
If nColonneSvil Mod 100 = 0 Then
Call AvanzamentoElab(0,nColonneTot,nColonneSvil)
If ScriptInterrotto Then Exit Do
Call DoEventsEx
End If
Loop
Call AvanzamentoElab(0,nColonneTot,nColonneSvil)

Scrivi "Analisi da "
Scrivi "Inizio : " & GetInfoEstrazione(Inizio)
Scrivi "Fine : " & GetInfoEstrazione(Fine)
Scrivi "Numeri : " & StringaNumeri (aNumeri)
Scrivi "Sviluppo in classe " & nClasse
Scrivi "Sorte " & NomeSorte(nSorte)
Scrivi "Elenco delle combinazioni presenti con frequenza minore uguale a " & mFreqMinima
Scrivi

Dim aTitoli
aTitoli = Array ("" ,"Combinazione" , "Q Ruote" , "Ruote")
Call InitTabella ( aTitoli ,vbYellow)
ReDim aValori (3)

For Each clsComb In CollLunghette
'Call Scrivi (StringaNumeri (clsComb.GetNumeri ,,True ) & " su " & clsComb.GetStringaRuote )
aValori (1)=StringaNumeri (clsComb.GetNumeri ,,True )
aValori(2) = clsComb.GetQuantitaRuote
aValori(3) = clsComb.GetStringaRuote
Call AddRigaTabella (aValori)
Next

Call CreaTabella ( 2)
End If
End Sub
Sub AddFormazioneTrovata(clsComb,coll)
Dim sKey
Dim clsCombTmp
sKey = "key" & StringaNumeri(clsComb.GetNumeri,".",True)
Set clsCombTmp = GetItemColl(sKey,coll)
If clsCombTmp Is Nothing Then
Set clsCombTmp = New clsCombinazione
Call clsCombTmp.SetDati(clsComb.GetNumeri,clsComb.GetRuote,clsComb.Sorte,clsComb.EstrazioneInizio,clsComb.EstrazioneFine)
Call coll.Add(clsCombTmp,sKey)
Else
Dim aR
aR = clsComb.GetRuote
Call clsCombTmp.AggiungiRuota (aR(1) )
End If
End Sub
Function GetItemColl(sKey,Coll)
On Error Resume Next
Set GetItemColl = Coll(sKey)
If Err <> 0 Then
Set GetItemColl = Nothing
Err.Clear
End If
End Function

Era esattamente quello che avevo in testa...

Semplicemente IRREALE... sei un GENIO!

[non mi stancherò mai di scriverlo...]

GRAZIE1000 (vedi anche allegato

)

i legend · 26 Maggio 2015

Da collezione,ecccccccccccccezzzzzionaleeeeeeeeeeeeeee, semplicemente,grazie

lotto_tom75 · 27 Maggio 2015

i legend;n1888710 ha scritto:
Da collezione,ecccccccccccccezzzzzionaleeeeeeeeeeeeeee, semplicemente,grazie

Davvero da collezione legend, il nostro Maestro si è superato ancora una volta!

Senti che ne dici di provare ad omaggiarlo cercando di individuare un terno a colpo su TUTTE partendo da una 20ina doc unendo le nostre forze e sfruttando al massimo questo nuovo fiammante script di Luigi? Ciao!

LuigiB · 27 Maggio 2015

ragazzi ringrazio .. pero piano con gli entusiasmi come dico sempre ... purtroppo vincere rimane una questien di K...
ciao

LuigiB · 27 Maggio 2015

ahhahah Tom lo sai che la tua tastiera personalizzara al tasto return non l'avevo ancora vista ...

lotto_tom75 · 29 Maggio 2015

LuigiB;n1888925 ha scritto:
ahhahah Tom lo sai che la tua tastiera personalizzara al tasto return non l'avevo ancora vista ...

Cerca

Cerca

Quante ruote su 10 hanno freq 0 per una determinata sorte in un determinato periodo?

lotto_tom75

Advanced Premium Member

LuigiB

Guest

lotto_tom75

Advanced Premium Member

Allegati

i legend

Premium Member

lotto_tom75

Advanced Premium Member

LuigiB

Guest

LuigiB

Guest

lotto_tom75

Advanced Premium Member

Ultima estrazione Lotto

Ultimi Messaggi