Per dirla alla "Austin Powers" sarebbe...

i legend · 6 Dicembre 2015

script di esempio

Codice:

Option Explicit
Sub Main
    ReDim aNumVirt(0)
    Dim sNumReal
    Dim sFile,Conc,Dist
    sFile = "SVP D(7) ConFissi [3950]_P1 "
    Conc = GetValoreFraSeparatori(sFile,"[","]")
    Dist = GetValoreFraSeparatori(sFile,"(",")")
    ScegliNumeri(aNumVirt)
    Call TrasformaArrayNumVirToNumReal(sFile,Conc,Dist,aNumVirt,sNumReal)
    Scrivi sNumReal
End Sub
Sub TrasformaArrayNumVirToNumReal(sFile,Conc,Dist,aNumVirt,sNumReal)
    Dim k
    For k = 1 To UBound(aNumVirt)
        sNumReal = sNumReal & Format2(NumVirtToNumReale(aNumVirt(k),True,Conc,Dist)) & "."
    Next
    sNumReal = RimuoviLastChr(sNumReal,".")
End Sub
Function GetValoreFraSeparatori(sFile,CharSep1,CharSep2)
    Dim k
    Dim i,f,sVal
    i = InStr(1,sFile,CharSep1) + 1
    f = InStr(i,sFile,CharSep2)
    GetValoreFraSeparatori = Int(Mid(sFile,i,f - i))
End Function

Io il regalo lo sto ricevendo da un bel po'
Grazie

Visto Il Video
se non ti stimassi , ma proprio tanto , quante te ne direi,Ma proprio TANTE

LuigiB · 6 Dicembre 2015

ahahha .. vedi che vuol dire godere della stima delle persone

... comunque i miei metodi funzionano ... hai fatto benissimo c'è solo un malinteso sull'idestrazione e un piccolo accorgimento da prendere nella funzione che trasforma i numeri
quel numero tra parentesi quadre è l'estrazione di partenza dell'archivio non ci serve. L'id che ci serve a noi è quello dell'estrazione alla quale termina la statistica mFine in pratica ..
invece la sub che ti trasorma i numeri se la lanci due volte ti concatena pure i numeri di prima , la prima cosa da fare in quella sub sarebbe svuotare sNumReal porlo ufuale a "" ... comunque non usare una sub ma una function che tornera lei la stringa non una variabile dei parametri.

Benissimo l'impostazione c'è .
Ora avevamo detto di mettere due variabili nella main bPrimaEstrFissa , nDistanza
queste due variabili valorizzale dopo che l'utente ha selezionato ul file dell'archivio ,proprio come avevamo gia detto se non seleziona uno dei 25 archivi virtuali devi impostarle a false e a 0.
Poi te le porti appresso in tutte e tre le funzioni che fanno la verifica delle condizioni aggiungendo altri due parametri a ciascuna.

dentro le tre funzioni di verifica se il valore ndistanza è diverso da 0 invocherai un nuovo metodo della classeche non è niente altro la funzione che hai gia scritto che serve a trasformare i numeri , gli passi i parametri che servono alcuni li hai ricevuti bPrimaEstrFissa , nDistanza altri la classe li sa gia mFine e i numeri ..con questa nuova funzione ottieni i numeri reali da scrivere a video inseme alla stringa dei virtuali

sper sia tutto chiaro

i legend · 6 Dicembre 2015

ciao ecco il nuovo script

Codice:

