Domanda sugli script

[Bubblegum]

Ciao a tutti, è la prima volta che scrivo e spero di averlo fatto nella sezione giusta.
Vorrei chiedere ai maestri se è possibile che uno script ci possa indicare con la matematica sommatoria quella ambata che ha coperto tutti i mesi richiesti con la media colpi più bassa .
Con inputbox imposteremo l'indice mensile da scegliere , la ruota di gioco , i colpi di gioco ed il numero di mesi da verificare.
Utilizzando 2 estratti , un fisso ed i tre operatori +-x .
Esempio inventato :

Indice mensile - 3
Ruota gioco - Bari
Colpi - 13
Mesi - 12

5NA + 3MI x 23 , coperti 12 mesi su 12 con una media colpi 7

Una seconda domanda : uno script può ricavare , sempre con la matematica sommatoria e con la media colpi più bassa , 3 numeri per ambata ma che siano risultati vincenti ogni mese 2 ?
Esempio :

A) 2BA - 3FI x 33
B) 4CA x 1NA + 55
C) 5VE - 5TO x 19

La coppia AB ( non come ambo) ha coperto 5 mesi su 12 (gen,feb,mar,ago,dic)
La coppia AC ha coperto 4 mesi su 12 (apr,mag,lug,set)
La coppia BC ha coperto 3 mesi su 12 (giu,ott,nov)

Grazie alle vostre risposte capirò se posso richiedere un listato sempre che ne abbiate voglia,tempo ed interesse .

Ciao

 

[claudio8]

Gli script possono ricavare tutto quello che si desidera, nello storico.
Il problema è costruirlo il listato e sperare che la cosa ( algoritmo ipotizzato) si ripeta in futuro.
Resta in attesa sperando che qualcuno ti passi qualcosa di simile già costriuto o che sia disponibile a realizzarlo.
Comunque, ciò che tu chiedi è un costruttore di metodi .
Nell'attesa, guardati la sezione "Metodi" andando su -> "sommativi" del programmai Spaziometria.
ciao

 

[Bubblegum]

Grazie per la risposta Signor claudio8

 

[Cinzia27]

Ciao, Bubblegum.
Sto imbastendo uno script per le presenze nei mesi.
Non è proprio ciò che cerchi ma è un primo passo.
Cinzia

 

[Cinzia27]

Eccolo.

'Frequenze per mese in ogni ruota ( Cinzia)
Sub Main()
    Dim ru(1)
    For r = 1 To 10
        co = 0 :max = 0
        ru(1) = r
        For a = 1 To 90
            co = 0
            fin = EstrazioneFin
            ini = 1
            For es = ini To fin
                If Mese(es) = 1 Then ' metti mese
                    For p = 1 To 5
                        If a = Estratto(es,r,p) Then co = co + 1
                    Next
                End If
            Next
            Scrivi " " & SiglaRuota(r) & " " & " " & Format2(a) & " si è presentato " & co & " volte"
            If co > max Then max = co :nn = a:
        Next
        Scrivi
        Scrivi " Massima frequenza numero " & nn & " sortite " & max
        Scrivi
    Next
End Sub

 

[Bubblegum]

Mille grazie Signora Cinzia27, molto gentile .

 

[claudio8]

Non è ciò che cerchi ma, comincia con questo dei mesi ed anni di Luigi

'
'rileva x anno e mese freq rit,ecc.  sino a terno
Option Explicit
Sub Main
    Dim nTipoRicerca
    Dim nAnnoRicerca
    Dim nClasse
    Dim r,m
    Dim nRetRit,nRetRitMax,nRetFre,nStart,nEnd,nValore,nMaxRisultati,nCols
    ReDim aR(1)
    nTipoRicerca = TipoRicerca
    nAnnoRicerca = ScegliAnno
    nClasse = ScegliClasse
    nMaxRisultati = CInt(InputBox("Quanti elementi scegliere come primi della lista ? ","Quantita combinazioni",10))
    ReDim aNum(0)
    Call GetANumeriPerSvil(aNum)
    ReDim aCol(nClasse)
    If nAnnoRicerca = 0 Then Exit Sub
    If nMaxRisultati <= 0 Then Exit Sub
    Dim aTitoli
    aTitoli = Array("","Ruota","Mese","Numeri","Ritardo","RitardoMax","Frequenza")
    Call InitTabella(aTitoli)
    For m = 1 To 12
        If GetLimitiMese(m,nAnnoRicerca,nStart,nEnd) Then
            For r = 1 To 12
                If r <> 11 Then
                    ReDim aValMax(nMaxRisultati,3)
                    aR(1) = r
                    nCols = 0
                    Call InitSviluppoIntegrale(aNum,nClasse)
                    Do Until GetCombSviluppo(aCol) = False
                        Call StatisticaFormazioneTurbo(aCol,aR,nClasse,nRetRit,nRetRitMax,0,nRetFre,nStart,nEnd)
                        If nTipoRicerca = 0 Then
                            nValore = nRetRit
                            Call AggiungiAValoriMax(aCol,nValore,aValMax,nRetRit,nRetRitMax,nRetFre,nMaxRisultati,1)
                        ElseIf nTipoRicerca = 1 Then
                            nValore = nRetRitMax
                            Call AggiungiAValoriMax(aCol,nValore,aValMax,nRetRit,nRetRitMax,nRetFre,nMaxRisultati,2)
                        ElseIf nTipoRicerca = 2 Then
                            nValore = nRetFre
                            Call AggiungiAValoriMax(aCol,nValore,aValMax,nRetRit,nRetRitMax,nRetFre,nMaxRisultati,3)
                        End If
                        nCols = nCols + 1
                        If nCols Mod 100 = 0 Then
                            Messaggio("Analizzate colonne : " & nCols)
                            If ScriptInterrotto Then Exit Do
                        End If
                    Loop
                    Call AggiungiRigheTabella(aValMax,nMaxRisultati,NomeRuota(r),MeseNome(m),nTipoRicerca + 4)
                End If
            Next
        End If
        Call AvanzamentoElab(1,12,m)
        If ScriptInterrotto Then Exit For
    Next
    Call CreaTabella
End Sub
Function ScegliAnno()
    Dim nA,nB,nAnno
    nA = Anno(1)
    nB = Anno(EstrazioniArchivio)
    nAnno = CInt(InputBox("Inserire un anno da " & nA & " a " & nB,"Scelta anno",nA))
    If nAnno >= nA And nAnno <= nB Then
        ScegliAnno = nAnno
    Else
        ScegliAnno = 0
    End If
End Function
Function TipoRicerca()
    Dim aV
    aV = Array("Ritardo","RitardoMax","Frequenza")
    TipoRicerca = ScegliOpzioneMenu(aV,2)
End Function
Function ScegliClasse()
    Dim aV
    aV = Array("Estratto","Ambo","Terno")
    ScegliClasse = ScegliOpzioneMenu(aV,0) + 1
End Function
Function GetLimitiMese(nMese,nAnno,nRetIni,nRetFi)
    Dim g,id
    nRetIni = 0
    nRetFi = 0
    Do
        g = g + 1
        id = DataEstrToIdEstr(g,nMese,nAnno)
    Loop While id = 0 And g <= 30
    If id > 0 Then nRetIni = id
    g = 32
    Do
        g = g - 1
        id = DataEstrToIdEstr(g,nMese,nAnno)
    Loop While id = 0 And g > 0
    If id > 0 Then nRetFi = id
    If nRetIni And nRetFi > 0 Then
        GetLimitiMese = True
    Else
        GetLimitiMese = False
    End If
End Function
Sub AggiungiAValoriMax(aCol,nValore,aValMax,nRit,nRitMax,nFre,nMaxElementi,nIdValue)
    Dim k,j
    For k = 1 To nMaxElementi
        If nValore >= aValMax(k,nIdValue) Then
            For j = nMaxElementi To k + 1 Step - 1
                aValMax(j,0) = aValMax(j - 1,0)
                aValMax(j,1) = aValMax(j - 1,1)
                aValMax(j,2) = aValMax(j - 1,2)
                aValMax(j,3) = aValMax(j - 1,3)
            Next
            aValMax(k,0) = StringaNumeri(aCol)
            aValMax(k,1) = nRit
            aValMax(k,2) = nRitMax
            aValMax(k,3) = nFre
            Exit For
        End If
    Next
End Sub
Sub AggiungiRigheTabella(aValMax,nMaxRisultati,sRuota,sMese,nIdColValore)
    ReDim aV(7)
    Dim k,j
    ReDim aColori(7)
    For k = 0 To 7
        aColori(k) = vbBlack
    Next
    aColori(nIdColValore) = vbRed
    For k = 1 To nMaxRisultati
        aV(1) = sRuota
        aV(2) = sMese
        For j = 0 To 3
            aV(j + 3) = aValMax(k,j)
        Next
        Call AddRigaTabella(aV,,,,aColori)
    Next