Option Explicit
Class clsLunghetta
    Private aNumeri ' contiene i numeri della lunghetta
    Private mInizio,mFine,aRuote,mSorte ' parametri per il range analisi
    Private mClasse ' contine la classe della lunghetta
    Private aElencoRit ' conterra l'elenco dei ritardi per la lunghetta
    Private aIdEstrElencoRit ' conterra l'elenco dei ritardi per la lunghetta
    Private aElencoIncrRitMax ' contiene l'elnco degli incrementi del ritardo max
    Private aIdEstrIncrRitMax ' conterra l'elenco degli id estrazione in
    ' cui si è registrato l'incremento del ritmax conosciuto
    Private aRitardiAllIncremento ' contiene il valore del ritardo all'idestrazione in cui
    ' si è verificato l'incremento
    Private mRitardo,mRitardoMax,mIncrRitMax,mFrequenza ' valori statistici
    Private mIncrRitardoMaxSto,mStrIncRitSto
    Private mDist,mbPrimaEstrFissa
    Public Property Get iNumIncrementi
        iNumIncrementi = UBound(aElencoIncrRitMax)
    End Property
    Public Property Get IncrRitMaxSto
        IncrRitMaxSto = mIncrRitardoMaxSto
    End Property
    Public Property Get strIncRitMaxSto
        strIncRitMaxSto = mStrIncRitSto
    End Property
    Public Property Get Ritardo
        Ritardo = mRitardo
    End Property
    Public Property Get RitardoMax
        RitardoMax = mRitardoMax
    End Property
    Public Property Get IncrRitMax
        IncrRitMax = mIncrRitMax
    End Property
    Public Property Get Frequenza
        Frequenza = mFrequenza
    End Property
    Public Property Get LunghettaString
        LunghettaString = StringaNumeri(aNumeri)
    End Property
    Public Property Get sNumReal
        sNumReal = TrasformaArrayNumVirToNumReal(mDist,mbPrimaEstrFissa)
    End Property
    ' inizializza le proprietà dell'oggetto
    Sub Init(sLunghetta,sChrSep,RangeInizio,RangeFine,vetRuote,SorteInGioco)
        ' acquisisco i parametri per l'analisi
        mInizio = RangeInizio
        mFine = RangeFine
        aRuote = vetRuote
        mSorte = SorteInGioco
        ' alimento il vettore con i numeri della lunghetta
        Call AlimentaVettoreLunghetta(sLunghetta,sChrSep)
        ' calcolo l'elenco dei ritardi
        Call ElencoRitardiTurbo(aNumeri,aRuote,mSorte,mInizio,mFine,aElencoRit,aIdEstrElencoRit)
        ' alimento il vettore che contien l'elenco degli incrementi rit max
        Call AlimentaVettoreIncrRitMax
    End Sub
    ' esegue il calcolo dei valori statistici della lunghetta
    Sub EseguiStatistica
        Call StatisticaFormazioneTurbo(aNumeri,aRuote,mSorte,mRitardo,mRitardoMax,mIncrRitMax,mFrequenza,mInizio,mFine)
    End Sub
    Private Sub AlimentaVettoreLunghetta(sLunghetta,sChrSep)
        Dim k
        If IsArray(sLunghetta) Then
            ' se la lunghetta è gia un array lo copio nel vettore locale dei numeri
            ReDim aNumeri(UBound(sLunghetta))
            For k = 1 To UBound(sLunghetta)
                aNumeri(k) = sLunghetta(k)
            Next
        Else
            ' antepongo un carattere separatore per fare in modo che
            ' aNumeri si valorizzi dall'indice 1 (senno si sarebeb valorizzato dall'indice 0)
            Call SplitByChar((sChrSep & sLunghetta),sChrSep,aNumeri)
        End If
        ' valorizzo la classe della lunghetta
        mClasse = UBound(aNumeri)
    End Sub
    Private Sub AlimentaVettoreIncrRitMax
        Dim nRitMax,nIncr,nId,k
        nId = 0
        ' inizializzo il vettore a 0 elementi
        ReDim aElencoIncrRitMax(0)
        ReDim aIdEstrIncrRitMax(0)
        ReDim aRitardiAllIncremento(0)
        ' ciclo sul vettore dei ritardi
        For k = 1 To UBound(aElencoRit)
            ' se il ritardo corrente supera il ritmax attuale..
            If aElencoRit(k) > nRitMax Then
                If nRitMax > 0 Then
                    ' se il ritmax attuale è >0 (ivvero ne esiste uno)
                    ' calcolo di quanto si è incrementato
                    nIncr = aElencoRit(k) - nRitMax
                    ' incremento il contatore dei valori trovati
                    nId = nId + 1
                    ' ridimensiono il vettore mantenendo i valori precedenti ma
                    ' aggiungendone uno
                    ReDim Preserve aElencoIncrRitMax(nId)
                    ' memorizzo il valore
                    aElencoIncrRitMax(nId) = nIncr
                    ' ridimensiono il vettore mantnendo i valori precedenti ma
                    ' aggiungendone uno
                    ReDim Preserve aIdEstrIncrRitMax(nId)
                    ' memorizzo l'id dell'estrazione dove si è avuto l'incremento
                    aIdEstrIncrRitMax(nId) = aIdEstrElencoRit(k)
                    ' ridimensiono il vettore mantnendo i valori precedenti ma
                    ' aggiungendone uno
                    ReDim Preserve aRitardiAllIncremento(nId)
                    ' memorizzo il valore del ritardo all'id dell'estrazione dove si è avuto l'incremento
                    aRitardiAllIncremento(nId) = aElencoRit(k)
                End If
                nRitMax = aElencoRit(k)
            End If
        Next
        mStrIncRitSto = StringaNumeri(aElencoIncrRitMax,,True)
    End Sub
    Function IsCondizioneRispettata(nIdFiltro,nQIncr)
        ' verifica che l'incremento dell'ultimo ritmax sia uguale al massimo incr rit max conosciuto.
        Dim nUpper
        nUpper = UBound(aElencoIncrRitMax)
        mIncrRitardoMaxSto = MassimoV(aElencoIncrRitMax,1,nUpper - 1)
        If aElencoRit(UBound(aElencoRit)) > 0 And aIdEstrIncrRitMax(nUpper) = mFine And nUpper >= nQIncr Then
            Select Case nIdFiltro
            Case 0
                IsCondizioneRispettata =(aElencoIncrRitMax(nUpper) = mIncrRitardoMaxSto)
            Case 1
                IsCondizioneRispettata =(aElencoIncrRitMax(nUpper) >= mIncrRitardoMaxSto)
            Case 2
                IsCondizioneRispettata =(aElencoIncrRitMax(nUpper) <= mIncrRitardoMaxSto)
            End Select
        Else
            IsCondizioneRispettata = False
        End If
    End Function
    Function TrasformaArrayNumVirToNumReal(iDist,bPrimaEstrFiss)
        Dim k
        Dim sNumreal
        mDist = iDist
        mbPrimaEstrFissa = bPrimaEstrFiss
        sNumreal = ""
        For k = 1 To UBound(aNumeri)
            sNumreal = sNumreal & Format2(NumVirtToNumReale(aNumeri(k),mbPrimaEstrFissa,mFine,mDist)) & "."
        Next
        sNumreal = RimuoviLastChr(sNumreal,".")
        TrasformaArrayNumVirToNumReal = sNumreal
    End Function
    Sub DisegnaGraficoIncrRitMax
        Dim x,y,k
        Dim nValoreMaxX,nValoreMaxY,nValoreMinX
        Dim nStepX,nStepY
        Dim nUpperVetIncrRit
        nValoreMinX = MinimoV(aIdEstrIncrRitMax,1)
        nValoreMaxX = aIdEstrIncrRitMax(UBound(aIdEstrIncrRitMax))
        nValoreMaxY = MassimoV(aElencoRit,1)
        nStepX =(nValoreMaxX -(mInizio - 1)) \10
        nStepY = nValoreMaxY \10
        Call PreparaGrafico("Formaziione " & StringaNumeri(aNumeri),nValoreMinX,nValoreMaxX,0,nValoreMaxY,nStepX,nStepY)
        nUpperVetIncrRit = UBound(aElencoIncrRitMax)
        ' linea dell'incremento rit max
        ReDim aV(nUpperVetIncrRit - 1,2)
        For k = 1 To nUpperVetIncrRit
            x = aIdEstrIncrRitMax(k)
            y = aElencoIncrRitMax(k)
            aV(k - 1,1) = x
            aV(k - 1,2) = y
        Next
        Call DisegnaLineaGrafico(aV,vbRed,"IncrRitMax")
        ' linea dell' rit max
        ReDim aV(nUpperVetIncrRit - 1,2)
        For k = 1 To nUpperVetIncrRit
            x = aIdEstrIncrRitMax(k)
            y = aRitardiAllIncremento(k)
            aV(k - 1,1) = x
            aV(k - 1,2) = y
        Next
        Call DisegnaLineaGrafico(aV,vbBlue,"RitMax")
        ' scrive grafico nell'output
        Call InserisciGrafico
    End Sub
End Class
Sub Main
    Dim sDir,Inizio,Fine,sFile,sFileCompleto,aRuote,Sorte
    Dim bOk,idFiltro,qIncr
    Dim bPrimaEstrFissa,nDistanza
    sDir = GetDirectoryAppData & "ArchiviVirtuali\"
    sFile = ScegliFileArchivioVirt(sDir)
    If sFile <> "" Then
        sFileCompleto = sDir & sFile & ".dat"
        bOk = ApriFileBaseDati(sFileCompleto)
        bPrimaEstrFissa = True
        nDistanza = GetValoreFraSeparatori(sFile,"(",")")
    Else
        bOk = True ' archivio normale
        bPrimaEstrFissa = False
        nDistanza = 0
    End If
    If bOk Then
        If ScegliRange(Inizio,Fine) Then
            Sorte = ScegliEsito
            Call ScegliRuote(aRuote,Nothing)
            ' decido il filtro in base al valore degli incrementi
            idFiltro = GetIdFiltro
            ' decido di filtrare in base al numero degli incrementi
            qIncr = GetQuantiIncrementi
            If(Fine > Inizio) And UBound(aRuote) > 0 And Sorte > 0 And idFiltro > - 1 Then
                Call Scrivi("Archivio : " & Iif(sFile <> "",sFile,"Archivio lotto"))
                Call Scrivi(Len(sFile))
                Select Case ScegliTipoSviluppo
                Case 1
                    Call AnalisiLunghetteFromFileTxt(Inizio,Fine,aRuote,Sorte,idFiltro,qIncr,bPrimaEstrFissa,nDistanza)
                Case 2
                    Call AnalisiLunghetteFromNumeriCasuali(Inizio,Fine,aRuote,Sorte,idFiltro,qIncr,bPrimaEstrFissa,nDistanza)
                Case 3
                    Call AnalisiLunghetteFromSceglinumeri(Inizio,Fine,aRuote,Sorte,idFiltro,qIncr,bPrimaEstrFissa,nDistanza)
                End Select
            End If
        End If
    End If
End Sub
Function ScegliFileArchivioVirt(sDir)
    Dim i
    ReDim aFile(0)
    Call ElencoFileInDirectory(sDir,aFile,".dat")
    aFile(0) = "Archivio reale"
    i = ScegliOpzioneMenu(aFile,0,"Scegli archivio virtuale")
    If i > 0 Then
        ScegliFileArchivioVirt = aFile(i)
    Else
        ScegliFileArchivioVirt = ""
    End If
End Function
Function ScegliTipoSviluppo
    ReDim aVoci(3)
    aVoci(1) = "Da file txt con lunghette"
    aVoci(2) = "Da sviluppo casuale"
    aVoci(3) = "Da sviluppo tabellare"
    ScegliTipoSviluppo = ScegliOpzioneMenu(aVoci,1)
End Function
Function GetChrSepFromRiga(sRiga)
    Dim k,schr
    schr = ""
    For k = 1 To Len(sRiga)
        schr = Mid(sRiga,k,1)
        If IsNumeric(schr) = False Then
            Exit For
        End If
    Next
    GetChrSepFromRiga = schr
End Function
Function GetIdFiltro
    Dim aFiltro
    aFiltro = Array("IncrRitMaxSto=UltimoIncrRitMax","IncrRitMaxSto<=UltimoIncrRitMax","IncrRitMaxSto>=UltimoIncrRitMax")
    GetIdFiltro = ScegliOpzioneMenu(aFiltro,0,"Select Filtro Condizione")
End Function
Function GetQuantiIncrementi
    GetQuantiIncrementi = CInt(InputBox("qIncr>=(NumeroIncrementiRitMaxFormazione)","Filtro Quantitaà Incrementi",5))
End Function
' Questa è la nuova routine che impedisce di scrivere i doppi
' ma non mpedisce di incrementare nTrov
'Sub AddLunghetta(collLunghette,clsL)
'On Error Resume Next
'collLunghette.Add clsL ,"k"&clsL.LunghettaString
'End Sub
Function AddLunghetta(collLunghette,clsL)
    On Error Resume Next
    collLunghette.Add clsL,"k" & clsL.LunghettaString
    If Err = 0 Then
        AddLunghetta = True
    Else
        AddLunghetta = False
    End If
    Err.Clear
End Function
Function GetValoreFraSeparatori(sFile,CharSep1,CharSep2)
    Dim k
    Dim i,f,sVal
    i = InStr(1,sFile,CharSep1) + 1
    f = InStr(i,sFile,CharSep2)
    GetValoreFraSeparatori = Int(Mid(sFile,i,f - i))
End Function
Sub AnalisiLunghetteFromFileTxt(Inizio,Fine,aRuote,Sorte,idFiltro,qIncr,bPrimaEstrFissa,nDistanza)
    Dim sFile,aLunghette,nTotLunghette
    Dim k,sChrSep
    Dim clsL,collLunghette
    Set collLunghette = GetNewCollection
    sFile = ScegliFile(GetDirectoryAppData,".txt")
    If FileEsistente(sFile) Then
        Call LeggiRigheFileDiTesto(sFile,aLunghette)
        nTotLunghette = UBound(aLunghette)
        If nTotLunghette > 0 Then
            sChrSep = GetChrSepFromRiga(aLunghette(1))
            For k = 0 To nTotLunghette
                Set clsL = New clsLunghetta
                Call clsL.Init(aLunghette(k),sChrSep,Inizio,Fine,aRuote,Sorte)
                If clsL.IsCondizioneRispettata(idFiltro,qIncr) Then
                    Call clsL.EseguiStatistica
                    collLunghette.Add clsL
                End If
                If k Mod 50 = 0 Then
                    Call Messaggio("Righe esaminate : " & k)
                    Call AvanzamentoElab(1,nTotLunghette,k)
                    If ScriptInterrotto Then Exit For
                End If
            Next
            Scrivi "Range analisi         : " & GetInfoEstrazione(Inizio) & " - " & GetInfoEstrazione(Fine)
            Scrivi "Lunghette esaminate   : " & nTotLunghette & " Valide : " & collLunghette.count
            Scrivi "Sorte                 : " & NomeSorte(Sorte)
            Scrivi "Ruote                 : " & StringaRuote(aRuote)
            Scrivi "Numero Minimo IncrRit : " & Format2(qIncr)
            Scrivi
            Scrivi "Lunghette ordinate per incremento ritardo max",True,,vbYellow
            Call Scrivi
            If collLunghette.count > 0 Then
                Call OrdinaItemCollection(collLunghette,"IncrRitMax",,,- 1)
                For Each clsL In collLunghette
                    If nDistanza = 0 Then
                    
                      Call Scrivi("Numeri Formazione     : " & clsL.LunghettaString)
                    Else
                    Call clsL.TrasformaArrayNumVirToNumReal(nDistanza,bPrimaEstrFissa)
                    Call Scrivi("Numeri Formazione     : " & clsL.LunghettaString & "   " & "NumeriReali   : " & clsL.sNumReal)
                    End If
                    
                    Call Scrivi("Ritardo               : " & clsL.Ritardo)
                    Call Scrivi("RitMax                : " & clsL.RitardoMax)
                    Call Scrivi("Freq                  : " & clsL.Frequenza)
                    Call Scrivi("IncrRitMx             : " & clsL.IncrRitMax)
                    Call Scrivi("IncrRitMaxSto         : " & clsL.IncrRitMaxSto)
                    Call Scrivi("strIncrementi         : " & clsL.strIncRitMaxSto)
                    Call Scrivi("Numero Incrementi     : " & clsL.iNumIncrementi)
                    Call clsL.DisegnaGraficoIncrRitMax
                Next
            Else
                Scrivi "Nessuna lunghetta rispetta le condizioni"
                Scrivi "Lunghette esaminate " & nTotLunghette + 1
            End If
        End If
    End If
End Sub
Sub AnalisiLunghetteFromNumeriCasuali(Inizio,Fine,aRuote,Sorte,idFiltro,qIncr,bPrimaEstrFissa,nDistanza)
    Dim sFile,aLunghette,nTotLunghette,nClasse
    Dim nTrov,nProdotte
    Dim clsL,collLunghette
    ReDim aSelNum(0)
    Set collLunghette = GetNewCollection
    nTotLunghette = Int(InputBox("Quante lunghette devono essere trovate ?",,10))
    ScegliNumeri(aSelNum)
    nClasse = Int(InputBox("Quanti numeri nella lunghetta",,Sorte))
    If nTotLunghette > 0 And nClasse >= Sorte And nClasse <= 10 Then
        nTrov = 0
        nProdotte = 0
        Do While nTrov <= nTotLunghette
            Set clsL = New clsLunghetta
            ReDim aNum(nClasse)
            Call GetColonnaCasuale(nClasse,aNum,aSelNum)
            nProdotte = nProdotte + 1
            Call clsL.Init(aNum,"",Inizio,Fine,aRuote,Sorte)
            If clsL.IsCondizioneRispettata(idFiltro,qIncr) Then
                Call clsL.EseguiStatistica
                ' Call AddLunghetta(collLunghette,clsL)
                'nTrov = collLunghette.count
                If AddLunghetta(collLunghette,clsL) Then nTrov = nTrov + 1
            End If
            If nProdotte Mod 50 = 0 Then
                Call Messaggio("combinazioni esaminate " & nProdotte & " valide " & nTrov)
                Call DoEventsEx
                If ScriptInterrotto Then Exit Do
            End If
        Loop
        Scrivi "Range analisi         : " & GetInfoEstrazione(Inizio) & " - " & GetInfoEstrazione(Fine)
        Scrivi "Lunghette esaminate   : " & nProdotte & " Valide : " & collLunghette.count
        Scrivi "Sorte                 : " & NomeSorte(Sorte)
        Scrivi "Ruote                 : " & StringaRuote(aRuote)
        Scrivi "Numero Minimo IncrRit : " & Format2(qIncr)
        Scrivi
        Scrivi "Lunghette ordinate per incremento ritardo max",True,,vbYellow
        Call Scrivi
        If collLunghette.count > 0 Then
            Call OrdinaItemCollection(collLunghette,"IncrRitMax",,,- 1)
            For Each clsL In collLunghette
                If nDistanza = 0 Then
                    
                      Call Scrivi("Numeri Formazione     : " & clsL.LunghettaString)
                    Else
                    Call clsL.TrasformaArrayNumVirToNumReal(nDistanza,bPrimaEstrFissa)
                    Call Scrivi("Numeri Formazione     : " & clsL.LunghettaString & "   " & "NumeriReali   : " & clsL.sNumReal)
                    End If

                Call Scrivi("Ritardo               : " & clsL.Ritardo)
                Call Scrivi("RitMax                : " & clsL.RitardoMax)
                Call Scrivi("Freq                  : " & clsL.Frequenza)
                Call Scrivi("IncrRitMx             : " & clsL.IncrRitMax)
                Call Scrivi("IncrRitMaxSto         : " & clsL.IncrRitMaxSto)
                Call Scrivi("strIncrementi         : " & clsL.strIncRitMaxSto)
                Call Scrivi("Numero Incrementi     : " & clsL.iNumIncrementi)
                Call clsL.DisegnaGraficoIncrRitMax
            Next
        Else
            Scrivi "Nessuna lunghetta rispetta le condizioni"
            Scrivi "Lunghette esaminate " & nTotLunghette
        End If
    End If
End Sub
Sub AnalisiLunghetteFromSceglinumeri(Inizio,Fine,aRuote,Sorte,idFiltro,qIncr,bPrimaEstrFissa,nDistanza)
    Dim nTotLunghette
    Dim k,sChrSep,nClasse
    ReDim aLunghette(0)
    Dim clsL,collLunghette
    Set collLunghette = GetNewCollection
    sChrSep = " "
    ScegliNumeri(aLunghette)
    nClasse = CInt(InputBox(" classe sviluppo ",,2))
    nTotLunghette = InitSviluppoIntegrale(aLunghette,nClasse)
    k = 0
    Do While GetCombSviluppo(aLunghette)
        k = k + 1
        Set clsL = New clsLunghetta
        Call clsL.Init(aLunghette,sChrSep,Inizio,Fine,aRuote,Sorte)
        If clsL.IsCondizioneRispettata(idFiltro,qIncr) Then
            Call clsL.EseguiStatistica
            collLunghette.Add clsL
        End If
        If k Mod 50 = 0 Then
            Call Messaggio("Righe esaminate " & k & "  valide " & collLunghette. count)
            DoEventsEx
            Call AvanzamentoElab(1,nTotLunghette,k)
            If ScriptInterrotto Then Exit Do
        End If
    Loop
    Scrivi "Range analisi         : " & GetInfoEstrazione(Inizio) & " - " & GetInfoEstrazione(Fine)
    Scrivi "Lunghette esaminate   : " & nTotLunghette & " Valide : " & collLunghette.count
    Scrivi "Sorte                 : " & NomeSorte(Sorte)
    Scrivi "Ruote                 : " & StringaRuote(aRuote)
    Scrivi "Numero Minimo IncrRit : " & Format2(qIncr)
    Scrivi
    Scrivi "Lunghette ordinate per incremento ritardo max",True,,vbYellow
    Call Scrivi
    If collLunghette.count > 0 Then
        Call OrdinaItemCollection(collLunghette,"IncrRitMax",,,- 1)
        For Each clsL In collLunghette
            If nDistanza = 0 Then
                    
                      Call Scrivi("Numeri Formazione     : " & clsL.LunghettaString)
                    Else
                    Call clsL.TrasformaArrayNumVirToNumReal(nDistanza,bPrimaEstrFissa)
                    Call Scrivi("Numeri Formazione     : " & clsL.LunghettaString & "   " & "NumeriReali   : " & clsL.sNumReal)
                    End If

            Call Scrivi("Ritardo               : " & clsL.Ritardo)
            Call Scrivi("RitMax                : " & clsL.RitardoMax)
            Call Scrivi("Freq                  : " & clsL.Frequenza)
            Call Scrivi("IncrRitMx             : " & clsL.IncrRitMax)
            Call Scrivi("IncrRitMaxSto         : " & clsL.IncrRitMaxSto)
            Call Scrivi("strIncrementi         : " & clsL.strIncRitMaxSto)
            Call Scrivi("Numero Incrementi     : " & clsL.iNumIncrementi)
            Call clsL.DisegnaGraficoIncrRitMax
        Next
    Else
        Scrivi "Nessuna lunghetta rispetta le condizioni"
        Scrivi "Lunghette esaminate " & nTotLunghette
    End If
End Sub

ciao

LuigiB · 6 Dicembre 2015

bravissimo Legend , lo script l'ho analizzato solo a memoria.

qui
bPrimaEstrFissa = True

dovresti valorizzare la variabile true o false in funzione del fatto che il file contenga la dicitura ConFissi oppure no .. in modo da poter usare pure gli archivi creati senza fissi.

hai creato mdist e mbPrimaEstrFissa come variabili globali della classe mon era necessario non deve vederle nessuan altra routine della classe quelle variabili perche servono solo nella funzione che trasforma i numeri,

il resto sembra ok .. aspettiamo silop .. aribbbravo !

i legend · 6 Dicembre 2015

Grazie

Se il maestro è bravo difficilmente l alunno non migliora.
E tu come prof sei bravissimo

Dopo cena correggo e posto l ultimo script

LuigiB · 6 Dicembre 2015

ok .. grazie ..con l'occasione quando mostri i numeri reali metti pure la stringa dei virtuali infondo son o i virtulai ad aver generato l'evidenza statistica

i legend · 6 Dicembre 2015

ciao Luigi ci sono già sulla stessa stringa.
allora nel nuovo script
ho fatto le modiche richieste
prima per i numeri reali utilizzavo property
ora calcolo i reali con la funzione nelle varie sub
l if che ho inserico nel for each si potrebbe scrivere diversamente?
ecco lo script credo finale

Codice:

Option Explicit
Class clsLunghetta
    Private aNumeri ' contiene i numeri della lunghetta
    Private mInizio,mFine,aRuote,mSorte ' parametri per il range analisi
    Private mClasse ' contine la classe della lunghetta
    Private aElencoRit ' conterra l'elenco dei ritardi per la lunghetta
    Private aIdEstrElencoRit ' conterra l'elenco dei ritardi per la lunghetta
    Private aElencoIncrRitMax ' contiene l'elnco degli incrementi del ritardo max
    Private aIdEstrIncrRitMax ' conterra l'elenco degli id estrazione in
    ' cui si è registrato l'incremento del ritmax conosciuto
    Private aRitardiAllIncremento ' contiene il valore del ritardo all'idestrazione in cui
    ' si è verificato l'incremento
    Private mRitardo,mRitardoMax,mIncrRitMax,mFrequenza ' valori statistici
    Private mIncrRitardoMaxSto,mStrIncRitSto
    'Private mDist,mbPrimaEstrFissa
    Public Property Get iNumIncrementi
        iNumIncrementi = UBound(aElencoIncrRitMax)
    End Property
    Public Property Get IncrRitMaxSto
        IncrRitMaxSto = mIncrRitardoMaxSto
    End Property
    Public Property Get strIncRitMaxSto
        strIncRitMaxSto = mStrIncRitSto
    End Property
    Public Property Get Ritardo
        Ritardo = mRitardo
    End Property
    Public Property Get RitardoMax
        RitardoMax = mRitardoMax
    End Property
    Public Property Get IncrRitMax
        IncrRitMax = mIncrRitMax
    End Property
    Public Property Get Frequenza
        Frequenza = mFrequenza
    End Property
    Public Property Get LunghettaString
        LunghettaString = StringaNumeri(aNumeri)
    End Property
        ' inizializza le proprietà dell'oggetto
    Sub Init(sLunghetta,sChrSep,RangeInizio,RangeFine,vetRuote,SorteInGioco)
        ' acquisisco i parametri per l'analisi
        mInizio = RangeInizio
        mFine = RangeFine
        aRuote = vetRuote
        mSorte = SorteInGioco
        ' alimento il vettore con i numeri della lunghetta
        Call AlimentaVettoreLunghetta(sLunghetta,sChrSep)
        ' calcolo l'elenco dei ritardi
        Call ElencoRitardiTurbo(aNumeri,aRuote,mSorte,mInizio,mFine,aElencoRit,aIdEstrElencoRit)
        ' alimento il vettore che contien l'elenco degli incrementi rit max
        Call AlimentaVettoreIncrRitMax
    End Sub
    ' esegue il calcolo dei valori statistici della lunghetta
    Sub EseguiStatistica
        Call StatisticaFormazioneTurbo(aNumeri,aRuote,mSorte,mRitardo,mRitardoMax,mIncrRitMax,mFrequenza,mInizio,mFine)
    End Sub
    Private Sub AlimentaVettoreLunghetta(sLunghetta,sChrSep)
        Dim k
        If IsArray(sLunghetta) Then
            ' se la lunghetta è gia un array lo copio nel vettore locale dei numeri
            ReDim aNumeri(UBound(sLunghetta))
            For k = 1 To UBound(sLunghetta)
                aNumeri(k) = sLunghetta(k)
            Next
        Else
            ' antepongo un carattere separatore per fare in modo che
            ' aNumeri si valorizzi dall'indice 1 (senno si sarebeb valorizzato dall'indice 0)
            Call SplitByChar((sChrSep & sLunghetta),sChrSep,aNumeri)
        End If
        ' valorizzo la classe della lunghetta
        mClasse = UBound(aNumeri)
    End Sub
    Private Sub AlimentaVettoreIncrRitMax
        Dim nRitMax,nIncr,nId,k
        nId = 0
        ' inizializzo il vettore a 0 elementi
        ReDim aElencoIncrRitMax(0)
        ReDim aIdEstrIncrRitMax(0)
        ReDim aRitardiAllIncremento(0)
        ' ciclo sul vettore dei ritardi
        For k = 1 To UBound(aElencoRit)
            ' se il ritardo corrente supera il ritmax attuale..
            If aElencoRit(k) > nRitMax Then
                If nRitMax > 0 Then
                    ' se il ritmax attuale è >0 (ivvero ne esiste uno)
                    ' calcolo di quanto si è incrementato
                    nIncr = aElencoRit(k) - nRitMax
                    ' incremento il contatore dei valori trovati
                    nId = nId + 1
                    ' ridimensiono il vettore mantenendo i valori precedenti ma
                    ' aggiungendone uno
                    ReDim Preserve aElencoIncrRitMax(nId)
                    ' memorizzo il valore
                    aElencoIncrRitMax(nId) = nIncr
                    ' ridimensiono il vettore mantnendo i valori precedenti ma
                    ' aggiungendone uno
                    ReDim Preserve aIdEstrIncrRitMax(nId)
                    ' memorizzo l'id dell'estrazione dove si è avuto l'incremento
                    aIdEstrIncrRitMax(nId) = aIdEstrElencoRit(k)
                    ' ridimensiono il vettore mantnendo i valori precedenti ma
                    ' aggiungendone uno
                    ReDim Preserve aRitardiAllIncremento(nId)
                    ' memorizzo il valore del ritardo all'id dell'estrazione dove si è avuto l'incremento
                    aRitardiAllIncremento(nId) = aElencoRit(k)
                End If
                nRitMax = aElencoRit(k)
            End If
        Next
        mStrIncRitSto = StringaNumeri(aElencoIncrRitMax,,True)
    End Sub
    Function IsCondizioneRispettata(nIdFiltro,nQIncr)
        ' verifica che l'incremento dell'ultimo ritmax sia uguale al massimo incr rit max conosciuto.
        Dim nUpper
        nUpper = UBound(aElencoIncrRitMax)
        mIncrRitardoMaxSto = MassimoV(aElencoIncrRitMax,1,nUpper - 1)
        If aElencoRit(UBound(aElencoRit)) > 0 And aIdEstrIncrRitMax(nUpper) = mFine And nUpper >= nQIncr Then
            Select Case nIdFiltro
            Case 0
                IsCondizioneRispettata =(aElencoIncrRitMax(nUpper) = mIncrRitardoMaxSto)
            Case 1
                IsCondizioneRispettata =(aElencoIncrRitMax(nUpper) >= mIncrRitardoMaxSto)
            Case 2
                IsCondizioneRispettata =(aElencoIncrRitMax(nUpper) <= mIncrRitardoMaxSto)
            End Select
        Else
            IsCondizioneRispettata = False
        End If
    End Function
    'Scrivo la funzione Importo i Parametri ma non li dichiaro private sono solo nella funzione
    Function TrasformaArrayNumVirToNumReal(iDist,bPrimaEstrFiss)
        Dim k
        Dim sNumreal
                sNumreal = ""
        For k = 1 To UBound(aNumeri)
             sNumreal = sNumreal & Format2(NumVirtToNumReale(aNumeri(k),bPrimaEstrFiss,mFine,iDist)) & "."
        Next
        sNumreal = RimuoviLastChr(sNumreal,".")
        TrasformaArrayNumVirToNumReal = sNumreal
    End Function
    Sub DisegnaGraficoIncrRitMax
        Dim x,y,k
        Dim nValoreMaxX,nValoreMaxY,nValoreMinX
        Dim nStepX,nStepY
        Dim nUpperVetIncrRit
        nValoreMinX = MinimoV(aIdEstrIncrRitMax,1)
        nValoreMaxX = aIdEstrIncrRitMax(UBound(aIdEstrIncrRitMax))
        nValoreMaxY = MassimoV(aElencoRit,1)
        nStepX =(nValoreMaxX -(mInizio - 1)) \10
        nStepY = nValoreMaxY \10
        Call PreparaGrafico("Formaziione " & StringaNumeri(aNumeri),nValoreMinX,nValoreMaxX,0,nValoreMaxY,nStepX,nStepY)
        nUpperVetIncrRit = UBound(aElencoIncrRitMax)
        ' linea dell'incremento rit max
        ReDim aV(nUpperVetIncrRit - 1,2)
        For k = 1 To nUpperVetIncrRit
            x = aIdEstrIncrRitMax(k)
            y = aElencoIncrRitMax(k)
            aV(k - 1,1) = x
            aV(k - 1,2) = y
        Next
        Call DisegnaLineaGrafico(aV,vbRed,"IncrRitMax")
        ' linea dell' rit max
        ReDim aV(nUpperVetIncrRit - 1,2)
        For k = 1 To nUpperVetIncrRit
            x = aIdEstrIncrRitMax(k)
            y = aRitardiAllIncremento(k)
            aV(k - 1,1) = x
            aV(k - 1,2) = y
        Next
        Call DisegnaLineaGrafico(aV,vbBlue,"RitMax")
        ' scrive grafico nell'output
        Call InserisciGrafico
    End Sub
End Class
Sub Main
    Dim sDir,Inizio,Fine,sFile,sFileCompleto,aRuote,Sorte
    Dim bOk,idFiltro,qIncr
    Dim bPrimaEstrFissa,nDistanza
    sDir = GetDirectoryAppData & "ArchiviVirtuali\"
    sFile = ScegliFileArchivioVirt(sDir)
    'preimposto a False x valutare qualsiasi sFile<>""
    bPrimaEstrFissa=False
    If sFile <> "" Then
        sFileCompleto = sDir & sFile & ".dat"
        bOk = ApriFileBaseDati(sFileCompleto)
        bPrimaEstrFissa = True
        nDistanza = GetValoreFraSeparatori(sFile,"(",")")
    Else
        bOk = True ' archivio normale
        
        nDistanza = 0 ' archivio Reale
    End If
    If bOk Then
        If ScegliRange(Inizio,Fine) Then
            Sorte = ScegliEsito
            Call ScegliRuote(aRuote,Nothing)
            ' decido il filtro in base al valore degli incrementi
            idFiltro = GetIdFiltro
            ' decido di filtrare in base al numero degli incrementi
            qIncr = GetQuantiIncrementi
            If(Fine > Inizio) And UBound(aRuote) > 0 And Sorte > 0 And idFiltro > - 1 Then
                Call Scrivi("Archivio : " & Iif(sFile <> "",sFile,"Archivio lotto"))
                Call Scrivi(Len(sFile))
                Select Case ScegliTipoSviluppo
                Case 1
                    Call AnalisiLunghetteFromFileTxt(Inizio,Fine,aRuote,Sorte,idFiltro,qIncr,bPrimaEstrFissa,nDistanza)
                Case 2
                    Call AnalisiLunghetteFromNumeriCasuali(Inizio,Fine,aRuote,Sorte,idFiltro,qIncr,bPrimaEstrFissa,nDistanza)
                Case 3
                    Call AnalisiLunghetteFromSceglinumeri(Inizio,Fine,aRuote,Sorte,idFiltro,qIncr,bPrimaEstrFissa,nDistanza)
                End Select
            End If
        End If
    End If
End Sub
Function ScegliFileArchivioVirt(sDir)
    Dim i
    ReDim aFile(0)
    Call ElencoFileInDirectory(sDir,aFile,".dat")
    aFile(0) = "Archivio reale"
    i = ScegliOpzioneMenu(aFile,0,"Scegli archivio virtuale")
    If i > 0 Then
        ScegliFileArchivioVirt = aFile(i)
    Else
        ScegliFileArchivioVirt = ""
    End If
End Function
Function ScegliTipoSviluppo
    ReDim aVoci(3)
    aVoci(1) = "Da file txt con lunghette"
    aVoci(2) = "Da sviluppo casuale"
    aVoci(3) = "Da sviluppo tabellare"
    ScegliTipoSviluppo = ScegliOpzioneMenu(aVoci,1)
End Function
Function GetChrSepFromRiga(sRiga)
    Dim k,schr
    schr = ""
    For k = 1 To Len(sRiga)
        schr = Mid(sRiga,k,1)
        If IsNumeric(schr) = False Then
            Exit For
        End If
    Next
    GetChrSepFromRiga = schr
End Function
Function GetIdFiltro
    Dim aFiltro
    aFiltro = Array("IncrRitMaxSto=UltimoIncrRitMax","IncrRitMaxSto<=UltimoIncrRitMax","IncrRitMaxSto>=UltimoIncrRitMax")
    GetIdFiltro = ScegliOpzioneMenu(aFiltro,0,"Select Filtro Condizione")
End Function
Function GetQuantiIncrementi
    GetQuantiIncrementi = CInt(InputBox("qIncr>=(NumeroIncrementiRitMaxFormazione)","Filtro Quantitaà Incrementi",5))
End Function
' Questa è la nuova routine che impedisce di scrivere i doppi
' ma non mpedisce di incrementare nTrov
'Sub AddLunghetta(collLunghette,clsL)
'On Error Resume Next
'collLunghette.Add clsL ,"k"&clsL.LunghettaString
'End Sub
Function AddLunghetta(collLunghette,clsL)
    On Error Resume Next
    collLunghette.Add clsL,"k" & clsL.LunghettaString
    If Err = 0 Then
        AddLunghetta = True
    Else
        AddLunghetta = False
    End If
    Err.Clear
End Function
Function GetValoreFraSeparatori(sFile,CharSep1,CharSep2)
    Dim k
    Dim i,f,sVal
    i = InStr(1,sFile,CharSep1) + 1
    f = InStr(i,sFile,CharSep2)
    GetValoreFraSeparatori = Int(Mid(sFile,i,f - i))
End Function
Sub AnalisiLunghetteFromFileTxt(Inizio,Fine,aRuote,Sorte,idFiltro,qIncr,bPrimaEstrFissa,nDistanza)
    Dim sFile,aLunghette,nTotLunghette
    Dim k,sChrSep,sNumReal
    Dim clsL,collLunghette
    Set collLunghette = GetNewCollection
    sFile = ScegliFile(GetDirectoryAppData,".txt")
    If FileEsistente(sFile) Then
        Call LeggiRigheFileDiTesto(sFile,aLunghette)
        nTotLunghette = UBound(aLunghette)
        If nTotLunghette > 0 Then
            sChrSep = GetChrSepFromRiga(aLunghette(1))
            For k = 0 To nTotLunghette
                Set clsL = New clsLunghetta
                Call clsL.Init(aLunghette(k),sChrSep,Inizio,Fine,aRuote,Sorte)
                If clsL.IsCondizioneRispettata(idFiltro,qIncr) Then
                    Call clsL.EseguiStatistica
                    collLunghette.Add clsL
                End If
                If k Mod 50 = 0 Then
                    Call Messaggio("Righe esaminate : " & k)
                    Call AvanzamentoElab(1,nTotLunghette,k)
                    If ScriptInterrotto Then Exit For
                End If
            Next
            Scrivi "Range analisi         : " & GetInfoEstrazione(Inizio) & " - " & GetInfoEstrazione(Fine)
            Scrivi "Lunghette esaminate   : " & nTotLunghette & " Valide : " & collLunghette.count
            Scrivi "Sorte                 : " & NomeSorte(Sorte)
            Scrivi "Ruote                 : " & StringaRuote(aRuote)
            Scrivi "Numero Minimo IncrRit : " & Format2(qIncr)
            Scrivi
            Scrivi "Lunghette ordinate per incremento ritardo max",True,,vbYellow
            Call Scrivi
            If collLunghette.count > 0 Then
                Call OrdinaItemCollection(collLunghette,"IncrRitMax",,,- 1)
                For Each clsL In collLunghette
                    If nDistanza = 0 Then
                        Call Scrivi("Numeri Formazione     : " & clsL.LunghettaString)
                    Else
                        sNumReal= clsL.TrasformaArrayNumVirToNumReal(nDistanza,bPrimaEstrFissa)
                        Call Scrivi("Numeri Formazione     : " & clsL.LunghettaString & "   " & "NumeriReali   : " & sNumReal)
                    End If
                    Call Scrivi("Ritardo               : " & clsL.Ritardo)
                    Call Scrivi("RitMax                : " & clsL.RitardoMax)
                    Call Scrivi("Freq                  : " & clsL.Frequenza)
                    Call Scrivi("IncrRitMx             : " & clsL.IncrRitMax)
                    Call Scrivi("IncrRitMaxSto         : " & clsL.IncrRitMaxSto)
                    Call Scrivi("strIncrementi         : " & clsL.strIncRitMaxSto)
                    Call Scrivi("Numero Incrementi     : " & clsL.iNumIncrementi)
                    Call clsL.DisegnaGraficoIncrRitMax
                Next
            Else
                Scrivi "Nessuna lunghetta rispetta le condizioni"
                Scrivi "Lunghette esaminate " & nTotLunghette + 1
            End If
        End If
    End If
End Sub
Sub AnalisiLunghetteFromNumeriCasuali(Inizio,Fine,aRuote,Sorte,idFiltro,qIncr,bPrimaEstrFissa,nDistanza)
    Dim sFile,aLunghette,nTotLunghette,nClasse
    Dim nTrov,nProdotte,sNumReal
    Dim clsL,collLunghette
    ReDim aSelNum(0)
    Set collLunghette = GetNewCollection
    nTotLunghette = Int(InputBox("Quante lunghette devono essere trovate ?",,10))
    ScegliNumeri(aSelNum)
    nClasse = Int(InputBox("Quanti numeri nella lunghetta",,Sorte))
    If nTotLunghette > 0 And nClasse >= Sorte And nClasse <= 10 Then
        nTrov = 0
        nProdotte = 0
        Do While nTrov <= nTotLunghette
            Set clsL = New clsLunghetta
            ReDim aNum(nClasse)
            Call GetColonnaCasuale(nClasse,aNum,aSelNum)
            nProdotte = nProdotte + 1
            Call clsL.Init(aNum,"",Inizio,Fine,aRuote,Sorte)
            If clsL.IsCondizioneRispettata(idFiltro,qIncr) Then
                Call clsL.EseguiStatistica
                ' Call AddLunghetta(collLunghette,clsL)
                'nTrov = collLunghette.count
                If AddLunghetta(collLunghette,clsL) Then nTrov = nTrov + 1
            End If
            If nProdotte Mod 50 = 0 Then
                Call Messaggio("combinazioni esaminate " & nProdotte & " valide " & nTrov)
                Call DoEventsEx
                If ScriptInterrotto Then Exit Do
            End If
        Loop
        Scrivi "Range analisi         : " & GetInfoEstrazione(Inizio) & " - " & GetInfoEstrazione(Fine)
        Scrivi "Lunghette esaminate   : " & nProdotte & " Valide : " & collLunghette.count
        Scrivi "Sorte                 : " & NomeSorte(Sorte)
        Scrivi "Ruote                 : " & StringaRuote(aRuote)
        Scrivi "Numero Minimo IncrRit : " & Format2(qIncr)
        Scrivi
        Scrivi "Lunghette ordinate per incremento ritardo max",True,,vbYellow
        Call Scrivi
        If collLunghette.count > 0 Then
            Call OrdinaItemCollection(collLunghette,"IncrRitMax",,,- 1)
            For Each clsL In collLunghette
                If nDistanza = 0 Then
                    Call Scrivi("Numeri Formazione     : " & clsL.LunghettaString)
                Else
                    sNumReal= clsL.TrasformaArrayNumVirToNumReal(nDistanza,bPrimaEstrFissa)
                    Call Scrivi("Numeri Formazione     : " & clsL.LunghettaString & "   " & "NumeriReali   : " & sNumReal)
                End If
                Call Scrivi("Ritardo               : " & clsL.Ritardo)
                Call Scrivi("RitMax                : " & clsL.RitardoMax)
                Call Scrivi("Freq                  : " & clsL.Frequenza)
                Call Scrivi("IncrRitMx             : " & clsL.IncrRitMax)
                Call Scrivi("IncrRitMaxSto         : " & clsL.IncrRitMaxSto)
                Call Scrivi("strIncrementi         : " & clsL.strIncRitMaxSto)
                Call Scrivi("Numero Incrementi     : " & clsL.iNumIncrementi)
                Call clsL.DisegnaGraficoIncrRitMax
            Next
        Else
            Scrivi "Nessuna lunghetta rispetta le condizioni"
            Scrivi "Lunghette esaminate " & nTotLunghette
        End If
    End If
End Sub
Sub AnalisiLunghetteFromSceglinumeri(Inizio,Fine,aRuote,Sorte,idFiltro,qIncr,bPrimaEstrFissa,nDistanza)
    Dim nTotLunghette
    Dim k,sChrSep,nClasse,sNumReal
    ReDim aLunghette(0)
    Dim clsL,collLunghette
    Set collLunghette = GetNewCollection
    sChrSep = " "
    ScegliNumeri(aLunghette)
    nClasse = CInt(InputBox(" classe sviluppo ",,2))
    nTotLunghette = InitSviluppoIntegrale(aLunghette,nClasse)
    k = 0
    Do While GetCombSviluppo(aLunghette)
        k = k + 1
        Set clsL = New clsLunghetta
        Call clsL.Init(aLunghette,sChrSep,Inizio,Fine,aRuote,Sorte)
        If clsL.IsCondizioneRispettata(idFiltro,qIncr) Then
            Call clsL.EseguiStatistica
            collLunghette.Add clsL
        End If
        If k Mod 50 = 0 Then
            Call Messaggio("Righe esaminate " & k & "  valide " & collLunghette. count)
            DoEventsEx
            Call AvanzamentoElab(1,nTotLunghette,k)
            If ScriptInterrotto Then Exit Do
        End If
    Loop
    Scrivi "Range analisi         : " & GetInfoEstrazione(Inizio) & " - " & GetInfoEstrazione(Fine)
    Scrivi "Lunghette esaminate   : " & nTotLunghette & " Valide : " & collLunghette.count
    Scrivi "Sorte                 : " & NomeSorte(Sorte)
    Scrivi "Ruote                 : " & StringaRuote(aRuote)
    Scrivi "Numero Minimo IncrRit : " & Format2(qIncr)
    Scrivi
    Scrivi "Lunghette ordinate per incremento ritardo max",True,,vbYellow
    Call Scrivi
    If collLunghette.count > 0 Then
        Call OrdinaItemCollection(collLunghette,"IncrRitMax",,,- 1)
        For Each clsL In collLunghette
            If nDistanza = 0 Then
                Call Scrivi("Numeri Formazione     : " & clsL.LunghettaString)
            Else
                 sNumReal=clsL.TrasformaArrayNumVirToNumReal(nDistanza,bPrimaEstrFissa)
                Call Scrivi("Numeri Formazione     : " & clsL.LunghettaString & "   " & "NumeriReali   : " & sNumReal)
            End If
            Call Scrivi("Ritardo               : " & clsL.Ritardo)
            Call Scrivi("RitMax                : " & clsL.RitardoMax)
            Call Scrivi("Freq                  : " & clsL.Frequenza)
            Call Scrivi("IncrRitMx             : " & clsL.IncrRitMax)
            Call Scrivi("IncrRitMaxSto         : " & clsL.IncrRitMaxSto)
            Call Scrivi("strIncrementi         : " & clsL.strIncRitMaxSto)
            Call Scrivi("Numero Incrementi     : " & clsL.iNumIncrementi)
            Call clsL.DisegnaGraficoIncrRitMax
        Next
    Else
        Scrivi "Nessuna lunghetta rispetta le condizioni"
        Scrivi "Lunghette esaminate " & nTotLunghette
    End If
End Sub

LuigiB · 6 Dicembre 2015

ciao legend aspettiam osilop per veder e se è tutto ok ..lo script io per ora l'ho analizzato solo a mente non l'ho provato.

lotto_tom75 · 6 Dicembre 2015

i legend;n1942089 ha scritto:

ciao Luigi ci sono già sulla stessa stringa.
allora nel nuovo script
ho fatto le modiche richieste
prima per i numeri reali utilizzavo property
ora calcolo i reali con la funzione nelle varie sub
l if che ho inserico nel for each si potrebbe scrivere diversamente?
ecco lo script credo finale

Codice:

Option Explicit
Class clsLunghetta
Private aNumeri ' contiene i numeri della lunghetta
Private mInizio,mFine,aRuote,mSorte ' parametri per il range analisi
Private mClasse ' contine la classe della lunghetta
Private aElencoRit ' conterra l'elenco dei ritardi per la lunghetta
Private aIdEstrElencoRit ' conterra l'elenco dei ritardi per la lunghetta
Private aElencoIncrRitMax ' contiene l'elnco degli incrementi del ritardo max
Private aIdEstrIncrRitMax ' conterra l'elenco degli id estrazione in
' cui si è registrato l'incremento del ritmax conosciuto
Private aRitardiAllIncremento ' contiene il valore del ritardo all'idestrazione in cui
' si è verificato l'incremento
Private mRitardo,mRitardoMax,mIncrRitMax,mFrequenza ' valori statistici
Private mIncrRitardoMaxSto,mStrIncRitSto
'Private mDist,mbPrimaEstrFissa
Public Property Get iNumIncrementi
iNumIncrementi = UBound(aElencoIncrRitMax)
End Property
Public Property Get IncrRitMaxSto
IncrRitMaxSto = mIncrRitardoMaxSto
End Property
Public Property Get strIncRitMaxSto
strIncRitMaxSto = mStrIncRitSto
End Property
Public Property Get Ritardo
Ritardo = mRitardo
End Property
Public Property Get RitardoMax
RitardoMax = mRitardoMax
End Property
Public Property Get IncrRitMax
IncrRitMax = mIncrRitMax
End Property
Public Property Get Frequenza
Frequenza = mFrequenza
End Property
Public Property Get LunghettaString
LunghettaString = StringaNumeri(aNumeri)
End Property
' inizializza le proprietà dell'oggetto
Sub Init(sLunghetta,sChrSep,RangeInizio,RangeFine,vetRuote,SorteInGioco)
' acquisisco i parametri per l'analisi
mInizio = RangeInizio
mFine = RangeFine
aRuote = vetRuote
mSorte = SorteInGioco
' alimento il vettore con i numeri della lunghetta
Call AlimentaVettoreLunghetta(sLunghetta,sChrSep)
' calcolo l'elenco dei ritardi
Call ElencoRitardiTurbo(aNumeri,aRuote,mSorte,mInizio,mFine,aElencoRit,aIdEstrElencoRit)
' alimento il vettore che contien l'elenco degli incrementi rit max
Call AlimentaVettoreIncrRitMax
End Sub
' esegue il calcolo dei valori statistici della lunghetta
Sub EseguiStatistica
Call StatisticaFormazioneTurbo(aNumeri,aRuote,mSorte,mRitardo,mRitardoMax,mIncrRitMax,mFrequenza,mInizio,mFine)
End Sub
Private Sub AlimentaVettoreLunghetta(sLunghetta,sChrSep)
Dim k
If IsArray(sLunghetta) Then
' se la lunghetta è gia un array lo copio nel vettore locale dei numeri
ReDim aNumeri(UBound(sLunghetta))
For k = 1 To UBound(sLunghetta)
aNumeri(k) = sLunghetta(k)
Next
Else
' antepongo un carattere separatore per fare in modo che
' aNumeri si valorizzi dall'indice 1 (senno si sarebeb valorizzato dall'indice 0)
Call SplitByChar((sChrSep & sLunghetta),sChrSep,aNumeri)
End If
' valorizzo la classe della lunghetta
mClasse = UBound(aNumeri)
End Sub
Private Sub AlimentaVettoreIncrRitMax
Dim nRitMax,nIncr,nId,k
nId = 0
' inizializzo il vettore a 0 elementi
ReDim aElencoIncrRitMax(0)
ReDim aIdEstrIncrRitMax(0)
ReDim aRitardiAllIncremento(0)
' ciclo sul vettore dei ritardi
For k = 1 To UBound(aElencoRit)
' se il ritardo corrente supera il ritmax attuale..
If aElencoRit(k) > nRitMax Then
If nRitMax > 0 Then
' se il ritmax attuale è >0 (ivvero ne esiste uno)
' calcolo di quanto si è incrementato
nIncr = aElencoRit(k) - nRitMax
' incremento il contatore dei valori trovati
nId = nId + 1
' ridimensiono il vettore mantenendo i valori precedenti ma
' aggiungendone uno
ReDim Preserve aElencoIncrRitMax(nId)
' memorizzo il valore
aElencoIncrRitMax(nId) = nIncr
' ridimensiono il vettore mantnendo i valori precedenti ma
' aggiungendone uno
ReDim Preserve aIdEstrIncrRitMax(nId)
' memorizzo l'id dell'estrazione dove si è avuto l'incremento
aIdEstrIncrRitMax(nId) = aIdEstrElencoRit(k)
' ridimensiono il vettore mantnendo i valori precedenti ma
' aggiungendone uno
ReDim Preserve aRitardiAllIncremento(nId)
' memorizzo il valore del ritardo all'id dell'estrazione dove si è avuto l'incremento
aRitardiAllIncremento(nId) = aElencoRit(k)
End If
nRitMax = aElencoRit(k)
End If
Next
mStrIncRitSto = StringaNumeri(aElencoIncrRitMax,,True)
End Sub
Function IsCondizioneRispettata(nIdFiltro,nQIncr)
' verifica che l'incremento dell'ultimo ritmax sia uguale al massimo incr rit max conosciuto.
Dim nUpper
nUpper = UBound(aElencoIncrRitMax)
mIncrRitardoMaxSto = MassimoV(aElencoIncrRitMax,1,nUpper - 1)
If aElencoRit(UBound(aElencoRit)) > 0 And aIdEstrIncrRitMax(nUpper) = mFine And nUpper >= nQIncr Then
Select Case nIdFiltro
Case 0
IsCondizioneRispettata =(aElencoIncrRitMax(nUpper) = mIncrRitardoMaxSto)
Case 1
IsCondizioneRispettata =(aElencoIncrRitMax(nUpper) >= mIncrRitardoMaxSto)
Case 2
IsCondizioneRispettata =(aElencoIncrRitMax(nUpper) <= mIncrRitardoMaxSto)
End Select
Else
IsCondizioneRispettata = False
End If
End Function
'Scrivo la funzione Importo i Parametri ma non li dichiaro private sono solo nella funzione
Function TrasformaArrayNumVirToNumReal(iDist,bPrimaEstrFiss)
Dim k
Dim sNumreal
sNumreal = ""
For k = 1 To UBound(aNumeri)
sNumreal = sNumreal & Format2(NumVirtToNumReale(aNumeri(k),bPrimaEstrFiss,mFine,iDist)) & "."
Next
sNumreal = RimuoviLastChr(sNumreal,".")
TrasformaArrayNumVirToNumReal = sNumreal
End Function
Sub DisegnaGraficoIncrRitMax
Dim x,y,k
Dim nValoreMaxX,nValoreMaxY,nValoreMinX
Dim nStepX,nStepY
Dim nUpperVetIncrRit
nValoreMinX = MinimoV(aIdEstrIncrRitMax,1)
nValoreMaxX = aIdEstrIncrRitMax(UBound(aIdEstrIncrRitMax))
nValoreMaxY = MassimoV(aElencoRit,1)
nStepX =(nValoreMaxX -(mInizio - 1)) \10
nStepY = nValoreMaxY \10
Call PreparaGrafico("Formaziione " & StringaNumeri(aNumeri),nValoreMinX,nValoreMaxX,0,nValoreMaxY,nStepX,nStepY)
nUpperVetIncrRit = UBound(aElencoIncrRitMax)
' linea dell'incremento rit max
ReDim aV(nUpperVetIncrRit - 1,2)
For k = 1 To nUpperVetIncrRit
x = aIdEstrIncrRitMax(k)
y = aElencoIncrRitMax(k)
aV(k - 1,1) = x
aV(k - 1,2) = y
Next
Call DisegnaLineaGrafico(aV,vbRed,"IncrRitMax")
' linea dell' rit max
ReDim aV(nUpperVetIncrRit - 1,2)
For k = 1 To nUpperVetIncrRit
x = aIdEstrIncrRitMax(k)
y = aRitardiAllIncremento(k)
aV(k - 1,1) = x
aV(k - 1,2) = y
Next
Call DisegnaLineaGrafico(aV,vbBlue,"RitMax")
' scrive grafico nell'output
Call InserisciGrafico
End Sub
End Class
Sub Main
Dim sDir,Inizio,Fine,sFile,sFileCompleto,aRuote,Sorte
Dim bOk,idFiltro,qIncr
Dim bPrimaEstrFissa,nDistanza
sDir = GetDirectoryAppData & "ArchiviVirtuali\"
sFile = ScegliFileArchivioVirt(sDir)
'preimposto a False x valutare qualsiasi sFile<>""
bPrimaEstrFissa=False
If sFile <> "" Then
sFileCompleto = sDir & sFile & ".dat"
bOk = ApriFileBaseDati(sFileCompleto)
bPrimaEstrFissa = True
nDistanza = GetValoreFraSeparatori(sFile,"(",")")
Else
bOk = True ' archivio normale

nDistanza = 0 ' archivio Reale
End If
If bOk Then
If ScegliRange(Inizio,Fine) Then
Sorte = ScegliEsito
Call ScegliRuote(aRuote,Nothing)
' decido il filtro in base al valore degli incrementi
idFiltro = GetIdFiltro
' decido di filtrare in base al numero degli incrementi
qIncr = GetQuantiIncrementi
If(Fine > Inizio) And UBound(aRuote) > 0 And Sorte > 0 And idFiltro > - 1 Then
Call Scrivi("Archivio : " & Iif(sFile <> "",sFile,"Archivio lotto"))
Call Scrivi(Len(sFile))
Select Case ScegliTipoSviluppo
Case 1
Call AnalisiLunghetteFromFileTxt(Inizio,Fine,aRuote,Sorte,idFiltro,qIncr,bPrimaEstrFissa,nDistanza)
Case 2
Call AnalisiLunghetteFromNumeriCasuali(Inizio,Fine,aRuote,Sorte,idFiltro,qIncr,bPrimaEstrFissa,nDistanza)
Case 3
Call AnalisiLunghetteFromSceglinumeri(Inizio,Fine,aRuote,Sorte,idFiltro,qIncr,bPrimaEstrFissa,nDistanza)
End Select
End If
End If
End If
End Sub
Function ScegliFileArchivioVirt(sDir)
Dim i
ReDim aFile(0)
Call ElencoFileInDirectory(sDir,aFile,".dat")
aFile(0) = "Archivio reale"
i = ScegliOpzioneMenu(aFile,0,"Scegli archivio virtuale")
If i > 0 Then
ScegliFileArchivioVirt = aFile(i)
Else
ScegliFileArchivioVirt = ""
End If
End Function
Function ScegliTipoSviluppo
ReDim aVoci(3)
aVoci(1) = "Da file txt con lunghette"
aVoci(2) = "Da sviluppo casuale"
aVoci(3) = "Da sviluppo tabellare"
ScegliTipoSviluppo = ScegliOpzioneMenu(aVoci,1)
End Function
Function GetChrSepFromRiga(sRiga)
Dim k,schr
schr = ""
For k = 1 To Len(sRiga)
schr = Mid(sRiga,k,1)
If IsNumeric(schr) = False Then
Exit For
End If
Next
GetChrSepFromRiga = schr
End Function
Function GetIdFiltro
Dim aFiltro
aFiltro = Array("IncrRitMaxSto=UltimoIncrRitMax","IncrRitMaxSto<=UltimoIncrRitMax","IncrRitMaxSto>=UltimoIncrRitMax")
GetIdFiltro = ScegliOpzioneMenu(aFiltro,0,"Select Filtro Condizione")
End Function
Function GetQuantiIncrementi
GetQuantiIncrementi = CInt(InputBox("qIncr>=(NumeroIncrementiRitMaxFormazione)","Filtro Quantitaà Incrementi",5))
End Function
' Questa è la nuova routine che impedisce di scrivere i doppi
' ma non mpedisce di incrementare nTrov
'Sub AddLunghetta(collLunghette,clsL)
'On Error Resume Next
'collLunghette.Add clsL ,"k"&clsL.LunghettaString
'End Sub
Function AddLunghetta(collLunghette,clsL)
On Error Resume Next
collLunghette.Add clsL,"k" & clsL.LunghettaString
If Err = 0 Then
AddLunghetta = True
Else
AddLunghetta = False
End If
Err.Clear
End Function
Function GetValoreFraSeparatori(sFile,CharSep1,CharSep2)
Dim k
Dim i,f,sVal
i = InStr(1,sFile,CharSep1) + 1
f = InStr(i,sFile,CharSep2)
GetValoreFraSeparatori = Int(Mid(sFile,i,f - i))
End Function
Sub AnalisiLunghetteFromFileTxt(Inizio,Fine,aRuote,Sorte,idFiltro,qIncr,bPrimaEstrFissa,nDistanza)
Dim sFile,aLunghette,nTotLunghette
Dim k,sChrSep,sNumReal
Dim clsL,collLunghette
Set collLunghette = GetNewCollection
sFile = ScegliFile(GetDirectoryAppData,".txt")
If FileEsistente(sFile) Then
Call LeggiRigheFileDiTesto(sFile,aLunghette)
nTotLunghette = UBound(aLunghette)
If nTotLunghette > 0 Then
sChrSep = GetChrSepFromRiga(aLunghette(1))
For k = 0 To nTotLunghette
Set clsL = New clsLunghetta
Call clsL.Init(aLunghette(k),sChrSep,Inizio,Fine,aRuote,Sorte)
If clsL.IsCondizioneRispettata(idFiltro,qIncr) Then
Call clsL.EseguiStatistica
collLunghette.Add clsL
End If
If k Mod 50 = 0 Then
Call Messaggio("Righe esaminate : " & k)
Call AvanzamentoElab(1,nTotLunghette,k)
If ScriptInterrotto Then Exit For
End If
Next
Scrivi "Range analisi : " & GetInfoEstrazione(Inizio) & " - " & GetInfoEstrazione(Fine)
Scrivi "Lunghette esaminate : " & nTotLunghette & " Valide : " & collLunghette.count
Scrivi "Sorte : " & NomeSorte(Sorte)
Scrivi "Ruote : " & StringaRuote(aRuote)
Scrivi "Numero Minimo IncrRit : " & Format2(qIncr)
Scrivi
Scrivi "Lunghette ordinate per incremento ritardo max",True,,vbYellow
Call Scrivi
If collLunghette.count > 0 Then
Call OrdinaItemCollection(collLunghette,"IncrRitMax",,,- 1)
For Each clsL In collLunghette
If nDistanza = 0 Then
Call Scrivi("Numeri Formazione : " & clsL.LunghettaString)
Else
sNumReal= clsL.TrasformaArrayNumVirToNumReal(nDistanza,bPrimaEstrFissa)
Call Scrivi("Numeri Formazione : " & clsL.LunghettaString & " " & "NumeriReali : " & sNumReal)
End If
Call Scrivi("Ritardo : " & clsL.Ritardo)
Call Scrivi("RitMax : " & clsL.RitardoMax)
Call Scrivi("Freq : " & clsL.Frequenza)
Call Scrivi("IncrRitMx : " & clsL.IncrRitMax)
Call Scrivi("IncrRitMaxSto : " & clsL.IncrRitMaxSto)
Call Scrivi("strIncrementi : " & clsL.strIncRitMaxSto)
Call Scrivi("Numero Incrementi : " & clsL.iNumIncrementi)
Call clsL.DisegnaGraficoIncrRitMax
Next
Else
Scrivi "Nessuna lunghetta rispetta le condizioni"
Scrivi "Lunghette esaminate " & nTotLunghette + 1
End If
End If
End If
End Sub
Sub AnalisiLunghetteFromNumeriCasuali(Inizio,Fine,aRuote,Sorte,idFiltro,qIncr,bPrimaEstrFissa,nDistanza)
Dim sFile,aLunghette,nTotLunghette,nClasse
Dim nTrov,nProdotte,sNumReal
Dim clsL,collLunghette
ReDim aSelNum(0)
Set collLunghette = GetNewCollection
nTotLunghette = Int(InputBox("Quante lunghette devono essere trovate ?",,10))
ScegliNumeri(aSelNum)
nClasse = Int(InputBox("Quanti numeri nella lunghetta",,Sorte))
If nTotLunghette > 0 And nClasse >= Sorte And nClasse <= 10 Then
nTrov = 0
nProdotte = 0
Do While nTrov <= nTotLunghette
Set clsL = New clsLunghetta
ReDim aNum(nClasse)
Call GetColonnaCasuale(nClasse,aNum,aSelNum)
nProdotte = nProdotte + 1
Call clsL.Init(aNum,"",Inizio,Fine,aRuote,Sorte)
If clsL.IsCondizioneRispettata(idFiltro,qIncr) Then
Call clsL.EseguiStatistica
' Call AddLunghetta(collLunghette,clsL)
'nTrov = collLunghette.count
If AddLunghetta(collLunghette,clsL) Then nTrov = nTrov + 1
End If
If nProdotte Mod 50 = 0 Then
Call Messaggio("combinazioni esaminate " & nProdotte & " valide " & nTrov)
Call DoEventsEx
If ScriptInterrotto Then Exit Do
End If
Loop
Scrivi "Range analisi : " & GetInfoEstrazione(Inizio) & " - " & GetInfoEstrazione(Fine)
Scrivi "Lunghette esaminate : " & nProdotte & " Valide : " & collLunghette.count
Scrivi "Sorte : " & NomeSorte(Sorte)
Scrivi "Ruote : " & StringaRuote(aRuote)
Scrivi "Numero Minimo IncrRit : " & Format2(qIncr)
Scrivi
Scrivi "Lunghette ordinate per incremento ritardo max",True,,vbYellow
Call Scrivi
If collLunghette.count > 0 Then
Call OrdinaItemCollection(collLunghette,"IncrRitMax",,,- 1)
For Each clsL In collLunghette
If nDistanza = 0 Then
Call Scrivi("Numeri Formazione : " & clsL.LunghettaString)
Else
sNumReal= clsL.TrasformaArrayNumVirToNumReal(nDistanza,bPrimaEstrFissa)
Call Scrivi("Numeri Formazione : " & clsL.LunghettaString & " " & "NumeriReali : " & sNumReal)
End If
Call Scrivi("Ritardo : " & clsL.Ritardo)
Call Scrivi("RitMax : " & clsL.RitardoMax)
Call Scrivi("Freq : " & clsL.Frequenza)
Call Scrivi("IncrRitMx : " & clsL.IncrRitMax)
Call Scrivi("IncrRitMaxSto : " & clsL.IncrRitMaxSto)
Call Scrivi("strIncrementi : " & clsL.strIncRitMaxSto)
Call Scrivi("Numero Incrementi : " & clsL.iNumIncrementi)
Call clsL.DisegnaGraficoIncrRitMax
Next
Else
Scrivi "Nessuna lunghetta rispetta le condizioni"
Scrivi "Lunghette esaminate " & nTotLunghette
End If
End If
End Sub
Sub AnalisiLunghetteFromSceglinumeri(Inizio,Fine,aRuote,Sorte,idFiltro,qIncr,bPrimaEstrFissa,nDistanza)
Dim nTotLunghette
Dim k,sChrSep,nClasse,sNumReal
ReDim aLunghette(0)
Dim clsL,collLunghette
Set collLunghette = GetNewCollection
sChrSep = " "
ScegliNumeri(aLunghette)
nClasse = CInt(InputBox(" classe sviluppo ",,2))
nTotLunghette = InitSviluppoIntegrale(aLunghette,nClasse)
k = 0
Do While GetCombSviluppo(aLunghette)
k = k + 1
Set clsL = New clsLunghetta
Call clsL.Init(aLunghette,sChrSep,Inizio,Fine,aRuote,Sorte)
If clsL.IsCondizioneRispettata(idFiltro,qIncr) Then
Call clsL.EseguiStatistica
collLunghette.Add clsL
End If
If k Mod 50 = 0 Then
Call Messaggio("Righe esaminate " & k & " valide " & collLunghette. count)
DoEventsEx
Call AvanzamentoElab(1,nTotLunghette,k)
If ScriptInterrotto Then Exit Do
End If
Loop
Scrivi "Range analisi : " & GetInfoEstrazione(Inizio) & " - " & GetInfoEstrazione(Fine)
Scrivi "Lunghette esaminate : " & nTotLunghette & " Valide : " & collLunghette.count
Scrivi "Sorte : " & NomeSorte(Sorte)
Scrivi "Ruote : " & StringaRuote(aRuote)
Scrivi "Numero Minimo IncrRit : " & Format2(qIncr)
Scrivi
Scrivi "Lunghette ordinate per incremento ritardo max",True,,vbYellow
Call Scrivi
If collLunghette.count > 0 Then
Call OrdinaItemCollection(collLunghette,"IncrRitMax",,,- 1)
For Each clsL In collLunghette
If nDistanza = 0 Then
Call Scrivi("Numeri Formazione : " & clsL.LunghettaString)
Else
sNumReal=clsL.TrasformaArrayNumVirToNumReal(nDistanza,bPrimaEstrFissa)
Call Scrivi("Numeri Formazione : " & clsL.LunghettaString & " " & "NumeriReali : " & sNumReal)
End If
Call Scrivi("Ritardo : " & clsL.Ritardo)
Call Scrivi("RitMax : " & clsL.RitardoMax)
Call Scrivi("Freq : " & clsL.Frequenza)
Call Scrivi("IncrRitMx : " & clsL.IncrRitMax)
Call Scrivi("IncrRitMaxSto : " & clsL.IncrRitMaxSto)
Call Scrivi("strIncrementi : " & clsL.strIncRitMaxSto)
Call Scrivi("Numero Incrementi : " & clsL.iNumIncrementi)
Call clsL.DisegnaGraficoIncrRitMax
Next
Else
Scrivi "Nessuna lunghetta rispetta le condizioni"
Scrivi "Lunghette esaminate " & nTotLunghette
End If
End Sub

Intanto grazie per tutta l'energia neuronica e il tempo speso.
Dopo tutto il lavoro che hai fatto non so come dirtelo grandissimo i legend...

Questa tua ultima complessa versione non risolve mi sembra (ma forse mi sono sbagliato io nei passaggi) il problema della generazione randomica delle colonne volute della classe voluta...

In sostanza nella modalità casuale (2° opzione) chiede sempre e soltanto quante colonne valide ricercare (come prima) senza dare la possibilità di generare in modo random le colonne volute della classe voluta. Infatti se superiamo la classe 10 mi pare lo script rilascia ancora un output bianco.

Poi a differenza della precedente versione che non dava errore nella sezione sviluppo tabellare (3° opzione con modalità integrale) adesso da errore e si blocca

se si supera la classe 10.

Mi spiace ma tocca fare anche il pignolo ogni tanto per aiutare i due maestri all'opera (ho scritto 2 maestri perchè tale sei già i legend per i programmatori alle prime armi come potrei essere io ad esempio

e anche per chi ne capisce anche molto di più credo) Ciao!

i legend · 6 Dicembre 2015

ciao Tom grazie per i complimenti ma il maestro è il mitico Luigi
allora Punto 1 )
nello sviluppo random se tu alzi il limite degli esiti che vuoi non hai problemi se scrivi ad esempio 100 ed esistessero solo 80 casi positivi continua finche non lo fermi tu. perche lui ne deve trovare almeno 100.
secondo me non è utile come sub come scegli numeri
allora punto 2
Il Limite delle Lunghette classe 10 lo ha inserito luigi
in

Codice:

AnalisiLunghetteFromNumeriCasuali(Inizio,Fine,aRuote,Sorte,idFiltro,qIncr,bPrimaEstrFissa,nDistanza)
'
'
'
If nTotLunghette > 0 And nClasse >= Sorte And nClasse <= 10 Then
'al posto di nClasse<=10 metti il numero che vuoi te ma seLuigi ha messo il limite ci deve essere un 'motivo magari ti parte in errore

Sentiamo anche Luigi ,magari non ho capito le tue richieste e se si possono scrivere lo faccio volentieri,
intanto ho inserito la voce del filtro
definitivo?

Codice:

Option Explicit
Class clsLunghetta
    Private aNumeri ' contiene i numeri della lunghetta
    Private mInizio,mFine,aRuote,mSorte ' parametri per il range analisi
    Private mClasse ' contine la classe della lunghetta
    Private aElencoRit ' conterra l'elenco dei ritardi per la lunghetta
    Private aIdEstrElencoRit ' conterra l'elenco dei ritardi per la lunghetta
    Private aElencoIncrRitMax ' contiene l'elnco degli incrementi del ritardo max
    Private aIdEstrIncrRitMax ' conterra l'elenco degli id estrazione in
    ' cui si è registrato l'incremento del ritmax conosciuto
    Private aRitardiAllIncremento ' contiene il valore del ritardo all'idestrazione in cui
    ' si è verificato l'incremento
    Private mRitardo,mRitardoMax,mIncrRitMax,mFrequenza ' valori statistici
    Private mIncrRitardoMaxSto,mStrIncRitSto
    'Private mDist,mbPrimaEstrFissa
    Public Property Get iNumIncrementi
        iNumIncrementi = UBound(aElencoIncrRitMax)
    End Property
    Public Property Get IncrRitMaxSto
        IncrRitMaxSto = mIncrRitardoMaxSto
    End Property
    Public Property Get strIncRitMaxSto
        strIncRitMaxSto = mStrIncRitSto
    End Property
    Public Property Get Ritardo
        Ritardo = mRitardo
    End Property
    Public Property Get RitardoMax
        RitardoMax = mRitardoMax
    End Property
    Public Property Get IncrRitMax
        IncrRitMax = mIncrRitMax
    End Property
    Public Property Get Frequenza
        Frequenza = mFrequenza
    End Property
    Public Property Get LunghettaString
        LunghettaString = StringaNumeri(aNumeri)
    End Property
    ' inizializza le proprietà dell'oggetto
    Sub Init(sLunghetta,sChrSep,RangeInizio,RangeFine,vetRuote,SorteInGioco)
        ' acquisisco i parametri per l'analisi
        mInizio = RangeInizio
        mFine = RangeFine
        aRuote = vetRuote
        mSorte = SorteInGioco
        ' alimento il vettore con i numeri della lunghetta
        Call AlimentaVettoreLunghetta(sLunghetta,sChrSep)
        ' calcolo l'elenco dei ritardi
        Call ElencoRitardiTurbo(aNumeri,aRuote,mSorte,mInizio,mFine,aElencoRit,aIdEstrElencoRit)
        ' alimento il vettore che contien l'elenco degli incrementi rit max
        Call AlimentaVettoreIncrRitMax
    End Sub
    ' esegue il calcolo dei valori statistici della lunghetta
    Sub EseguiStatistica
        Call StatisticaFormazioneTurbo(aNumeri,aRuote,mSorte,mRitardo,mRitardoMax,mIncrRitMax,mFrequenza,mInizio,mFine)
    End Sub
    Private Sub AlimentaVettoreLunghetta(sLunghetta,sChrSep)
        Dim k
        If IsArray(sLunghetta) Then
            ' se la lunghetta è gia un array lo copio nel vettore locale dei numeri
            ReDim aNumeri(UBound(sLunghetta))
            For k = 1 To UBound(sLunghetta)
                aNumeri(k) = sLunghetta(k)
            Next
        Else
            ' antepongo un carattere separatore per fare in modo che
            ' aNumeri si valorizzi dall'indice 1 (senno si sarebeb valorizzato dall'indice 0)
            Call SplitByChar((sChrSep & sLunghetta),sChrSep,aNumeri)
        End If
        ' valorizzo la classe della lunghetta
        mClasse = UBound(aNumeri)
    End Sub
    Private Sub AlimentaVettoreIncrRitMax
        Dim nRitMax,nIncr,nId,k
        nId = 0
        ' inizializzo il vettore a 0 elementi
        ReDim aElencoIncrRitMax(0)
        ReDim aIdEstrIncrRitMax(0)
        ReDim aRitardiAllIncremento(0)
        ' ciclo sul vettore dei ritardi
        For k = 1 To UBound(aElencoRit)
            ' se il ritardo corrente supera il ritmax attuale..
            If aElencoRit(k) > nRitMax Then
                If nRitMax > 0 Then
                    ' se il ritmax attuale è >0 (ivvero ne esiste uno)
                    ' calcolo di quanto si è incrementato
                    nIncr = aElencoRit(k) - nRitMax
                    ' incremento il contatore dei valori trovati
                    nId = nId + 1
                    ' ridimensiono il vettore mantenendo i valori precedenti ma
                    ' aggiungendone uno
                    ReDim Preserve aElencoIncrRitMax(nId)
                    ' memorizzo il valore
                    aElencoIncrRitMax(nId) = nIncr
                    ' ridimensiono il vettore mantnendo i valori precedenti ma
                    ' aggiungendone uno
                    ReDim Preserve aIdEstrIncrRitMax(nId)
                    ' memorizzo l'id dell'estrazione dove si è avuto l'incremento
                    aIdEstrIncrRitMax(nId) = aIdEstrElencoRit(k)
                    ' ridimensiono il vettore mantnendo i valori precedenti ma
                    ' aggiungendone uno
                    ReDim Preserve aRitardiAllIncremento(nId)
                    ' memorizzo il valore del ritardo all'id dell'estrazione dove si è avuto l'incremento
                    aRitardiAllIncremento(nId) = aElencoRit(k)
                End If
                nRitMax = aElencoRit(k)
            End If
        Next
        mStrIncRitSto = StringaNumeri(aElencoIncrRitMax,,True)
    End Sub
    Function IsCondizioneRispettata(nIdFiltro,nQIncr)
        ' verifica che l'incremento dell'ultimo ritmax sia uguale al massimo incr rit max conosciuto.
        Dim nUpper
        nUpper = UBound(aElencoIncrRitMax)
        mIncrRitardoMaxSto = MassimoV(aElencoIncrRitMax,1,nUpper - 1)
        If aElencoRit(UBound(aElencoRit)) > 0 And aIdEstrIncrRitMax(nUpper) = mFine And nUpper >= nQIncr Then
            Select Case nIdFiltro
            Case 0
                IsCondizioneRispettata =(aElencoIncrRitMax(nUpper) = mIncrRitardoMaxSto)
            Case 1
                IsCondizioneRispettata =(aElencoIncrRitMax(nUpper) >= mIncrRitardoMaxSto)
            Case 2
                IsCondizioneRispettata =(aElencoIncrRitMax(nUpper) <= mIncrRitardoMaxSto)
            End Select
        Else
            IsCondizioneRispettata = False
        End If
    End Function
    'Scrivo la funzione Importo i Parametri ma non li dichiaro private sono solo nella funzione
    Function TrasformaArrayNumVirToNumReal(iDist,bPrimaEstrFiss)
        Dim k
        Dim sNumreal
        sNumreal = ""
        For k = 1 To UBound(aNumeri)
            sNumreal = sNumreal & Format2(NumVirtToNumReale(aNumeri(k),bPrimaEstrFiss,mFine,iDist)) & "."
        Next
        sNumreal = RimuoviLastChr(sNumreal,".")
        TrasformaArrayNumVirToNumReal = sNumreal
    End Function
    Sub DisegnaGraficoIncrRitMax
        Dim x,y,k
        Dim nValoreMaxX,nValoreMaxY,nValoreMinX
        Dim nStepX,nStepY
        Dim nUpperVetIncrRit
        nValoreMinX = MinimoV(aIdEstrIncrRitMax,1)
        nValoreMaxX = aIdEstrIncrRitMax(UBound(aIdEstrIncrRitMax))
        nValoreMaxY = MassimoV(aElencoRit,1)
        nStepX =(nValoreMaxX -(mInizio - 1)) \10
        nStepY = nValoreMaxY \10
        Call PreparaGrafico("Formaziione " & StringaNumeri(aNumeri),nValoreMinX,nValoreMaxX,0,nValoreMaxY,nStepX,nStepY)
        nUpperVetIncrRit = UBound(aElencoIncrRitMax)
        ' linea dell'incremento rit max
        ReDim aV(nUpperVetIncrRit - 1,2)
        For k = 1 To nUpperVetIncrRit
            x = aIdEstrIncrRitMax(k)
            y = aElencoIncrRitMax(k)
            aV(k - 1,1) = x
            aV(k - 1,2) = y
        Next
        Call DisegnaLineaGrafico(aV,vbRed,"IncrRitMax")
        ' linea dell' rit max
        ReDim aV(nUpperVetIncrRit - 1,2)
        For k = 1 To nUpperVetIncrRit
            x = aIdEstrIncrRitMax(k)
            y = aRitardiAllIncremento(k)
            aV(k - 1,1) = x
            aV(k - 1,2) = y
        Next
        Call DisegnaLineaGrafico(aV,vbBlue,"RitMax")
        ' scrive grafico nell'output
        Call InserisciGrafico
    End Sub
End Class
Sub Main
    Dim sDir,Inizio,Fine,sFile,sFileCompleto,aRuote,Sorte
    Dim bOk,idFiltro,qIncr
    Dim bPrimaEstrFissa,nDistanza
    sDir = GetDirectoryAppData & "ArchiviVirtuali\"
    sFile = ScegliFileArchivioVirt(sDir)
    'preimposto a False x valutare qualsiasi sFile<>""
    bPrimaEstrFissa = False
    If sFile <> "" Then
        sFileCompleto = sDir & sFile & ".dat"
        bOk = ApriFileBaseDati(sFileCompleto)
        bPrimaEstrFissa = True
        nDistanza = GetValoreFraSeparatori(sFile,"(",")")
    Else
        bOk = True ' archivio normale
        nDistanza = 0 ' archivio Reale
    End If
    If bOk Then
        If ScegliRange(Inizio,Fine) Then
            Sorte = ScegliEsito
            Call ScegliRuote(aRuote,Nothing)
            ' decido il filtro in base al valore degli incrementi
            idFiltro = GetIdFiltro
            ' decido di filtrare in base al numero degli incrementi
            qIncr = GetQuantiIncrementi
            If(Fine > Inizio) And UBound(aRuote) > 0 And Sorte > 0 And idFiltro > - 1 Then
                Call Scrivi("Archivio : " & Iif(sFile <> "",sFile,"Archivio lotto"))
                Select Case ScegliTipoSviluppo
                Case 1
                    Call AnalisiLunghetteFromFileTxt(Inizio,Fine,aRuote,Sorte,idFiltro,qIncr,bPrimaEstrFissa,nDistanza)
                Case 2
                    Call AnalisiLunghetteFromNumeriCasuali(Inizio,Fine,aRuote,Sorte,idFiltro,qIncr,bPrimaEstrFissa,nDistanza)
                Case 3
                    Call AnalisiLunghetteFromSceglinumeri(Inizio,Fine,aRuote,Sorte,idFiltro,qIncr,bPrimaEstrFissa,nDistanza)
                End Select
            End If
        End If
    End If
End Sub
Function ScegliFileArchivioVirt(sDir)
    Dim i
    ReDim aFile(0)
    Call ElencoFileInDirectory(sDir,aFile,".dat")
    aFile(0) = "Archivio reale"
    i = ScegliOpzioneMenu(aFile,0,"Scegli archivio virtuale")
    If i > 0 Then
        ScegliFileArchivioVirt = aFile(i)
    Else
        ScegliFileArchivioVirt = ""
    End If
End Function
Function ScegliTipoSviluppo
    ReDim aVoci(3)
    aVoci(1) = "Da file .txt"
    aVoci(2) = "Da sviluppo casuale"
    aVoci(3) = "Da Selezione Utente"
    ScegliTipoSviluppo = ScegliOpzioneMenu(aVoci,1,"SelezionaSviluppo")
End Function
Function GetChrSepFromRiga(sRiga)
    Dim k,schr
    schr = ""
    For k = 1 To Len(sRiga)
        schr = Mid(sRiga,k,1)
        If IsNumeric(schr) = False Then
            Exit For
        End If
    Next
    GetChrSepFromRiga = schr
End Function
'Function GetIdFiltro
'Dim aFiltro
'aFiltro = Array("IncrRitMaxSto=UltimoIncrRitMax","IncrRitMaxSto<=UltimoIncrRitMax","IncrRitMaxSto>=UltimoIncrRitMax")
'GetIdFiltro = ScegliOpzioneMenu(aFiltro,0,"Select Filtro Condizione")
'End Function
Function GetIdFiltro
    Dim aFiltro(2)
    aFiltro(0) = "aElencoIncrRitMax(nUpper) = mIncrRitardoMaxSto"
    aFiltro(1) = "aElencoIncrRitMax(nUpper) >= mIncrRitardoMaxSto"
    aFiltro(2) = "aElencoIncrRitMax(nUpper) <= mIncrRitardoMaxSto"
    GetIdFiltro = ScegliOpzioneMenu(aFiltro,0,"Select Filtro Condizione")
End Function
Function ScriviFiltro(idFiltro)
    Select Case idFiltro
    Case 0
        ScriviFiltro =("aElencoIncrRitMax(nUpper) = mIncrRitardoMaxSto")
    Case 1
        ScriviFiltro =("aElencoIncrRitMax(nUpper) >= mIncrRitardoMaxSto")
    Case 2
        ScriviFiltro=("aElencoIncrRitMax(nUpper) <= mIncrRitardoMaxSto")
    End Select
End Function
Function GetQuantiIncrementi
    GetQuantiIncrementi = CInt(InputBox("qIncr>=(NumeroIncrementiRitMaxFormazione)","Filtro Quantitaà Incrementi",5))
End Function
' Questa è la nuova routine che impedisce di scrivere i doppi
' ma non mpedisce di incrementare nTrov
'Sub AddLunghetta(collLunghette,clsL)
'On Error Resume Next
'collLunghette.Add clsL ,"k"&clsL.LunghettaString
'End Sub
Function AddLunghetta(collLunghette,clsL)
    On Error Resume Next
    collLunghette.Add clsL,"k" & clsL.LunghettaString
    If Err = 0 Then
        AddLunghetta = True
    Else
        AddLunghetta = False
    End If
    Err.Clear
End Function
Function GetValoreFraSeparatori(sFile,CharSep1,CharSep2)
    Dim k
    Dim i,f,sVal
    i = InStr(1,sFile,CharSep1) + 1
    f = InStr(i,sFile,CharSep2)
    GetValoreFraSeparatori = Int(Mid(sFile,i,f - i))
End Function
Sub AnalisiLunghetteFromFileTxt(Inizio,Fine,aRuote,Sorte,idFiltro,qIncr,bPrimaEstrFissa,nDistanza)
    Dim sFile,aLunghette,nTotLunghette
    Dim k,sChrSep,sNumReal
    Dim clsL,collLunghette
    Set collLunghette = GetNewCollection
    sFile = ScegliFile(GetDirectoryAppData,".txt")
    If FileEsistente(sFile) Then
        Call LeggiRigheFileDiTesto(sFile,aLunghette)
        nTotLunghette = UBound(aLunghette)
        If nTotLunghette > 0 Then
            sChrSep = GetChrSepFromRiga(aLunghette(1))
            For k = 0 To nTotLunghette
                Set clsL = New clsLunghetta
                Call clsL.Init(aLunghette(k),sChrSep,Inizio,Fine,aRuote,Sorte)
                If clsL.IsCondizioneRispettata(idFiltro,qIncr) Then
                    Call clsL.EseguiStatistica
                    collLunghette.Add clsL
                End If
                If k Mod 50 = 0 Then
                    Call Messaggio("Righe esaminate : " & k)
                    Call AvanzamentoElab(1,nTotLunghette,k)
                    If ScriptInterrotto Then Exit For
                End If
            Next
            Scrivi "Range analisi         : " & GetInfoEstrazione(Inizio) & " - " & GetInfoEstrazione(Fine)
            Scrivi "Filtro Esaminato      : " & ScriviFiltro(idFiltro)
            Scrivi "Lunghette esaminate   : " & nTotLunghette & " Valide : " & collLunghette.count
            Scrivi "Sorte                 : " & NomeSorte(Sorte)
            Scrivi "Ruote                 : " & StringaRuote(aRuote)
            Scrivi "Numero Minimo IncrRit : " & Format2(qIncr)
            Scrivi
            Scrivi "Lunghette ordinate per incremento ritardo max",True,,vbYellow
            Call Scrivi
            If collLunghette.count > 0 Then
                Call OrdinaItemCollection(collLunghette,"IncrRitMax",,,- 1)
                For Each clsL In collLunghette
                    If nDistanza = 0 Then
                        Call Scrivi("Numeri Formazione     : " & clsL.LunghettaString)
                    Else
                        sNumReal = clsL.TrasformaArrayNumVirToNumReal(nDistanza,bPrimaEstrFissa)
                        Call Scrivi("Numeri Formazione     : " & clsL.LunghettaString & "   " & "NumeriReali   : " & sNumReal)
                    End If
                    Call Scrivi("Ritardo               : " & clsL.Ritardo)
                    Call Scrivi("RitMax                : " & clsL.RitardoMax)
                    Call Scrivi("Freq                  : " & clsL.Frequenza)
                    Call Scrivi("IncrRitMx             : " & clsL.IncrRitMax)
                    Call Scrivi("IncrRitMaxSto         : " & clsL.IncrRitMaxSto)
                    Call Scrivi("strIncrementi         : " & clsL.strIncRitMaxSto)
                    Call Scrivi("Numero Incrementi     : " & clsL.iNumIncrementi)
                    Call clsL.DisegnaGraficoIncrRitMax
                Next
            Else
                Scrivi "Nessuna lunghetta rispetta le condizioni"
                Scrivi "Lunghette esaminate " & nTotLunghette + 1
            End If
        End If
    End If
End Sub
Sub AnalisiLunghetteFromNumeriCasuali(Inizio,Fine,aRuote,Sorte,idFiltro,qIncr,bPrimaEstrFissa,nDistanza)
    Dim sFile,aLunghette,nTotLunghette,nClasse
    Dim nTrov,nProdotte,sNumReal
    Dim clsL,collLunghette
    ReDim aSelNum(0)
    Set collLunghette = GetNewCollection
    nTotLunghette = Int(InputBox("Quante lunghette devono essere trovate ?",,10))
    ScegliNumeri(aSelNum)
    nClasse = Int(InputBox("Quanti numeri nella lunghetta",,Sorte))
    If nTotLunghette > 0 And nClasse >= Sorte And nClasse <= 10 Then
        nTrov = 0
        nProdotte = 0
        Do While nTrov <= nTotLunghette
            Set clsL = New clsLunghetta
            ReDim aNum(nClasse)
            Call GetColonnaCasuale(nClasse,aNum,aSelNum)
            nProdotte = nProdotte + 1
            Call clsL.Init(aNum,"",Inizio,Fine,aRuote,Sorte)
            If clsL.IsCondizioneRispettata(idFiltro,qIncr) Then
                Call clsL.EseguiStatistica
                ' Call AddLunghetta(collLunghette,clsL)
                'nTrov = collLunghette.count
                If AddLunghetta(collLunghette,clsL) Then nTrov = nTrov + 1
            End If
            If nProdotte Mod 50 = 0 Then
                Call Messaggio("combinazioni esaminate " & nProdotte & " valide " & nTrov)
                Call DoEventsEx
                If ScriptInterrotto Then Exit Do
            End If
        Loop
        Scrivi "Range analisi         : " & GetInfoEstrazione(Inizio) & " - " & GetInfoEstrazione(Fine)
        Scrivi "Filtro Esaminato      : " & ScriviFiltro(idFiltro)
        Scrivi "Lunghette esaminate   : " & nProdotte & " Valide : " & collLunghette.count
        Scrivi "Sorte                 : " & NomeSorte(Sorte)
        Scrivi "Ruote                 : " & StringaRuote(aRuote)
        Scrivi "Numero Minimo IncrRit : " & Format2(qIncr)
        Scrivi
        Scrivi "Lunghette ordinate per incremento ritardo max",True,,vbYellow
        Call Scrivi
        If collLunghette.count > 0 Then
            Call OrdinaItemCollection(collLunghette,"IncrRitMax",,,- 1)
            For Each clsL In collLunghette
                If nDistanza = 0 Then
                    Call Scrivi("Numeri Formazione     : " & clsL.LunghettaString)
                Else
                    sNumReal = clsL.TrasformaArrayNumVirToNumReal(nDistanza,bPrimaEstrFissa)
                    Call Scrivi("Numeri Formazione     : " & clsL.LunghettaString & "   " & "NumeriReali   : " & sNumReal)
                End If
                Call Scrivi("Ritardo               : " & clsL.Ritardo)
                Call Scrivi("RitMax                : " & clsL.RitardoMax)
                Call Scrivi("Freq                  : " & clsL.Frequenza)
                Call Scrivi("IncrRitMx             : " & clsL.IncrRitMax)
                Call Scrivi("IncrRitMaxSto         : " & clsL.IncrRitMaxSto)
                Call Scrivi("strIncrementi         : " & clsL.strIncRitMaxSto)
                Call Scrivi("Numero Incrementi     : " & clsL.iNumIncrementi)
                Call clsL.DisegnaGraficoIncrRitMax
            Next
        Else
            Scrivi "Nessuna lunghetta rispetta le condizioni"
            Scrivi "Lunghette esaminate " & nTotLunghette
        End If
    End If
End Sub
Sub AnalisiLunghetteFromSceglinumeri(Inizio,Fine,aRuote,Sorte,idFiltro,qIncr,bPrimaEstrFissa,nDistanza)
    Dim nTotLunghette
    Dim k,sChrSep,nClasse,sNumReal
    ReDim aLunghette(0)
    Dim clsL,collLunghette,FiltroEsaminato
    Set collLunghette = GetNewCollection
    FiltroEsaminato = ScriviFiltro(idFiltro)
    sChrSep = " "
    ScegliNumeri(aLunghette)
    nClasse = CInt(InputBox(" classe sviluppo ",,2))
    nTotLunghette = InitSviluppoIntegrale(aLunghette,nClasse)
    k = 0
    Do While GetCombSviluppo(aLunghette)
        k = k + 1
        Set clsL = New clsLunghetta
        Call clsL.Init(aLunghette,sChrSep,Inizio,Fine,aRuote,Sorte)
        If clsL.IsCondizioneRispettata(idFiltro,qIncr) Then
            Call clsL.EseguiStatistica
            collLunghette.Add clsL
        End If
        If k Mod 50 = 0 Then
            Call Messaggio("Righe esaminate " & k & "  valide " & collLunghette. count)
            DoEventsEx
            Call AvanzamentoElab(1,nTotLunghette,k)
            If ScriptInterrotto Then Exit Do
        End If
    Loop
    Scrivi "Range analisi         : " & GetInfoEstrazione(Inizio) & " - " & GetInfoEstrazione(Fine)
    Scrivi "Filtro Esaminato      : " & FiltroEsaminato
    Scrivi "Lunghette esaminate   : " & nTotLunghette & " Valide : " & collLunghette.count
    Scrivi "Sorte                 : " & NomeSorte(Sorte)
    Scrivi "Ruote                 : " & StringaRuote(aRuote)
    Scrivi "Numero Minimo IncrRit : " & Format2(qIncr)
    Scrivi
    Scrivi "Lunghette ordinate per incremento ritardo max",True,,vbYellow
    Call Scrivi
    If collLunghette.count > 0 Then
        Call OrdinaItemCollection(collLunghette,"IncrRitMax",,,- 1)
        For Each clsL In collLunghette
            If nDistanza = 0 Then
                Call Scrivi("Numeri Formazione     : " & clsL.LunghettaString)
            Else
                sNumReal = clsL.TrasformaArrayNumVirToNumReal(nDistanza,bPrimaEstrFissa)
                Call Scrivi("Numeri Formazione     : " & clsL.LunghettaString & "   " & "NumeriReali   : " & sNumReal)
            End If
            Call Scrivi("Ritardo               : " & clsL.Ritardo)
            Call Scrivi("RitMax                : " & clsL.RitardoMax)
            Call Scrivi("Freq                  : " & clsL.Frequenza)
            Call Scrivi("IncrRitMx             : " & clsL.IncrRitMax)
            Call Scrivi("IncrRitMaxSto         : " & clsL.IncrRitMaxSto)
            Call Scrivi("strIncrementi         : " & clsL.strIncRitMaxSto)
            Call Scrivi("Numero Incrementi     : " & clsL.iNumIncrementi)
            Call clsL.DisegnaGraficoIncrRitMax
        Next
    Else
        Scrivi "Nessuna lunghetta rispetta le condizioni"
        Scrivi "Lunghette esaminate " & nTotLunghette
    End If
End Sub

LuigiB · 6 Dicembre 2015

ciao legend la modifica che voleva tom da come ho capito io era sostituire il "trova n colonne" con
un altro concetto "genera n colonne e poi fermati quelle che trovi trovi"

riguardo lo sviluppo tabellare non so che errore da , il limite 10 dipende dalla funzione get colonna casuale
che mi sembra generi solo fino a classe 10 .. provare non costa nulla tuttal piu da errore

silop2005 · 6 Dicembre 2015

Eccomi.......

Ciao LuigiB e i legend ,

ho avviato il tuo ultimo script quello delle ore 21:26 del 06/12/2015

con SPMT vers. 1.5.66 e plug in SVP vers. 1.0.50

(il plug in SVP mi è servito per vedere per i sistemi analizzati quali erano i numeri convertiti in : NumInGioco)

come infatti lo script VA BENE ma non mette i numeri in gioco ma bensì i numeri reali

i quali non servono per una eventuale giocata all'estrazione successiva.

Comunque il problema è risolvibile facilmente, basta SOMMARE ai numeri reali

la [D] dei sistemi elaborati. Nel nostro caso D(1) e D(11) si sommano ai numeri reali

delle terzine e si ottengono i numeri in gioco.

Oppure vedrà il prof come far evidenziare in output i : NumInGioco.

========================

Una domanda per i legend che significa quel numero 27 e il numero 28 (li ho colorati BLU) ?

========================

Per sistema D(90) va bene perché sono gli stessi NumV = NumInGioco

========================

Poi ti avevo chiesto di mettere visto che già lo faceva lo script di LuigiB :

combinazioni presenti (59)_____combinazioni valide (4)

========================

Ecco l'output con il tuo ultimo script :

========================

1^ condizione

Archivio : SVP D(90) ConFissi [3950]_P1

28

Range analisi : [00001] [ 37] 14.09.1946 - [05139] [143] 28.11.2015

Lunghette esaminate : 117479 Valide : 1

Sorte : Ambo

Ruote : TT

Numero Minimo IncrRit : 05

Lunghette ordinate per incremento ritardo max

Numeri Formazione : .17.24.27 NumeriReali : 17.24.27

Ritardo : 82

RitMax : 82

Freq : 354

IncrRitMx : 14

IncrRitMaxSto : 14

strIncrementi : 05.01.01.14.06.08.04.01.06.14

Numero Incrementi : 10

1^ condizione

Archivio : SVP D(1) ConFissi [3950]_P1

27

Range analisi : [00001] [ 37] 14.09.1946 - [05139] [143] 28.11.2015

Lunghette esaminate : 117479 Valide : 4

Sorte : Ambo

Ruote : TT

Numero Minimo IncrRit : 05

Lunghette ordinate per incremento ritardo max

Numeri Formazione : .29.47.88 NumeriReali : 37.55.06

Ritardo : 113

RitMax : 113

Freq : 422

IncrRitMx : 38

IncrRitMaxSto : 38

strIncrementi : 08.38.07.18.38

Numero Incrementi : 5

Numeri Formazione : .01.16.19 NumeriReali : 09.24.27

Ritardo : 102

RitMax : 102

Freq : 364

IncrRitMx : 28

IncrRitMaxSto : 28

strIncrementi : 28.03.15.04.28

Numero Incrementi : 5

Numeri Formazione : .18.28.35 NumeriReali : 26.36.43

Ritardo : 82

RitMax : 82

Freq : 388

IncrRitMx : 18

IncrRitMaxSto : 18

strIncrementi : 04.01.18.05.03.18

Numero Incrementi : 6

Numeri Formazione : .15.37.54 NumeriReali : 23.45.62

Ritardo : 78

RitMax : 78

Freq : 411

IncrRitMx : 17

IncrRitMaxSto : 17

strIncrementi : 17.13.02.04.17

Numero Incrementi : 5

1^ condizione

Archivio : SVP D(11) ConFissi [3950]_P1

28

Range analisi : [00001] [ 37] 14.09.1946 - [05139] [143] 28.11.2015

Lunghette esaminate : 117479 Valide : 4

Sorte : Ambo

Ruote : TT

Numero Minimo IncrRit : 05

Lunghette ordinate per incremento ritardo max

Numeri Formazione : .36.60.70 NumeriReali : 34.58.68

Ritardo : 128

RitMax : 128

Freq : 422

IncrRitMx : 25

IncrRitMaxSto : 25

strIncrementi : 24.05.14.25.18.25

Numero Incrementi : 6

Numeri Formazione : .03.36.49 NumeriReali : 01.34.47

Ritardo : 104

RitMax : 104

Freq : 370

IncrRitMx : 18

IncrRitMaxSto : 18

strIncrementi : 14.03.07.18.07.18

Numero Incrementi : 6

Numeri Formazione : .17.38.48 NumeriReali : 15.36.46

Ritardo : 82

RitMax : 82

Freq : 391

IncrRitMx : 13

IncrRitMaxSto : 13

strIncrementi : 07.04.03.01.01.08.13.05.06.05.12.13

Numero Incrementi : 12

Numeri Formazione : .16.36.70 NumeriReali : 14.34.68

Ritardo : 58

RitMax : 58

Freq : 451

IncrRitMx : 7

IncrRitMaxSto : 7

strIncrementi : 04.03.02.07.05.07

Numero Incrementi : 6

======================

Controlla con il post precedente l'unica differenza sono i numeri reali che bisogna cambiare in NumInGioco.

========================

Buona notte a tutti.

A presto

Silop

PS

x i legend

Silop ma a casa hai una biblioteca sul lotto?

========================

…. direi non proprio una biblioteca, ma un bel po di "roba" di tutti i generi,

dalla cabala allo scientifico, accumulata in molti anni di ricerche

( non ti dico quanti anni …. ehehehe) che conservo gelosamente nell'armadio.

Che nelle varie occasioni vado a rispolverare/rileggere per me e per i posteri appassionati.

lotto_tom75 · 6 Dicembre 2015

i legend;n1942117 ha scritto:

ciao Tom grazie per i complimenti ma il maestro è il mitico Luigi
allora Punto 1 )
nello sviluppo random se tu alzi il limite degli esiti che vuoi non hai problemi se scrivi ad esempio 100 ed esistessero solo 80 casi positivi continua finche non lo fermi tu. perche lui ne deve trovare almeno 100.
secondo me non è utile come sub come scegli numeri
allora punto 2
Il Limite delle Lunghette classe 10 lo ha inserito luigi
in

Codice:

AnalisiLunghetteFromNumeriCasuali(Inizio,Fine,aRuote,Sorte,idFiltro,qIncr,bPrimaEstrFissa,nDistanza)
'
'
'
If nTotLunghette > 0 And nClasse >= Sorte And nClasse <= 10 Then
'al posto di nClasse<=10 metti il numero che vuoi te ma seLuigi ha messo il limite ci deve essere un 'motivo magari ti parte in errore

Sentiamo anche Luigi ,magari non ho capito le tue richieste e se si possono scrivere lo faccio volentieri,
intanto ho inserito la voce del filtro
definitivo?

Codice:

Option Explicit
Class clsLunghetta
Private aNumeri ' contiene i numeri della lunghetta
Private mInizio,mFine,aRuote,mSorte ' parametri per il range analisi
Private mClasse ' contine la classe della lunghetta
Private aElencoRit ' conterra l'elenco dei ritardi per la lunghetta
Private aIdEstrElencoRit ' conterra l'elenco dei ritardi per la lunghetta
Private aElencoIncrRitMax ' contiene l'elnco degli incrementi del ritardo max
Private aIdEstrIncrRitMax ' conterra l'elenco degli id estrazione in
' cui si è registrato l'incremento del ritmax conosciuto
Private aRitardiAllIncremento ' contiene il valore del ritardo all'idestrazione in cui
' si è verificato l'incremento
Private mRitardo,mRitardoMax,mIncrRitMax,mFrequenza ' valori statistici
Private mIncrRitardoMaxSto,mStrIncRitSto
'Private mDist,mbPrimaEstrFissa
Public Property Get iNumIncrementi
iNumIncrementi = UBound(aElencoIncrRitMax)
End Property
Public Property Get IncrRitMaxSto
IncrRitMaxSto = mIncrRitardoMaxSto
End Property
Public Property Get strIncRitMaxSto
strIncRitMaxSto = mStrIncRitSto
End Property
Public Property Get Ritardo
Ritardo = mRitardo
End Property
Public Property Get RitardoMax
RitardoMax = mRitardoMax
End Property
Public Property Get IncrRitMax
IncrRitMax = mIncrRitMax
End Property
Public Property Get Frequenza
Frequenza = mFrequenza
End Property
Public Property Get LunghettaString
LunghettaString = StringaNumeri(aNumeri)
End Property
' inizializza le proprietà dell'oggetto
Sub Init(sLunghetta,sChrSep,RangeInizio,RangeFine,vetRuote,SorteInGioco)
' acquisisco i parametri per l'analisi
mInizio = RangeInizio
mFine = RangeFine
aRuote = vetRuote
mSorte = SorteInGioco
' alimento il vettore con i numeri della lunghetta
Call AlimentaVettoreLunghetta(sLunghetta,sChrSep)
' calcolo l'elenco dei ritardi
Call ElencoRitardiTurbo(aNumeri,aRuote,mSorte,mInizio,mFine,aElencoRit,aIdEstrElencoRit)
' alimento il vettore che contien l'elenco degli incrementi rit max
Call AlimentaVettoreIncrRitMax
End Sub
' esegue il calcolo dei valori statistici della lunghetta
Sub EseguiStatistica
Call StatisticaFormazioneTurbo(aNumeri,aRuote,mSorte,mRitardo,mRitardoMax,mIncrRitMax,mFrequenza,mInizio,mFine)
End Sub
Private Sub AlimentaVettoreLunghetta(sLunghetta,sChrSep)
Dim k
If IsArray(sLunghetta) Then
' se la lunghetta è gia un array lo copio nel vettore locale dei numeri
ReDim aNumeri(UBound(sLunghetta))
For k = 1 To UBound(sLunghetta)
aNumeri(k) = sLunghetta(k)
Next
Else
' antepongo un carattere separatore per fare in modo che
' aNumeri si valorizzi dall'indice 1 (senno si sarebeb valorizzato dall'indice 0)
Call SplitByChar((sChrSep & sLunghetta),sChrSep,aNumeri)
End If
' valorizzo la classe della lunghetta
mClasse = UBound(aNumeri)
End Sub
Private Sub AlimentaVettoreIncrRitMax
Dim nRitMax,nIncr,nId,k
nId = 0
' inizializzo il vettore a 0 elementi
ReDim aElencoIncrRitMax(0)
ReDim aIdEstrIncrRitMax(0)
ReDim aRitardiAllIncremento(0)
' ciclo sul vettore dei ritardi
For k = 1 To UBound(aElencoRit)
' se il ritardo corrente supera il ritmax attuale..
If aElencoRit(k) > nRitMax Then
If nRitMax > 0 Then
' se il ritmax attuale è >0 (ivvero ne esiste uno)
' calcolo di quanto si è incrementato
nIncr = aElencoRit(k) - nRitMax
' incremento il contatore dei valori trovati
nId = nId + 1
' ridimensiono il vettore mantenendo i valori precedenti ma
' aggiungendone uno
ReDim Preserve aElencoIncrRitMax(nId)
' memorizzo il valore
aElencoIncrRitMax(nId) = nIncr
' ridimensiono il vettore mantnendo i valori precedenti ma
' aggiungendone uno
ReDim Preserve aIdEstrIncrRitMax(nId)
' memorizzo l'id dell'estrazione dove si è avuto l'incremento
aIdEstrIncrRitMax(nId) = aIdEstrElencoRit(k)
' ridimensiono il vettore mantnendo i valori precedenti ma
' aggiungendone uno
ReDim Preserve aRitardiAllIncremento(nId)
' memorizzo il valore del ritardo all'id dell'estrazione dove si è avuto l'incremento
aRitardiAllIncremento(nId) = aElencoRit(k)
End If
nRitMax = aElencoRit(k)
End If
Next
mStrIncRitSto = StringaNumeri(aElencoIncrRitMax,,True)
End Sub
Function IsCondizioneRispettata(nIdFiltro,nQIncr)
' verifica che l'incremento dell'ultimo ritmax sia uguale al massimo incr rit max conosciuto.
Dim nUpper
nUpper = UBound(aElencoIncrRitMax)
mIncrRitardoMaxSto = MassimoV(aElencoIncrRitMax,1,nUpper - 1)
If aElencoRit(UBound(aElencoRit)) > 0 And aIdEstrIncrRitMax(nUpper) = mFine And nUpper >= nQIncr Then
Select Case nIdFiltro
Case 0
IsCondizioneRispettata =(aElencoIncrRitMax(nUpper) = mIncrRitardoMaxSto)
Case 1
IsCondizioneRispettata =(aElencoIncrRitMax(nUpper) >= mIncrRitardoMaxSto)
Case 2
IsCondizioneRispettata =(aElencoIncrRitMax(nUpper) <= mIncrRitardoMaxSto)
End Select
Else
IsCondizioneRispettata = False
End If
End Function
'Scrivo la funzione Importo i Parametri ma non li dichiaro private sono solo nella funzione
Function TrasformaArrayNumVirToNumReal(iDist,bPrimaEstrFiss)
Dim k
Dim sNumreal
sNumreal = ""
For k = 1 To UBound(aNumeri)
sNumreal = sNumreal & Format2(NumVirtToNumReale(aNumeri(k),bPrimaEstrFiss,mFine,iDist)) & "."
Next
sNumreal = RimuoviLastChr(sNumreal,".")
TrasformaArrayNumVirToNumReal = sNumreal
End Function
Sub DisegnaGraficoIncrRitMax
Dim x,y,k
Dim nValoreMaxX,nValoreMaxY,nValoreMinX
Dim nStepX,nStepY
Dim nUpperVetIncrRit
nValoreMinX = MinimoV(aIdEstrIncrRitMax,1)
nValoreMaxX = aIdEstrIncrRitMax(UBound(aIdEstrIncrRitMax))
nValoreMaxY = MassimoV(aElencoRit,1)
nStepX =(nValoreMaxX -(mInizio - 1)) \10
nStepY = nValoreMaxY \10
Call PreparaGrafico("Formaziione " & StringaNumeri(aNumeri),nValoreMinX,nValoreMaxX,0,nValoreMaxY,nStepX,nStepY)
nUpperVetIncrRit = UBound(aElencoIncrRitMax)
' linea dell'incremento rit max
ReDim aV(nUpperVetIncrRit - 1,2)
For k = 1 To nUpperVetIncrRit
x = aIdEstrIncrRitMax(k)
y = aElencoIncrRitMax(k)
aV(k - 1,1) = x
aV(k - 1,2) = y
Next
Call DisegnaLineaGrafico(aV,vbRed,"IncrRitMax")
' linea dell' rit max
ReDim aV(nUpperVetIncrRit - 1,2)
For k = 1 To nUpperVetIncrRit
x = aIdEstrIncrRitMax(k)
y = aRitardiAllIncremento(k)
aV(k - 1,1) = x
aV(k - 1,2) = y
Next
Call DisegnaLineaGrafico(aV,vbBlue,"RitMax")
' scrive grafico nell'output
Call InserisciGrafico
End Sub
End Class
Sub Main
Dim sDir,Inizio,Fine,sFile,sFileCompleto,aRuote,Sorte
Dim bOk,idFiltro,qIncr
Dim bPrimaEstrFissa,nDistanza
sDir = GetDirectoryAppData & "ArchiviVirtuali\"
sFile = ScegliFileArchivioVirt(sDir)
'preimposto a False x valutare qualsiasi sFile<>""
bPrimaEstrFissa = False
If sFile <> "" Then
sFileCompleto = sDir & sFile & ".dat"
bOk = ApriFileBaseDati(sFileCompleto)
bPrimaEstrFissa = True
nDistanza = GetValoreFraSeparatori(sFile,"(",")")
Else
bOk = True ' archivio normale
nDistanza = 0 ' archivio Reale
End If
If bOk Then
If ScegliRange(Inizio,Fine) Then
Sorte = ScegliEsito
Call ScegliRuote(aRuote,Nothing)
' decido il filtro in base al valore degli incrementi
idFiltro = GetIdFiltro
' decido di filtrare in base al numero degli incrementi
qIncr = GetQuantiIncrementi
If(Fine > Inizio) And UBound(aRuote) > 0 And Sorte > 0 And idFiltro > - 1 Then
Call Scrivi("Archivio : " & Iif(sFile <> "",sFile,"Archivio lotto"))
Select Case ScegliTipoSviluppo
Case 1
Call AnalisiLunghetteFromFileTxt(Inizio,Fine,aRuote,Sorte,idFiltro,qIncr,bPrimaEstrFissa,nDistanza)
Case 2
Call AnalisiLunghetteFromNumeriCasuali(Inizio,Fine,aRuote,Sorte,idFiltro,qIncr,bPrimaEstrFissa,nDistanza)
Case 3
Call AnalisiLunghetteFromSceglinumeri(Inizio,Fine,aRuote,Sorte,idFiltro,qIncr,bPrimaEstrFissa,nDistanza)
End Select
End If
End If
End If
End Sub
Function ScegliFileArchivioVirt(sDir)
Dim i
ReDim aFile(0)
Call ElencoFileInDirectory(sDir,aFile,".dat")
aFile(0) = "Archivio reale"
i = ScegliOpzioneMenu(aFile,0,"Scegli archivio virtuale")
If i > 0 Then
ScegliFileArchivioVirt = aFile(i)
Else
ScegliFileArchivioVirt = ""
End If
End Function
Function ScegliTipoSviluppo
ReDim aVoci(3)
aVoci(1) = "Da file .txt"
aVoci(2) = "Da sviluppo casuale"
aVoci(3) = "Da Selezione Utente"
ScegliTipoSviluppo = ScegliOpzioneMenu(aVoci,1,"SelezionaSviluppo")
End Function
Function GetChrSepFromRiga(sRiga)
Dim k,schr
schr = ""
For k = 1 To Len(sRiga)
schr = Mid(sRiga,k,1)
If IsNumeric(schr) = False Then
Exit For
End If
Next
GetChrSepFromRiga = schr
End Function
'Function GetIdFiltro
'Dim aFiltro
'aFiltro = Array("IncrRitMaxSto=UltimoIncrRitMax","IncrRitMaxSto<=UltimoIncrRitMax","IncrRitMaxSto>=UltimoIncrRitMax")
'GetIdFiltro = ScegliOpzioneMenu(aFiltro,0,"Select Filtro Condizione")
'End Function
Function GetIdFiltro
Dim aFiltro(2)
aFiltro(0) = "aElencoIncrRitMax(nUpper) = mIncrRitardoMaxSto"
aFiltro(1) = "aElencoIncrRitMax(nUpper) >= mIncrRitardoMaxSto"
aFiltro(2) = "aElencoIncrRitMax(nUpper) <= mIncrRitardoMaxSto"
GetIdFiltro = ScegliOpzioneMenu(aFiltro,0,"Select Filtro Condizione")
End Function
Function ScriviFiltro(idFiltro)
Select Case idFiltro
Case 0
ScriviFiltro =("aElencoIncrRitMax(nUpper) = mIncrRitardoMaxSto")
Case 1
ScriviFiltro =("aElencoIncrRitMax(nUpper) >= mIncrRitardoMaxSto")
Case 2
ScriviFiltro=("aElencoIncrRitMax(nUpper) <= mIncrRitardoMaxSto")
End Select
End Function
Function GetQuantiIncrementi
GetQuantiIncrementi = CInt(InputBox("qIncr>=(NumeroIncrementiRitMaxFormazione)","Filtro Quantitaà Incrementi",5))
End Function
' Questa è la nuova routine che impedisce di scrivere i doppi
' ma non mpedisce di incrementare nTrov
'Sub AddLunghetta(collLunghette,clsL)
'On Error Resume Next
'collLunghette.Add clsL ,"k"&clsL.LunghettaString
'End Sub
Function AddLunghetta(collLunghette,clsL)
On Error Resume Next
collLunghette.Add clsL,"k" & clsL.LunghettaString
If Err = 0 Then
AddLunghetta = True
Else
AddLunghetta = False
End If
Err.Clear
End Function
Function GetValoreFraSeparatori(sFile,CharSep1,CharSep2)
Dim k
Dim i,f,sVal
i = InStr(1,sFile,CharSep1) + 1
f = InStr(i,sFile,CharSep2)
GetValoreFraSeparatori = Int(Mid(sFile,i,f - i))
End Function
Sub AnalisiLunghetteFromFileTxt(Inizio,Fine,aRuote,Sorte,idFiltro,qIncr,bPrimaEstrFissa,nDistanza)
Dim sFile,aLunghette,nTotLunghette
Dim k,sChrSep,sNumReal
Dim clsL,collLunghette
Set collLunghette = GetNewCollection
sFile = ScegliFile(GetDirectoryAppData,".txt")
If FileEsistente(sFile) Then
Call LeggiRigheFileDiTesto(sFile,aLunghette)
nTotLunghette = UBound(aLunghette)
If nTotLunghette > 0 Then
sChrSep = GetChrSepFromRiga(aLunghette(1))
For k = 0 To nTotLunghette
Set clsL = New clsLunghetta
Call clsL.Init(aLunghette(k),sChrSep,Inizio,Fine,aRuote,Sorte)
If clsL.IsCondizioneRispettata(idFiltro,qIncr) Then
Call clsL.EseguiStatistica
collLunghette.Add clsL
End If
If k Mod 50 = 0 Then
Call Messaggio("Righe esaminate : " & k)
Call AvanzamentoElab(1,nTotLunghette,k)
If ScriptInterrotto Then Exit For
End If
Next
Scrivi "Range analisi : " & GetInfoEstrazione(Inizio) & " - " & GetInfoEstrazione(Fine)
Scrivi "Filtro Esaminato : " & ScriviFiltro(idFiltro)
Scrivi "Lunghette esaminate : " & nTotLunghette & " Valide : " & collLunghette.count
Scrivi "Sorte : " & NomeSorte(Sorte)
Scrivi "Ruote : " & StringaRuote(aRuote)
Scrivi "Numero Minimo IncrRit : " & Format2(qIncr)
Scrivi
Scrivi "Lunghette ordinate per incremento ritardo max",True,,vbYellow
Call Scrivi
If collLunghette.count > 0 Then
Call OrdinaItemCollection(collLunghette,"IncrRitMax",,,- 1)
For Each clsL In collLunghette
If nDistanza = 0 Then
Call Scrivi("Numeri Formazione : " & clsL.LunghettaString)
Else
sNumReal = clsL.TrasformaArrayNumVirToNumReal(nDistanza,bPrimaEstrFissa)
Call Scrivi("Numeri Formazione : " & clsL.LunghettaString & " " & "NumeriReali : " & sNumReal)
End If
Call Scrivi("Ritardo : " & clsL.Ritardo)
Call Scrivi("RitMax : " & clsL.RitardoMax)
Call Scrivi("Freq : " & clsL.Frequenza)
Call Scrivi("IncrRitMx : " & clsL.IncrRitMax)
Call Scrivi("IncrRitMaxSto : " & clsL.IncrRitMaxSto)
Call Scrivi("strIncrementi : " & clsL.strIncRitMaxSto)
Call Scrivi("Numero Incrementi : " & clsL.iNumIncrementi)
Call clsL.DisegnaGraficoIncrRitMax
Next
Else
Scrivi "Nessuna lunghetta rispetta le condizioni"
Scrivi "Lunghette esaminate " & nTotLunghette + 1
End If
End If
End If
End Sub
Sub AnalisiLunghetteFromNumeriCasuali(Inizio,Fine,aRuote,Sorte,idFiltro,qIncr,bPrimaEstrFissa,nDistanza)
Dim sFile,aLunghette,nTotLunghette,nClasse
Dim nTrov,nProdotte,sNumReal
Dim clsL,collLunghette
ReDim aSelNum(0)
Set collLunghette = GetNewCollection
nTotLunghette = Int(InputBox("Quante lunghette devono essere trovate ?",,10))
ScegliNumeri(aSelNum)
nClasse = Int(InputBox("Quanti numeri nella lunghetta",,Sorte))
If nTotLunghette > 0 And nClasse >= Sorte And nClasse <= 10 Then
nTrov = 0
nProdotte = 0
Do While nTrov <= nTotLunghette
Set clsL = New clsLunghetta
ReDim aNum(nClasse)
Call GetColonnaCasuale(nClasse,aNum,aSelNum)
nProdotte = nProdotte + 1
Call clsL.Init(aNum,"",Inizio,Fine,aRuote,Sorte)
If clsL.IsCondizioneRispettata(idFiltro,qIncr) Then
Call clsL.EseguiStatistica
' Call AddLunghetta(collLunghette,clsL)
'nTrov = collLunghette.count
If AddLunghetta(collLunghette,clsL) Then nTrov = nTrov + 1
End If
If nProdotte Mod 50 = 0 Then
Call Messaggio("combinazioni esaminate " & nProdotte & " valide " & nTrov)
Call DoEventsEx
If ScriptInterrotto Then Exit Do
End If
Loop
Scrivi "Range analisi : " & GetInfoEstrazione(Inizio) & " - " & GetInfoEstrazione(Fine)
Scrivi "Filtro Esaminato : " & ScriviFiltro(idFiltro)
Scrivi "Lunghette esaminate : " & nProdotte & " Valide : " & collLunghette.count
Scrivi "Sorte : " & NomeSorte(Sorte)
Scrivi "Ruote : " & StringaRuote(aRuote)
Scrivi "Numero Minimo IncrRit : " & Format2(qIncr)
Scrivi
Scrivi "Lunghette ordinate per incremento ritardo max",True,,vbYellow
Call Scrivi
If collLunghette.count > 0 Then
Call OrdinaItemCollection(collLunghette,"IncrRitMax",,,- 1)
For Each clsL In collLunghette
If nDistanza = 0 Then
Call Scrivi("Numeri Formazione : " & clsL.LunghettaString)
Else
sNumReal = clsL.TrasformaArrayNumVirToNumReal(nDistanza,bPrimaEstrFissa)
Call Scrivi("Numeri Formazione : " & clsL.LunghettaString & " " & "NumeriReali : " & sNumReal)
End If
Call Scrivi("Ritardo : " & clsL.Ritardo)
Call Scrivi("RitMax : " & clsL.RitardoMax)
Call Scrivi("Freq : " & clsL.Frequenza)
Call Scrivi("IncrRitMx : " & clsL.IncrRitMax)
Call Scrivi("IncrRitMaxSto : " & clsL.IncrRitMaxSto)
Call Scrivi("strIncrementi : " & clsL.strIncRitMaxSto)
Call Scrivi("Numero Incrementi : " & clsL.iNumIncrementi)
Call clsL.DisegnaGraficoIncrRitMax
Next
Else
Scrivi "Nessuna lunghetta rispetta le condizioni"
Scrivi "Lunghette esaminate " & nTotLunghette
End If
End If
End Sub
Sub AnalisiLunghetteFromSceglinumeri(Inizio,Fine,aRuote,Sorte,idFiltro,qIncr,bPrimaEstrFissa,nDistanza)
Dim nTotLunghette
Dim k,sChrSep,nClasse,sNumReal
ReDim aLunghette(0)
Dim clsL,collLunghette,FiltroEsaminato
Set collLunghette = GetNewCollection
FiltroEsaminato = ScriviFiltro(idFiltro)
sChrSep = " "
ScegliNumeri(aLunghette)
nClasse = CInt(InputBox(" classe sviluppo ",,2))
nTotLunghette = InitSviluppoIntegrale(aLunghette,nClasse)
k = 0
Do While GetCombSviluppo(aLunghette)
k = k + 1
Set clsL = New clsLunghetta
Call clsL.Init(aLunghette,sChrSep,Inizio,Fine,aRuote,Sorte)
If clsL.IsCondizioneRispettata(idFiltro,qIncr) Then
Call clsL.EseguiStatistica
collLunghette.Add clsL
End If
If k Mod 50 = 0 Then
Call Messaggio("Righe esaminate " & k & " valide " & collLunghette. count)
DoEventsEx
Call AvanzamentoElab(1,nTotLunghette,k)
If ScriptInterrotto Then Exit Do
End If
Loop
Scrivi "Range analisi : " & GetInfoEstrazione(Inizio) & " - " & GetInfoEstrazione(Fine)
Scrivi "Filtro Esaminato : " & FiltroEsaminato
Scrivi "Lunghette esaminate : " & nTotLunghette & " Valide : " & collLunghette.count
Scrivi "Sorte : " & NomeSorte(Sorte)
Scrivi "Ruote : " & StringaRuote(aRuote)
Scrivi "Numero Minimo IncrRit : " & Format2(qIncr)
Scrivi
Scrivi "Lunghette ordinate per incremento ritardo max",True,,vbYellow
Call Scrivi
If collLunghette.count > 0 Then
Call OrdinaItemCollection(collLunghette,"IncrRitMax",,,- 1)
For Each clsL In collLunghette
If nDistanza = 0 Then
Call Scrivi("Numeri Formazione : " & clsL.LunghettaString)
Else
sNumReal = clsL.TrasformaArrayNumVirToNumReal(nDistanza,bPrimaEstrFissa)
Call Scrivi("Numeri Formazione : " & clsL.LunghettaString & " " & "NumeriReali : " & sNumReal)
End If
Call Scrivi("Ritardo : " & clsL.Ritardo)
Call Scrivi("RitMax : " & clsL.RitardoMax)
Call Scrivi("Freq : " & clsL.Frequenza)
Call Scrivi("IncrRitMx : " & clsL.IncrRitMax)
Call Scrivi("IncrRitMaxSto : " & clsL.IncrRitMaxSto)
Call Scrivi("strIncrementi : " & clsL.strIncRitMaxSto)
Call Scrivi("Numero Incrementi : " & clsL.iNumIncrementi)
Call clsL.DisegnaGraficoIncrRitMax
Next
Else
Scrivi "Nessuna lunghetta rispetta le condizioni"
Scrivi "Lunghette esaminate " & nTotLunghette
End If
End Sub

Ciao mito

e ciao Luigi!

Dunque vi riporto il codice di script che sarebbe bello implementare nell'opzione due (sviluppo casuale) del nostro stupendissimo script!

Codice:

Option Explicit
Sub Main


Dim k
Dim Classe
Dim aCol
ReDim aNum(90)
Dim i
Dim nSorte,Fine,RetRit1,QuantitaNumeriScelti,aRuoteSel,RuoteSelezionate,RetRitMax,RetIncrRitMax,RetFreq,Inizio
Dim ColTot,aRetcol
Dim valoreInizioelaborazione,valorefineelaborazione

Dim aRuoteTmp


ReDim aNum(0)
QuantitaNumeriScelti = ScegliNumeri(aNum)
ReDim aRuoteSel(12)


'ReDim aRuoteSel(12)
'RuoteSelezionate = ScegliRuote(aRuoteSel)


Call Scrivi(" ---------------------------------------------------------------- ")
Call Scrivi(" Le ruote sottostanti nella ricerca vengono considerate UNITE! ")
Call Scrivi(" ---------------------------------------------------------------- ")




'For k = 1 To RuoteSelezionate


'Call Scrivi("Scelta ruota " & NomeRuota(aRuoteSel(k)) & " - " & SiglaRuota(aRuoteSel(k)))


'Next




valoreInizioelaborazione = 1
valorefineelaborazione = 10000000

Classe = 30


'GetColonnaCasuale(Classe,aRetcol,aNum)


'ReDim aRuoteTmp(1)


ReDim aRuote(11)

aRuote(1) = BA_
aRuote(2) = CA_
aRuote(3) = FI_
aRuote(4) = GE_
aRuote(5) = MI_
aRuote(6) = NA_
aRuote(7) = PA_
aRuote(8) = RO_
aRuote(9) = TO_
aRuote(10) = VE_
aRuote(11) = NZ_

'aRuote(1) = TU_


'For k = 1 To RuoteSelezionate


'aRuoteTmp(2) = aRuote(2)



'Call Scrivi("Scelta ruota " & NomeRuota(aRuoteSel(k)) & " - " & ))




For i = valoreInizioelaborazione To valorefineelaborazione

Call GetColonnaCasuale(Classe,aRetcol,aNum)

Call StatisticaFormazioneTurbo(aRetcol,aRuote,nSorte,RetRit1,RetRitMax,RetIncrRitMax,RetFreq)

'Call Scrivi(StringaNumeri(aRetcol,,True))

'sorte = 1

Call AvanzamentoElab(1,valorefineelaborazione,i)


Call Messaggio("Colonna " & i)

nSorte = 1

'Call StatisticaFormazioneSE(aRetcol,nSorte,RetRit1,RetRitMax,RetIncrRitMax,RetFreq,Inizio,Fine)


Dim Diff
Diff = RetRitMax - RetRit1

'If(RetRit1 >= 0 And Diff = 0 And RetIncrRitMax = 0) Then

'If(RetRit1 >= 0 And Diff < 2 And RetIncrRitMax = 0) Then

If(RetRit1 = 0 And RetRit1 = 0 And RetRitMax = 0) Then

Call Scrivi("Ruota: " & "ruote decise" & " Colonna: " & i & " " & StringaNumeri(aRetcol,,True) & " RA " & RetRit1 & " RS " & RetRitMax & " INCMAX " & RetIncrRitMax & " FQ " & RetFreq & " Diff " & Diff)

End If





'Dim Diff
'Diff = RetRitMax - RetRit1


'If(RetRit1 >= 0) Then


'Call Scrivi(FormattaStringa(i,"00000") & " " & StringaNumeri(aCol) & " RA: " & RetRit1 & " RS: " & RetRitMax & " INCMAX: " & RetIncrRitMax & " FQ: " & RetFreq & " RUOTA: " & NomeRuota(aRuoteSel(k)) & " DIFF " & Diff)


'End If




If ScriptInterrotto Then Exit For

Next

'Next


'Loop


End Sub

Ovviamente lo script che vi ho postato sopra è solo per avere un esempio di sviluppo casuale senza limite nè di colonne sviluppabili nè sopratutto di classe. Questo script come noterete subito, nonostante funzioni alla grandissima, genera doppioni di colonne casuali che voi due maghi, con le dritte del Maestro Luigi sull'id univoco ecc..., sono sicuro potrete risolvere velocissimante ma è questo in sostanza che sarebbe da implementare nell'opzione 2 dello sviluppo casuale

'notte legend e 'notte Luigi!

'notte anche a silop

, che ho letto solo ora e che prima o poi mi dovrà insegnare qualcosa su questi sistemi paralleli che mi rimangono piuttosto ostici da digerire... ma che mi stanno cominciando ad attrarre irresistibilmente...

i legend · 6 Dicembre 2015

Tom a me ha sviluppato anche lunghette da 12 ma ho nserito 16 numeri forse tu ne hai valorizzato qualcuno in piu?
Ciao

ps: i mumeri sono reali non quelli di gioco
per quelli alla prossima puntata hihihihihihihihih

i legend · 6 Dicembre 2015

Tom a me ha sviluppato anche lunghette da 12 ma ho nserito 16 numeri forse tu ne hai valorizzato qualcuno in piu?
Ciao

X silop io ho utilizzato come partenza lo script che ha postato luigi per non fare confusione con i nomi
se mi spieghi cosa sono quelle voci le cerco oppure le riscrivo se ci riesco,
ok per i numeri in gioco vedo se riesco a fare una funzione se gia non esiste

Leggo tutto con calma
27 e 28 erano degli output che mi servivano per fare l'ultima funzione
sono la lunghezza della stringa dei virtuali nell ultimo script li ho cancellati

lotto_tom75 · 6 Dicembre 2015

i legend;n1942131 ha scritto:
Tom a me ha sviluppato anche lunghette da 12 ma ho nserito 16 numeri forse tu ne hai valorizzato qualcuno in piu?
Ciao

Carissimo ti dico solo... che con lo script che ti ho postato sopra "come riferimento" si generano anche milioni di 89ine... senza nessuna difficolta' a parte appunto il fatto che si generano pure anche i doppioni senza possibilità di gestirli.. (quindi quest ultimo aspetto andrebbe limato... prima di implementarlo nell'opzione 2 dello script scopadelico)

i legend · 6 Dicembre 2015

Tom aspetto Luigi per questo ho paura di mandare in panne qualche pc con quei numeri

Intanto cerco di completare le due sub parallelamente

xSilop
Mi sa che per armadio hai una stanza 20*20 hihihi

Notte a tutti
Ora vado a Nanna doma sveglia presto

silop2005 · 6 Dicembre 2015

buona notte anche a te e .... buon lavoro.

LuigiB · 6 Dicembre 2015

ciao legend hai piena liberta anche perche stare dietro a tutte le idee che vengono a lottotom è un impresa.uno script anche se si impalla non rompe certo il computer .. fai le tue prove e implementa le varie cose che ti chiedono.
Non ho capito escono colonne duplicate nel nostro script o in quello spezzopne proposto da tom ?

i legend · 7 Dicembre 2015

ciao a tutti ho provato a fare le modifiche che sono state richieste
ho un dubbio sui sistemi virtuali sulla trasformazione dei numeri.
Luigi potresti controllare se nella Main ho scritto bene?
il parametro bPrimaEstrFissa che torna true
nella function TrasformaArrayVirtToNumReal(nDistanza,bPrimaEstrfFissa)
se file<>"" ora nella main mi torna true
ma cosi come distinguo il calcolo delle estrazioni?
Quindi da verificare
Tom sviluppo casuale
Silop Se il valore trasormato è corretto
Luigi se non ho scritto solo un caso specifico e non che vada sempre bene
ho inserito anche il calcolo.dat
spero non si rallenti troppo
ciao

ecco il code

Codice:

Option Explicit
' Script Da Verificare
' Eliminate i filtri di nClasse x sistemi casuali .Il P.C con un elevato numero di combinazioni
' potrebbe impallarsi, anzi lo farà sicuramente
' Inserita funzione per trasformare i numeri virtuali( forse e solo Parziale e non generale)
' Un Grande grazie a Tom Richiedente lo script
' Un Grande grazie a silop che ha ampliato la ricerca con le sue conoscenze
' Un Grandissimo grazie a Luigi per i suoi INSEGNAMENTI
' Un grande saluto da I Legend [ aiutante:)]

Class clsLunghetta
    Private aNumeri ' contiene i numeri della lunghetta
    Private mInizio,mFine,aRuote,mSorte ' parametri per il range analisi
    Private mClasse ' contine la classe della lunghetta
    Private aElencoRit ' conterra l'elenco dei ritardi per la lunghetta
    Private aIdEstrElencoRit ' conterra l'elenco dei ritardi per la lunghetta
    Private aElencoIncrRitMax ' contiene l'elnco degli incrementi del ritardo max
    Private aIdEstrIncrRitMax ' conterra l'elenco degli id estrazione in
    ' cui si è registrato l'incremento del ritmax conosciuto
    Private aRitardiAllIncremento ' contiene il valore del ritardo all'idestrazione in cui
    ' si è verificato l'incremento
    Private mRitardo,mRitardoMax,mIncrRitMax,mFrequenza ' valori statistici
    Private mIncrRitardoMaxSto,mStrIncRitSto
    'Private mDist,mbPrimaEstrFissa
    Public Property Get iNumIncrementi
        iNumIncrementi = UBound(aElencoIncrRitMax)
    End Property
    Public Property Get IncrRitMaxSto
        IncrRitMaxSto = mIncrRitardoMaxSto
    End Property
    Public Property Get strIncRitMaxSto
        strIncRitMaxSto = mStrIncRitSto
    End Property
    Public Property Get Ritardo
        Ritardo = mRitardo
    End Property
    Public Property Get RitardoMax
        RitardoMax = mRitardoMax
    End Property
    Public Property Get IncrRitMax
        IncrRitMax = mIncrRitMax
    End Property
    Public Property Get Frequenza
        Frequenza = mFrequenza
    End Property
    Public Property Get LunghettaString
        LunghettaString = StringaNumeri(aNumeri)
    End Property
    ' inizializza le proprietà dell'oggetto
    Sub Init(sLunghetta,sChrSep,RangeInizio,RangeFine,vetRuote,SorteInGioco)
        ' acquisisco i parametri per l'analisi
        mInizio = RangeInizio
        mFine = RangeFine
        aRuote = vetRuote
        mSorte = SorteInGioco
        ' alimento il vettore con i numeri della lunghetta
        Call AlimentaVettoreLunghetta(sLunghetta,sChrSep)
        ' calcolo l'elenco dei ritardi
        Call ElencoRitardiTurbo(aNumeri,aRuote,mSorte,mInizio,mFine,aElencoRit,aIdEstrElencoRit)
        ' alimento il vettore che contien l'elenco degli incrementi rit max
        Call AlimentaVettoreIncrRitMax
    End Sub
    ' esegue il calcolo dei valori statistici della lunghetta
    Sub EseguiStatistica
        Call StatisticaFormazioneTurbo(aNumeri,aRuote,mSorte,mRitardo,mRitardoMax,mIncrRitMax,mFrequenza,mInizio,mFine)
    End Sub
    Private Sub AlimentaVettoreLunghetta(sLunghetta,sChrSep)
        Dim k
        If IsArray(sLunghetta) Then
            ' se la lunghetta è gia un array lo copio nel vettore locale dei numeri
            ReDim aNumeri(UBound(sLunghetta))
            For k = 1 To UBound(sLunghetta)
                aNumeri(k) = sLunghetta(k)
            Next
        Else
            ' antepongo un carattere separatore per fare in modo che
            ' aNumeri si valorizzi dall'indice 1 (senno si sarebeb valorizzato dall'indice 0)
            Call SplitByChar((sChrSep & sLunghetta),sChrSep,aNumeri)
        End If
        ' valorizzo la classe della lunghetta
        mClasse = UBound(aNumeri)
    End Sub
    Private Sub AlimentaVettoreIncrRitMax
        Dim nRitMax,nIncr,nId,k
        nId = 0
        ' inizializzo il vettore a 0 elementi
        ReDim aElencoIncrRitMax(0)
        ReDim aIdEstrIncrRitMax(0)
        ReDim aRitardiAllIncremento(0)
        ' ciclo sul vettore dei ritardi
        For k = 1 To UBound(aElencoRit)
            ' se il ritardo corrente supera il ritmax attuale..
            If aElencoRit(k) > nRitMax Then
                If nRitMax > 0 Then
                    ' se il ritmax attuale è >0 (ivvero ne esiste uno)
                    ' calcolo di quanto si è incrementato
                    nIncr = aElencoRit(k) - nRitMax
                    ' incremento il contatore dei valori trovati
                    nId = nId + 1
                    ' ridimensiono il vettore mantenendo i valori precedenti ma
                    ' aggiungendone uno
                    ReDim Preserve aElencoIncrRitMax(nId)
                    ' memorizzo il valore
                    aElencoIncrRitMax(nId) = nIncr
                    ' ridimensiono il vettore mantnendo i valori precedenti ma
                    ' aggiungendone uno
                    ReDim Preserve aIdEstrIncrRitMax(nId)
                    ' memorizzo l'id dell'estrazione dove si è avuto l'incremento
                    aIdEstrIncrRitMax(nId) = aIdEstrElencoRit(k)
                    ' ridimensiono il vettore mantnendo i valori precedenti ma
                    ' aggiungendone uno
                    ReDim Preserve aRitardiAllIncremento(nId)
                    ' memorizzo il valore del ritardo all'id dell'estrazione dove si è avuto l'incremento
                    aRitardiAllIncremento(nId) = aElencoRit(k)
                End If
                nRitMax = aElencoRit(k)
            End If
        Next
        mStrIncRitSto = StringaNumeri(aElencoIncrRitMax,,True)
    End Sub
    Function IsCondizioneRispettata(nIdFiltro,nQIncr)
        ' verifica che l'incremento dell'ultimo ritmax sia uguale al massimo incr rit max conosciuto.
        Dim nUpper
        nUpper = UBound(aElencoIncrRitMax)
        mIncrRitardoMaxSto = MassimoV(aElencoIncrRitMax,1,nUpper - 1)
        If aElencoRit(UBound(aElencoRit)) > 0 And aIdEstrIncrRitMax(nUpper) = mFine And nUpper >= nQIncr Then
            Select Case nIdFiltro
            Case 0
                IsCondizioneRispettata =(aElencoIncrRitMax(nUpper) = mIncrRitardoMaxSto)
            Case 1
                IsCondizioneRispettata =(aElencoIncrRitMax(nUpper) >= mIncrRitardoMaxSto)
            Case 2
                IsCondizioneRispettata =(aElencoIncrRitMax(nUpper) <= mIncrRitardoMaxSto)
            End Select
        Else
            IsCondizioneRispettata = False
        End If
    End Function
    'Scrivo la funzione Importo i Parametri ma non li dichiaro private sono solo nella funzione
    
    Function TrasformaArrayNumVirToNumReal(iDist,bPrimaEstrFiss)
    ' bPrimaEstrFiss dovrebbe influenzare il conteggio di nTotEstr
    ' if bPrimaFissa=true then
    'nTotEstr =((mFine - mInizio) + 1)Mod 90
    'else
    'nTotEstr =((mFine - mInizio) )Mod 90
    'end if
    

        Dim k,nTotEstr,ValVirt
        Dim sNumreal
        sNumreal = ""
        nTotEstr =((mFine - mInizio) + 1)Mod 90
        ValVirt = Fuori90(nTotEstr *iDist)
        For k = 1 To UBound(aNumeri)
            sNumreal = sNumreal & Format2(Fuori90(aNumeri(k) + ValVirt)) & "."
        Next
        sNumreal = RimuoviLastChr(sNumreal,".")
        TrasformaArrayNumVirToNumReal = sNumreal
    End Function
    Sub DisegnaGraficoIncrRitMax
        Dim x,y,k
        Dim nValoreMaxX,nValoreMaxY,nValoreMinX
        Dim nStepX,nStepY
        Dim nUpperVetIncrRit
        nValoreMinX = MinimoV(aIdEstrIncrRitMax,1)
        nValoreMaxX = aIdEstrIncrRitMax(UBound(aIdEstrIncrRitMax))
        nValoreMaxY = MassimoV(aElencoRit,1)
        nStepX =(nValoreMaxX -(mInizio - 1)) \10
        nStepY = nValoreMaxY \10
        Call PreparaGrafico("Formaziione " & StringaNumeri(aNumeri),nValoreMinX,nValoreMaxX,0,nValoreMaxY,nStepX,nStepY)
        nUpperVetIncrRit = UBound(aElencoIncrRitMax)
        ' linea dell'incremento rit max
        ReDim aV(nUpperVetIncrRit - 1,2)
        For k = 1 To nUpperVetIncrRit
            x = aIdEstrIncrRitMax(k)
            y = aElencoIncrRitMax(k)
            aV(k - 1,1) = x
            aV(k - 1,2) = y
        Next
        Call DisegnaLineaGrafico(aV,vbRed,"IncrRitMax")
        ' linea dell' rit max
        ReDim aV(nUpperVetIncrRit - 1,2)
        For k = 1 To nUpperVetIncrRit
            x = aIdEstrIncrRitMax(k)
            y = aRitardiAllIncremento(k)
            aV(k - 1,1) = x
            aV(k - 1,2) = y
        Next
        Call DisegnaLineaGrafico(aV,vbBlue,"RitMax")
        ' scrive grafico nell'output
        Call InserisciGrafico
    End Sub
End Class
Sub Main
    Dim sDir,Inizio,Fine,sFile,sFileCompleto,aRuote,Sorte
    Dim bOk,idFiltro,qIncr
    Dim bPrimaEstrFissa,nDistanza
    sDir = GetDirectoryAppData & "ArchiviVirtuali\"
    sFile = ScegliFileArchivioVirt(sDir)
    'preimposto a False x valutare qualsiasi sFile<>""
    bPrimaEstrFissa = False
    If sFile <> "" Then
        sFileCompleto = sDir & sFile & ".dat"
        bOk = ApriFileBaseDati(sFileCompleto)
        bPrimaEstrFissa = True
        nDistanza = GetValoreFraSeparatori(sFile,"(",")")
    Else
        bOk = True ' archivio normale
        nDistanza = 0 ' archivio Reale
    End If
    If bOk Then
        If ScegliRange(Inizio,Fine) Then
            Sorte = ScegliEsito
            Call ScegliRuote(aRuote,Nothing)
            ' decido il filtro in base al valore degli incrementi
            idFiltro = GetIdFiltro
            ' decido di filtrare in base al numero degli incrementi
            qIncr = GetQuantiIncrementi
            If(Fine > Inizio) And UBound(aRuote) > 0 And Sorte > 0 And idFiltro > - 1 Then
                Call Scrivi("Archivio : " & Iif(sFile <> "",sFile,"Archivio lotto"))
                Select Case ScegliTipoSviluppo
                Case 1
                    Call AnalisiLunghetteFromFileTxt(Inizio,Fine,aRuote,Sorte,idFiltro,qIncr,bPrimaEstrFissa,nDistanza)
                    Case 2
                    Call AnalisiLunghetteFromFileCol(Inizio,Fine,aRuote,Sorte,idFiltro,qIncr,bPrimaEstrFissa,nDistanza)

                Case 3
                    Call AnalisiLunghetteFromNumeriCasuali(Inizio,Fine,aRuote,Sorte,idFiltro,qIncr,bPrimaEstrFissa,nDistanza)
                Case 4
                    Call AnalisiLunghetteFromSceglinumeri(Inizio,Fine,aRuote,Sorte,idFiltro,qIncr,bPrimaEstrFissa,nDistanza)
                    
                End Select
            End If
        End If
    End If
End Sub
Function ScegliFileArchivioVirt(sDir)
    Dim i
    ReDim aFile(0)
    Call ElencoFileInDirectory(sDir,aFile,".dat")
    aFile(0) = "Archivio reale"
    i = ScegliOpzioneMenu(aFile,0,"Scegli archivio virtuale")
    If i > 0 Then
        ScegliFileArchivioVirt = aFile(i)
    Else
        ScegliFileArchivioVirt = ""
    End If
End Function
Function ScegliTipoSviluppo
    ReDim aVoci(4)
    aVoci(1) = "Da File .txt"
    aVoci(2) = "Da File .Col"

    aVoci(3) = "Da Selezione Casuale"
    aVoci(4) = "Da Selezione Utente"
    
    ScegliTipoSviluppo = ScegliOpzioneMenu(aVoci,1,"SelezionaSviluppo")
End Function
Function GetChrSepFromRiga(sRiga)
    Dim k,schr
    schr = ""
    For k = 1 To Len(sRiga)
        schr = Mid(sRiga,k,1)
        If IsNumeric(schr) = False Then
            Exit For
        End If
    Next
    GetChrSepFromRiga = schr
End Function
'Function GetIdFiltro
'Dim aFiltro
'aFiltro = Array("IncrRitMaxSto=UltimoIncrRitMax","IncrRitMaxSto<=UltimoIncrRitMax","IncrRitMaxSto>=UltimoIncrRitMax")
'GetIdFiltro = ScegliOpzioneMenu(aFiltro,0,"Select Filtro Condizione")
'End Function
Function GetIdFiltro
    Dim aFiltro(2)
    aFiltro(0) = "aElencoIncrRitMax(nUpper) = mIncrRitardoMaxSto"
    aFiltro(1) = "aElencoIncrRitMax(nUpper)>= mIncrRitardoMaxSto"
    aFiltro(2) = "aElencoIncrRitMax(nUpper)<= mIncrRitardoMaxSto"
    GetIdFiltro = ScegliOpzioneMenu(aFiltro,0,"Select Filtro Condizione")
End Function
Function ScriviFiltro(idFiltro)
    Select Case idFiltro
    Case 0
        ScriviFiltro =("aElencoIncrRitMax(nUpper) = mIncrRitardoMaxSto")
    Case 1
        ScriviFiltro =("aElencoIncrRitMax(nUpper)>= mIncrRitardoMaxSto")
    Case 2
        ScriviFiltro =("aElencoIncrRitMax(nUpper)<= mIncrRitardoMaxSto")
    End Select
End Function
Function GetQuantiIncrementi
    GetQuantiIncrementi = CInt(InputBox("qIncr>=(NumeroIncrementiRitMaxFormazione)","Filtro Quantitaà Incrementi",5))
End Function
' Questa è la nuova routine che impedisce di scrivere i doppi
' ma non mpedisce di incrementare nTrov
'Sub AddLunghetta(collLunghette,clsL)
'On Error Resume Next
'collLunghette.Add clsL ,"k"&clsL.LunghettaString
'End Sub
Function AddLunghetta(collLunghette,clsL)
    On Error Resume Next
    collLunghette.Add clsL,"k" & clsL.LunghettaString
    If Err = 0 Then
        AddLunghetta = True
    Else
        AddLunghetta = False
    End If
    Err.Clear
End Function
Function GetValoreFraSeparatori(sFile,CharSep1,CharSep2)
    Dim k
    Dim i,f,sVal
    i = InStr(1,sFile,CharSep1) + 1
    f = InStr(i,sFile,CharSep2)
    GetValoreFraSeparatori = Int(Mid(sFile,i,f - i))
End Function
Sub AnalisiLunghetteFromFileTxt(Inizio,Fine,aRuote,Sorte,idFiltro,qIncr,bPrimaEstrFissa,nDistanza)
    Dim sFile,aLunghette,nTotLunghette
    Dim k,sChrSep,sNumReal
    Dim clsL,collLunghette
    Set collLunghette = GetNewCollection
    sFile = ScegliFile(GetDirectoryAppData,".txt")
    If FileEsistente(sFile) Then
        Call LeggiRigheFileDiTesto(sFile,aLunghette)
        nTotLunghette = UBound(aLunghette)
        If nTotLunghette > 0 Then
            sChrSep = GetChrSepFromRiga(aLunghette(1))
            For k = 0 To nTotLunghette
                Set clsL = New clsLunghetta
                Call clsL.Init(aLunghette(k),sChrSep,Inizio,Fine,aRuote,Sorte)
                If clsL.IsCondizioneRispettata(idFiltro,qIncr) Then
                    Call clsL.EseguiStatistica
                    collLunghette.Add clsL
                End If
                If k Mod 50 = 0 Then
                    Call Messaggio("Righe esaminate : " & k)
                    Call AvanzamentoElab(1,nTotLunghette,k)
                    If ScriptInterrotto Then Exit For
                End If
            Next
            Scrivi "Range analisi         : " & GetInfoEstrazione(Inizio) & " - " & GetInfoEstrazione(Fine)
            Scrivi "Filtro Esaminato      : " & ScriviFiltro(idFiltro)
            Scrivi "Lunghette esaminate   : " & nTotLunghette & " Valide : " & collLunghette.count
            Scrivi "Sorte                 : " & NomeSorte(Sorte)
            Scrivi "Ruote                 : " & StringaRuote(aRuote)
            Scrivi "Numero Minimo IncrRit : " & Format2(qIncr)
            Scrivi
            Scrivi FormatSpace("Lunghette ordinate per incremento ritardo max",75),True,True,RGB(25,89,76),vbWhite

            Call Scrivi
            If collLunghette.count > 0 Then
                Call OrdinaItemCollection(collLunghette,"IncrRitMax",,,- 1)
                For Each clsL In collLunghette
                    If nDistanza = 0 Then
                        Call Scrivi("Numeri Formazione     : " & clsL.LunghettaString)
                    Else
                        sNumReal = clsL.TrasformaArrayNumVirToNumReal(nDistanza,bPrimaEstrFissa)
                        Call Scrivi("Numeri Formazione     : " & clsL.LunghettaString & "   " & "Numeri Verifica   : " & sNumReal)
                    End If
                    Call Scrivi("Ritardo               : " & clsL.Ritardo)
                    Call Scrivi("RitMax                : " & clsL.RitardoMax)
                    Call Scrivi("Freq                  : " & clsL.Frequenza)
                    Call Scrivi("IncrRitMx             : " & clsL.IncrRitMax)
                    Call Scrivi("IncrRitMaxSto         : " & clsL.IncrRitMaxSto)
                    Call Scrivi("strIncrementi         : " & clsL.strIncRitMaxSto)
                    Call Scrivi("Numero Incrementi     : " & clsL.iNumIncrementi)
                    Call clsL.DisegnaGraficoIncrRitMax
                Next
            Else
                Scrivi "Nessuna lunghetta rispetta le condizioni"
                Scrivi "Lunghette esaminate " & nTotLunghette + 1
            End If
        End If
    End If
End Sub
Sub AnalisiLunghetteFromNumeriCasuali(Inizio,Fine,aRuote,Sorte,idFiltro,qIncr,bPrimaEstrFissa,nDistanza)
    Dim sFile,aLunghette,nTotLunghette,nClasse
    Dim nTrov,nProdotte,sNumReal
    Dim clsL,collLunghette,uLunghette
    ReDim aSelNum(0)
    Set collLunghette = GetNewCollection
    nTotLunghette = Int(InputBox("Quante lunghette devono essere prodotte ?",,10))
    uLunghette=nTotLunghette
    ScegliNumeri(aSelNum)
    nClasse = Int(InputBox("Quanti numeri nella lunghetta","Sorte analizzata" & NomeSorte(Sorte),2))
    If nTotLunghette > 0 And nClasse >= Sorte Then

        nTrov = 0
        nProdotte = 0
        Do While nTotLunghette > 0
            Set clsL = New clsLunghetta
            ReDim aNum(nClasse)
            Call GetColonnaCasuale(nClasse,aNum,aSelNum)
            nProdotte = nProdotte + 1
            Call clsL.Init(aNum,"",Inizio,Fine,aRuote,Sorte)
            If clsL.IsCondizioneRispettata(idFiltro,qIncr) Then
                Call clsL.EseguiStatistica
                If AddLunghetta(collLunghette,clsL) Then nTrov = nTrov + 1
            End If
            If nProdotte Mod 50 = 0 Then
                Call Messaggio("combinazioni esaminate " & nProdotte & " valide " & nTrov)
                Call AvanzamentoElab(1,uLunghette,nProdotte)
                Call DoEventsEx
                If ScriptInterrotto Then Exit Do
            End If
            nTotLunghette = nTotLunghette - 1
        Loop
        Scrivi "Range analisi         : " & GetInfoEstrazione(Inizio) & " - " & GetInfoEstrazione(Fine)
        Scrivi "Filtro Esaminato      : " & ScriviFiltro(idFiltro)
        Scrivi "Lunghette esaminate   : " & nProdotte & " Valide : " & collLunghette.count
        Scrivi "Sorte                 : " & NomeSorte(Sorte)
        Scrivi "Ruote                 : " & StringaRuote(aRuote)
        Scrivi "Numero Minimo IncrRit : " & Format2(qIncr)
        Scrivi
        Scrivi FormatSpace("Lunghette ordinate per incremento ritardo max",75),True,True,RGB(25,89,76),vbWhite

        Call Scrivi
        If collLunghette.count > 0 Then
            Call OrdinaItemCollection(collLunghette,"IncrRitMax",,,- 1)
            For Each clsL In collLunghette
                If nDistanza = 0 Then
                    Call Scrivi("Numeri Formazione     : " & clsL.LunghettaString)
                Else
                    sNumReal = clsL.TrasformaArrayNumVirToNumReal(nDistanza,bPrimaEstrFissa)
                    Call Scrivi("Numeri Formazione     : " & clsL.LunghettaString & "   " & "Numeri Verifica   : " & sNumReal)
                End If
                Call Scrivi("Ritardo               : " & clsL.Ritardo)
                Call Scrivi("RitMax                : " & clsL.RitardoMax)
                Call Scrivi("Freq                  : " & clsL.Frequenza)
                Call Scrivi("IncrRitMx             : " & clsL.IncrRitMax)
                Call Scrivi("IncrRitMaxSto         : " & clsL.IncrRitMaxSto)
                Call Scrivi("strIncrementi         : " & clsL.strIncRitMaxSto)
                Call Scrivi("Numero Incrementi     : " & clsL.iNumIncrementi)
                Call clsL.DisegnaGraficoIncrRitMax
            Next
        Else
            Scrivi "Nessuna lunghetta rispetta le condizioni"
            Scrivi "Lunghette esaminate " & nTotLunghette
        End If
    End If
End Sub
Sub AnalisiLunghetteFromSceglinumeri(Inizio,Fine,aRuote,Sorte,idFiltro,qIncr,bPrimaEstrFissa,nDistanza)
    Dim nTotLunghette
    Dim k,sChrSep,nClasse,sNumReal
    ReDim aLunghette(0)
    Dim clsL,collLunghette,FiltroEsaminato
    Set collLunghette = GetNewCollection
    FiltroEsaminato = ScriviFiltro(idFiltro)
    sChrSep = " "
    ScegliNumeri(aLunghette)
    nClasse = CInt(InputBox(" classe sviluppo ",,2))
    nTotLunghette = InitSviluppoIntegrale(aLunghette,nClasse)
    k = 0
    Do While GetCombSviluppo(aLunghette)
        k = k + 1
        Set clsL = New clsLunghetta
        Call clsL.Init(aLunghette,sChrSep,Inizio,Fine,aRuote,Sorte)
        If clsL.IsCondizioneRispettata(idFiltro,qIncr) Then
            Call clsL.EseguiStatistica
            collLunghette.Add clsL
        End If
        If k Mod 50 = 0 Then
            Call Messaggio("Righe esaminate " & k & "  valide " & collLunghette. count)
            DoEventsEx
            Call AvanzamentoElab(1,nTotLunghette,k)
            If ScriptInterrotto Then Exit Do
        End If
    Loop
    Scrivi "Range analisi         : " & GetInfoEstrazione(Inizio) & " - " & GetInfoEstrazione(Fine)
    Scrivi "Filtro Esaminato      : " & FiltroEsaminato
    Scrivi "Lunghette esaminate   : " & nTotLunghette & " Valide : " & collLunghette.count
    Scrivi "Sorte                 : " & NomeSorte(Sorte)
    Scrivi "Ruote                 : " & StringaRuote(aRuote)
    Scrivi "Numero Minimo IncrRit : " & Format2(qIncr)
    Scrivi
    Scrivi FormatSpace("Lunghette ordinate per incremento ritardo max",75),True,True,RGB(25,89,76),vbWhite

    Call Scrivi
    If collLunghette.count > 0 Then
        Call OrdinaItemCollection(collLunghette,"IncrRitMax",,,- 1)
        For Each clsL In collLunghette
            If nDistanza = 0 Then
                Call Scrivi("Numeri Formazione     : " & clsL.LunghettaString)
            Else
                sNumReal = clsL.TrasformaArrayNumVirToNumReal(nDistanza,bPrimaEstrFissa)
                Call Scrivi("Numeri Formazione     : " & clsL.LunghettaString & "   " & "Numeri Verifica   : " & sNumReal)
            End If
            Call Scrivi("Ritardo               : " & clsL.Ritardo)
            Call Scrivi("RitMax                : " & clsL.RitardoMax)
            Call Scrivi("Freq                  : " & clsL.Frequenza)
            Call Scrivi("IncrRitMx             : " & clsL.IncrRitMax)
            Call Scrivi("IncrRitMaxSto         : " & clsL.IncrRitMaxSto)
            Call Scrivi("strIncrementi         : " & clsL.strIncRitMaxSto)
            Call Scrivi("Numero Incrementi     : " & clsL.iNumIncrementi)
            Call clsL.DisegnaGraficoIncrRitMax
        Next
    Else
        Scrivi "Nessuna lunghetta rispetta le condizioni"
        Scrivi "Lunghette esaminate " & nTotLunghette
    End If
End Sub
Sub AnalisiLunghetteFromFileCol(Inizio,Fine,aRuote,Sorte,idFiltro,qIncr,bPrimaEstrFissa,nDistanza)
    Dim sFile,nTotLunghette
    Dim k,sChrSep,sNumReal
    Dim clsL,collLunghette
    sChrSep = " "
    Set collLunghette = GetNewCollection
    sFile = ScegliFile(GetDirectoryAppData & "SviluppiColonne",".col")
    If FileEsistente(sFile) Then
    ReDim alunghette(0)
        Call LeggiColonnaSistema(alunghette,1,sFile,,nTotLunghette)
        
        If nTotLunghette > 0 Then
            
            For k = 1 To nTotLunghette
            ReDim alunghette(0)
                Call LeggiColonnaSistema(alunghette,k,sFile)

                Set clsL = New clsLunghetta
                                
                Call clsL.Init(alunghette,sChrSep,Inizio,Fine,aRuote,Sorte)
                If clsL.IsCondizioneRispettata(idFiltro,qIncr) Then
                    Call clsL.EseguiStatistica
                    collLunghette.Add clsL
                End If
                If k Mod 50 = 0 Then
                    Call Messaggio("Colonne esaminate : " & k & "  Valide : " & collLunghette.count)
                    Call AvanzamentoElab(1,nTotLunghette,k)
                    If ScriptInterrotto Then Exit For
                End If
            Next
            Scrivi "Range analisi         : " & GetInfoEstrazione(Inizio) & " - " & GetInfoEstrazione(Fine)
            Scrivi "Filtro Esaminato      : " & ScriviFiltro(idFiltro)
            Scrivi "Lunghette esaminate   : " & nTotLunghette & " Valide : " & collLunghette.count
            Scrivi "Sorte                 : " & NomeSorte(Sorte)
            Scrivi "Ruote                 : " & StringaRuote(aRuote)
            Scrivi "Numero Minimo IncrRit : " & Format2(qIncr)
            Scrivi
            Scrivi FormatSpace("Lunghette ordinate per incremento ritardo max",75),True,True,RGB(25,89,76),vbWhite
            Call Scrivi
            If collLunghette.count > 0 Then
                Call OrdinaItemCollection(collLunghette,"IncrRitMax",,,- 1)
                For Each clsL In collLunghette
                    If nDistanza = 0 Then
                        Call Scrivi("Numeri Formazione     : " & clsL.LunghettaString)
                    Else
                        sNumReal = clsL.TrasformaArrayNumVirToNumReal(nDistanza,bPrimaEstrFissa)
                        Call Scrivi("Numeri Formazione     : " & clsL.LunghettaString & " => " & "Numeri Verifica   : " & sNumReal)
                    End If
                    Call Scrivi("Ritardo               : " & clsL.Ritardo)
                    Call Scrivi("RitMax                : " & clsL.RitardoMax)
                    Call Scrivi("Freq                  : " & clsL.Frequenza)
                    Call Scrivi("IncrRitMx             : " & clsL.IncrRitMax)
                    Call Scrivi("IncrRitMaxSto         : " & clsL.IncrRitMaxSto)
                    Call Scrivi("strIncrementi         : " & clsL.strIncRitMaxSto)
                    Call Scrivi("Numero Incrementi     : " & clsL.iNumIncrementi)
                    Call clsL.DisegnaGraficoIncrRitMax
                Next
            Else
                Scrivi "Nessuna lunghetta rispetta le condizioni"
                Scrivi "Lunghette esaminate " & nTotLunghette + 1
            End If
        End If
    End If
End Sub

Per dirla alla "Austin Powers" sarebbe...

Premium Member

LuigiB

Guest

Premium Member

LuigiB

Guest

Premium Member

LuigiB

Guest

Premium Member

LuigiB

Guest

Advanced Premium Member

Premium Member

LuigiB

Guest

Advanced Member >PLATINUM<

Advanced Premium Member

Premium Member

Premium Member

Advanced Premium Member

Premium Member

Advanced Member >PLATINUM<

LuigiB

Guest

Premium Member