End Sub
Sub GetANumeriPerSvil(aNum)
    Dim k
    ReDim aNum(90)
    For k = 1 To 90
        aNum(k) = k
    Next
End Sub

Un saluto

 

[claudio8]

Anche questo di Luigi, se hai una fissa del mese o qualsiasi , ti cerca degli abbinamenti...l'avessi ricordato prima avrei potuto azzeccare un ambo con il 66-47 su Ba con definizione mese "tutti" ...
attenzione... nella prima richiesta di numeri inseriscili tutti ( INV SEL) ad esclusione della fissa o fisse, se la classe è maggiore di 2, che inserirai nel secondo quadrante Scegli numeri. Ti consiglio di usare la freq. ( non ti aspettare che i + frequenti siano i + probabili... se ipoteticamente fosse così probabilmente si ripeterebbero sempre gli stessi numeri.

Option Explicit
Class ClsCombinazione
    Private aNumeri
    Private aRuote
    Private m_ritardo
    Private m_frequenza
    Private m_ritardoMax
    Private m_sorte
    Private m_EstrIni
    Private m_EstrFin
    Public Property Get Ruote
        Ruote = aRuote
    End Property
    Public Property Get Sorte
        Sorte = m_sorte
    End Property
    Public Property Get EstrIni
        EstrIni = m_EstrIni
    End Property
    Public Property Get EstrFin
        EstrFin = m_EstrFin
    End Property
    Public Property Get Ritardo
        Ritardo = m_ritardo
    End Property
    Public Property Get Frequenza
        Frequenza = m_frequenza
    End Property
    Public Property Get RitardoMax
        RitardoMax = m_ritardoMax
    End Property
    Sub EseguiStat(vNumeri,vRuote,Sorte,Inizio,Fine)
        Dim nColTot,r
        ReDim aR(1)
        aNumeri = vNumeri
        aRuote = vRuote
        m_sorte = Sorte
        m_EstrIni = Inizio
        m_EstrFin = Fine
        m_ritardo = 0
        m_frequenza = 0
        m_ritardoMax = 0
        Call StatisticaFormazioneTurbo(aNumeri,aRuote,m_sorte,m_ritardo,m_ritardoMax,0,m_frequenza,m_EstrIni,m_EstrFin)
    End Sub
    Function StringaNum
        StringaNum = StringaNumeri(aNumeri)
    End Function
End Class
Sub Main
    Dim nQNum,nQFissi,nSorte,Inizio,Fine,nFisso,idMese,nEstrAna
    Dim Coll,clsCmb
    Dim R,j
    Dim idTipoRic
    ReDim aNumeri(0)
    ReDim aFissi(0)
    ReDim aVTable(11)
    ReDim abMesi(12)
    Dim aVTipoRic
    Dim nClasse
    nClasse = Int(InputBox("Sviluppa lunghette classe",,"2"))
    nQFissi = 0
    aVTipoRic = Array("Frequenza","Ritardo","RitardoMax")
    idMese = ScegliMese
    abMesi(idMese) = True
    'nFisso = Sceglifisso
    aVTable(1) = "Ruota "
    ResetTimer
    For R = 2 To 11
        aVTable(R) = "A" & R - 1 & Space(15)
    Next
    Call InitTabella(aVTable)
    Inizio = 9000'EstrazioneIni
    Fine = EstrazioneFin
    nQNum = ScegliNumeri(aNumeri)
    If MsgBox("Scegliere i numeri fissi ?",vbQuestion + vbYesNo) = vbYes Then
        nQFissi = ScegliNumeri(aFissi)
    End If
    If NumeriRipetutiTraVett(aNumeri,aFissi) Then
        MsgBox "Numeri ripetuti tra fissi e variabili"
        Exit Sub
    End If
    nSorte = ScegliEsito(2)
    idTipoRic = ScegliTipoRicerca
    nEstrAna = AttivaEstrazioni(Inizio,Fine,abMesi)
    For R = 1 To 12
        'If R <> 11 Then
        aVTable(1) = NomeRuota(R)
        Call Messaggio(aVTable(1))
        Set Coll = GetNewCollection
        Call EseguiStatistica(aFissi,aNumeri,R,nClasse,nSorte,Inizio,Fine,Coll)
        Call OrdinaItemCollection(Coll,aVTipoRic(idTipoRic))
        'For j = 2 To 11
        For j = 2 To Coll.count + 1
            If j > 11 Then Exit For
            Set clsCmb = Coll(j - 1)
            If aVTipoRic(idTipoRic) = "Frequenza" Then
                aVTable(j) = clsCmb.StringaNum & " (" & "<font color='RED'>" & clsCmb.Frequenza & "</font>)"
            ElseIf aVTipoRic(idTipoRic) = "Ritardo" Then
                aVTable(j) = clsCmb.StringaNum & " (" & "<font color='RED'>" & clsCmb.Ritardo & "</font>)"
            ElseIf aVTipoRic(idTipoRic) = "RitardoMax" Then
                aVTable(j) = clsCmb.StringaNum & " (" & "<font color='RED'>" & clsCmb.RitardoMax & "</font>)"
            End If
        Next
        Call AddRigaTabella(aVTable)
        'End If
    Next
    SetTableWidth("100%")
    Call Scrivi("Range analizzato : " & GetInfoEstrazione(Inizio) & " - " & GetInfoEstrazione(Fine))
    Call Scrivi("Numero fissi : " & Iif(nQFissi = 0,"Nessuno",StringaNumeri(aFissi)))
    Call Scrivi("Mese analizzato : " & Iif(idMese = 0,"Tutti",MeseNome(idMese)))
    Call Scrivi("Estrazioni tot, : " & nEstrAna)
    Call Scrivi(String(100,"-"))
    Call CreaTabella
    Scrivi "Tempo di Elaborazione : " & TempoTrascorso,1
End Sub
Sub EseguiStatistica(aFissi,vNumeri,nRuota,Classe,Sorte,Inizio,Fine,CollDest)
    Dim nColTot,nFatte
    Dim cComb
    ReDim aR(1)
    aR(1) = nRuota
    If aFissi(1) > 0 Then
        nColTot = InitSviluppoIntegrale(vNumeri,Classe,aFissi)
    Else
        nColTot = InitSviluppoIntegrale(vNumeri,Classe)
    End If
    ReDim aCol(0)
    nFatte = 0
    Do While GetCombSviluppo(aCol)
        Set cComb = New ClsCombinazione
        Call cComb.EseguiStat(aCol,aR,Sorte,Inizio,Fine)
        CollDest.Add cComb
        nFatte = nFatte + 1
        Call AvanzamentoElab(1,nColTot,nFatte)
        If ScriptInterrotto Then Exit Do
    Loop
End Sub
Private Function MeseValido(idEstr,aMesi)
    If aMesi(0) Then
        MeseValido = True
    Else
        MeseValido = aMesi(Mese(idEstr))
    End If
End Function
Private Function AttivaEstrazioni(Inizio,fine,aMesi)
    Dim k
    Dim nValide,b
    nValide = 0
    For k = Inizio To fine
        b = MeseValido(k,aMesi)
        Call ImpostaEstrazione(k,CBool(b))
        If b Then
            nValide = nValide + 1
        End If
    Next
    AttivaEstrazioni = nValide
End Function
Function ScegliMese
    Dim aV
    aV = Array("Tutti","Gen","Feb","Mar","Apr","Mag","Giu","Lug","Ago","Set","Ott","Nov","Dic")
    ScegliMese = ScegliOpzioneMenu(aV,0)
End Function
Function Sceglifisso
    ReDim aV(90)
    Dim k
    aV(0) = "Nessun fisso"
    For k = 1 To 90
        aV(k) = k
    Next
    Sceglifisso = ScegliOpzioneMenu(aV,0)
End Function
Function ScegliTipoRicerca
    Dim aV
    aV = Array("Frequenza","Ritardo","RitardoMax")
    ScegliTipoRicerca = ScegliOpzioneMenu(aV,0)
End Function
Function NumeriRipetutiTraVett(aNumeri,aFissi)
    Dim ab,k,nRip
    nRip = 0
    ab = ArrayNumeriToBool(aFissi)
    'sca
    For k = 1 To UBound(aNumeri)
        If ab(aNumeri(k)) Then
            nRip = nRip + 1
        End If
    Next
    NumeriRipetutiTraVett = nRip
End Function

Buon divertimento
Claudio

 

[Bubblegum]

Grazie , due ottimi script ! Gentilissimo Claudio ,buona giornata .