Novità

x abasul e non solo

lotto_tom75

Advanced Premium Member
Incuriosendomi molto la tua interessante idea della % doc di distanze dai massimi storici, anche perchè convergente con alcune mie ultime ricerche di "distanze mai oltrepassate", ho cercato di implementarla in questo ultra power script multi funzione. Spero di esserci riuscito e che ti torni utile per i tuoi sviluppi.

Codice:
Option Explicit

'by lotto_tom75 implementazione filtro abasul x A in 3ina
'lo script implementa anche il motore a sviluppo integrale senza limiti di classe dei mitici edo95 e luigib

Class clsSviluppo
   Private aBNumDaSvil
   Private nQNumeri
   Private nCombInt
   Private nClasse
   Private aRighe
   Private nQNumPerRiga
   Private aPuntatore
   Private nSviluppate
   Function InitSviluppo(aNumeri,Classe)
      nQNumeri = AlimentArrayNumDaSvil(aNumeri)
      nCombInt = Combinazioni(nQNumeri,Classe)
      nClasse = Classe
      nSviluppate = 0
      If nCombInt > 0 Then
         Call AlimentaArrayRighe
         Call InitArrayPuntatore
      End If
      InitSviluppo = nCombInt
   End Function
   Function GetQuantitaNumeriDaSvil
      GetQuantitaNumeriDaSvil = nQNumeri
   End Function
   Function GetStringaNumDaSvil
      Dim s,k
      s = ""
      For k = 1 To UBound(aBNumDaSvil)
         If aBNumDaSvil(k) Then
            s = s & Format2(k) & "."
         End If
      Next
      GetStringaNumDaSvil = RimuoviLastChr(s,".")
   End Function
   Private Sub InitArrayPuntatore
      Dim k
      ReDim aPuntatore(nClasse)
      For k = 1 To nClasse - 1
         aPuntatore(k) = 1
      Next
      aPuntatore(k) = 0
   End Sub
   Function GetComb(aComb)
      Dim nTmp,K,nPuntatore
      nPuntatore = nClasse
      nTmp = aPuntatore(nPuntatore) + 1
      Do While nTmp > nQNumPerRiga
         nPuntatore = nPuntatore - 1
         If nPuntatore <= 0 Then Exit Do
         nTmp = aPuntatore(nPuntatore) + 1
      Loop
      If nPuntatore > 0 Then
         For K = nPuntatore To nClasse
            aPuntatore(K) = nTmp
         Next
         ReDim aComb(nClasse)
         For K = 1 To nClasse
            aComb(K) = aRighe(K,aPuntatore(K))
         Next
         nSviluppate = nSviluppate + 1
         GetComb = True
      Else
         GetComb = False
      End If
   End Function
   Function GetQuantitaSviluppate
      GetQuantitaSviluppate = nSviluppate
   End Function
   Private Function AlimentArrayNumDaSvil(aNumeri)
      Dim k,q
      aBNumDaSvil = ArrayNumeriToBool(aNumeri)
      For k = 1 To 90
         If aBNumDaSvil(k) Then
            q = q + 1
         End If
      Next
      AlimentArrayNumDaSvil = q
   End Function
   Private Sub AlimentaArrayRighe
      Dim nRiga,k,aNumeri
      Call ArrayBNumToArrayNum(aBNumDaSvil,aNumeri)
      nQNumPerRiga =(nQNumeri - nClasse) + 1
      ReDim aRighe(nClasse,nQNumPerRiga)
      For nRiga = 1 To nClasse
         'i = 0
         For k = nRiga To(nRiga + nQNumPerRiga) - 1 '(nQNumeri - nClasse) + nRiga
            ' i = i + 1
            ' i = (k - nRiga )+1
            aRighe(nRiga,(k - nRiga) + 1) = aNumeri(k)
         Next
      Next
   End Sub
   Sub OutputARighe
      Dim k,j,s
      For k = 1 To nClasse
         s = ""
         For j = 1 To nQNumPerRiga
            s = s & Format2(aRighe(k,j)) & "."
         Next
         Call Scrivi(Format2(k) & ") " & RimuoviLastChr(s,"."))
      Next
   End Sub
End Class
Sub Main
   Dim clSvi
   Dim nClasse
   Dim nSorte
   Dim k,j
   Dim sNumeri
   Dim idComb
   Dim nInizio,nFine
   Dim idValoreDaAna
   Dim sValoreUsato
   Dim CombTot
   Dim aRuote
   Set clSvi = New clsSviluppo
   Dim quantirisultati
   Dim Col_Ord
   Dim Tipo_Ord
   Dim QNS
   ReDim aNum(0)
   QNS = ScegliNumeri(aNum)
   Dim classedisviluppodidefault
   classedisviluppodidefault = 3
   nClasse = ScegliEsito(classedisviluppodidefault,1,90)
   Call ScegliRuote(aRuote)
   nSorte = ScegliSorte
   idValoreDaAna = ScegliValoreDaAnalizzare(sValoreUsato)
   Col_Ord = CInt(InputBox("Colonna da ordinare (freq= 2; Rit= 3; RitMax= 4; Diff= 5; Incmax= 6).","colonna da ordinare ",3))
   Tipo_Ord = CInt(InputBox("Ordinamento (Crescente > 0 1; Decresc = 0).","Ordinamento ",1))
   nInizio = EstrazioneIni
   nFine = EstrazioneFin
   If nClasse > 0 And nSorte > 0 And nSorte <= nClasse And idValoreDaAna > 0 Then
      Call Messaggio("Sviluppo combinazioni di classe " & nClasse)
      CombTot = clSvi.InitSviluppo(aNum,nClasse)
      Call Messaggio("Lunghette totali da analizzare " & CombTot)
      ReDim aCombMigliori(CombTot,6)
      Call Messaggio("Statistica combinazioni in corso ")
      ReDim aCol(nClasse)
      Do While clSvi.GetComb(aCol) = True
         Call AnalisiComb(aCol,aRuote,nSorte,aCombMigliori,nInizio,nFine,idValoreDaAna)
         k = k + 1
         If k Mod 1 = 0 Then
            Call Messaggio("Statistica combinazioni in corso " & k & " di " & CombTot)
            Call AvanzamentoElab(1,CombTot,k)
            If ScriptInterrotto Then Exit Do
         End If
      Loop
      Call Messaggio("")
      '     ReDim aTitoli(6)
      '      aTitoli(1) = "Combinazione"
      '      aTitoli(2) = "Frequenza"
      '      aTitoli(3) = "Ritardo"
      '      aTitoli(4) = "RitardoMax"
      '      aTitoli(5) = "Differenza Aurea"
      '      aTitoli(6) = "IncMax"
      '
      Call Scrivi("Combinazioni di classe " & nClasse & " analizzate per punti " & nSorte & " sulle ruote " & GetRuoteUsate(aRuote))
      Call Scrivi("La seguente lista mostra le prime " & quantirisultati & " Combinazioni In Base al valore di " & sValoreUsato)
      Call Scrivi("Range analizzato " & GetInfoEstrazione(nInizio) & " fino a " & GetInfoEstrazione(nFine))
      Call Scrivi("Estrazioni analizzate totali : " &(nFine + 1) - nInizio)
      Call Scrivi
      For k = 1 To UBound(aCombMigliori)
         ReDim ADati(6)
         ADati(1) = aCombMigliori(k,4) 'combinazione
         ADati(2) = aCombMigliori(k,1) 'frequenza
         ADati(3) = aCombMigliori(k,2) 'ritardo
         ADati(4) = aCombMigliori(k,3) 'ritardo max
         ADati(5) = aCombMigliori(k,5) 'differenza aurea
         ADati(6) = aCombMigliori(k,6) ' incmax
         Dim ccolonna
         Dim contatore
         contatore = contatore + 1
         Dim diff
         'prova inserimento filtro by idea di abasul sotto riportata...
         '
         'Potremmo chiamare questa mia idea "Ritardi di lunghette prossimi allo storico" dove con la tua bravura dovresti
         'permettere a tutti noi di poter controllare solo quei ritardi distanti dallo storico tra il 45% e il 75%. Mi spiego:
         'Se ad esempio su una qualsiasi ruota una lunghetta di una terzina per ambo avesse un ritardo di 263 estrazioni
         'e lo storico fosse di 362, basterebbe dividere 263/362x100 per vedere se questa previsione rientrerebbe
         'nel range da Me definito: siccome 263:362x100= 72,65, allora questa previsione sarebbe da inserire;
         'se invece, tra i tanti ritardi ne avessimo uno sempre di una lunghetta In terzina per ambo di 389 estrazioni e
         'il ritardo storico fosse di 411, allora avremmo 389/411x100=94,64% e questa previsione sarebbe da non inserire.
         '
         'fine esposizione idea abasul
         Dim datoabasul
         If ADati(3) <> 0 And ADati(4) <> 0 Then
            datoabasul =(ADati(3)/ADati(4)) * 100
            If ADati(5) <= 10 Then
               Call Scrivi("formazione: " & ADati(1) & " -" & " FQ " & ADati(2) & " -" & " RA " & ADati(3) & " -" & " RS " & ADati(4) & " -" & diff & " <font color=red bgcolor=yellow>" & ADati(5) & " -" & " INCMAX " & ADati(6) & "</font>" & " -" & " contatore " & contatore)
            Else
               Call Scrivi("formazione: " & ADati(1) & " -" & " FQ " & ADati(2) & " -" & " RA " & ADati(3) & " -" & " RS " & ADati(4) & " - DIFF " & ADati(5) & " -" & " INCMAX " & ADati(6) & " -" & " contatore " & contatore)
            End If
            Scrivi
            Call Scrivi("PROVA OUTPUT SECONDO FILTRO ABASUL con sole formazioni con ra distante dal rispettivo rs x A in terzina tra il 45% e 75%")
            'If datoabasul <> Null Then
            If(datoabasul >= 45) And(datoabasul <= 75) Then
               Call Scrivi("<font color=green>OK la formazione ha passato il filtro abasul per A in 3ina con valore di filtro: </font>" & datoabasul)
            Else
               Call Scrivi("<font color=red>NO la formazione NON ha passato il filtro abasul per A in 3ina con valore di filtro: </font>" & datoabasul)
            End If
         End If ' x controllo valori non nulli di ra e rs
         Scrivi
         'End If
      Next
      'Next
      Call Scrivi
      Call Scrivi("Tempo trascorso: " & TempoTrascorso)
      Call Scrivi
   Else
      MsgBox "Selezionare la classe di sviluppo e la Sorte , " & _
      "si ricorda che la Sorte non puo essere maggiore della classe di sviluppo " & _
      "e che bisogna scegliere quale valore statistico considerare per " & _
      "alimentare la lista delle prime N Combinazioni desiderate da mostrare in output "
   End If
End Sub
Sub AnalisiComb(aNum,aRuote,Sorte,aCombMig,nInizio,nFine,idValoreDaAna)
   Dim k,j
   Dim Rit
   Dim RitMax
   Dim Freq
   Dim Valore
   Dim diff
   Dim RetIncrRitMax
   Call StatisticaFormazioneTurbo(aNum,aRuote,Sorte,Rit,RitMax,RetIncrRitMax,Freq,nInizio,nFine)
   diff = RitMax - Rit
   Select Case idValoreDaAna
   Case 1
      Valore = Freq
   Case 2
      Valore = Rit
   Case 3
      Valore = RitMax
   End Select
   For k = 1 To UBound(aCombMig)
      If Valore >= aCombMig(k,0) Then
         For j = UBound(aCombMig) To(k + 1) Step - 1
            aCombMig(j,0) = aCombMig(j - 1,0)
            aCombMig(j,1) = aCombMig(j - 1,1)
            aCombMig(j,2) = aCombMig(j - 1,2)
            aCombMig(j,3) = aCombMig(j - 1,3)
            aCombMig(j,4) = aCombMig(j - 1,4)
            aCombMig(j,5) = aCombMig(j - 1,5)
            aCombMig(j,6) = aCombMig(j - 1,6)
         Next
         aCombMig(k,0) = Valore
         aCombMig(k,1) = Freq
         aCombMig(k,2) = Rit
         aCombMig(k,3) = RitMax
         aCombMig(k,4) = StringaNumeri(aNum)
         aCombMig(k,5) = diff
         aCombMig(k,6) = RetIncrRitMax
         Exit For
      End If
   Next
End Sub
Function ScegliSorte()
   ReDim aVoci(4)
   aVoci(0) = "Estratto"
   aVoci(1) = "Ambo"
   aVoci(2) = "Terno"
   aVoci(3) = "Quaterna"
   aVoci(4) = "Cinquina"
   ScegliSorte = ScegliOpzioneMenu(aVoci,1,"Scegli Sorte") + 1
End Function
Function ScegliValoreDaAnalizzare(sValore)
   ReDim aVoci(4)
   Dim i
   aVoci(0) = "Frequenza"
   aVoci(1) = "Ritardo"
   aVoci(2) = "Ritardo massimo"
   aVoci(3) = "Differenza Aurea"
   aVoci(4) = "IncMax"
   i = ScegliOpzioneMenu(aVoci,1,"Quale valore considerare per l'ordinamento ? ")
   sValore = aVoci(i)
   ScegliValoreDaAnalizzare = i + 1
End Function
Function GetRuoteUsate(aRuote)
   Dim k
   Dim s
   For k = 1 To UBound(aRuote)
      s = s & SiglaRuota(aRuote(k)) & " "
   Next
   GetRuoteUsate = Trim(s)
End Function

👋:)
 

abasul

Super Member >PLATINUM<
Ciao lotto_tom75, trovo che l'impostazione della ricerca sia ottima e ben congegnata. Tuttavia a me interesserebbe conoscere solo quei ritardi attuali, su ogni ruota, che si avvicinano al suo Max Ritardo Storico attuale di ruota, compresi tra il 45% e il 75%. Una volta che ho sotto controllo gli ambi, le terzine per ambo o le quartine per ambo, spiegherò come fare per scegliere le combinazioni più probabili per vincere al Lotto.
 
Ultima modifica:

lotto_tom75

Advanced Premium Member
Ciao lotto_tom75, trovo che l'impostazione della ricerca sia ottima e ben congegnata. Tuttavia a me interesserebbe conoscere solo quei ritardi attuali, su ogni ruota, che si avvicinano al suo Max Ritardo Storico attuale di ruota, compresi tra il 45% e il 75%. Una volta che ho sotto controllo gli ambi, le terzine per ambo o le quartine per ambo, spiegherò come fare per scegliere le combinazioni più probabili per vincere al Lotto.
Ok quindi se ho ben capito non vuoi vedere tutte le scritte in rosso che non soddisfano tale tuo filtro giusto? ;)

Se si... questo stesso cod di prima, opportunatamente commentato e leggermente modificato, dovrebbe andarti bene...

Codice:
Option Explicit
'by lotto_tom75 implementazione filtro abasul x A in 3ina
'lo script implementa anche il motore a sviluppo integrale senza limiti di classe dei mitici edo95 e luigib
Class clsSviluppo
   Private aBNumDaSvil
   Private nQNumeri
   Private nCombInt
   Private nClasse
   Private aRighe
   Private nQNumPerRiga
   Private aPuntatore
   Private nSviluppate
   Function InitSviluppo(aNumeri,Classe)
      nQNumeri = AlimentArrayNumDaSvil(aNumeri)
      nCombInt = Combinazioni(nQNumeri,Classe)
      nClasse = Classe
      nSviluppate = 0
      If nCombInt > 0 Then
         Call AlimentaArrayRighe
         Call InitArrayPuntatore
      End If
      InitSviluppo = nCombInt
   End Function
   Function GetQuantitaNumeriDaSvil
      GetQuantitaNumeriDaSvil = nQNumeri
   End Function
   Function GetStringaNumDaSvil
      Dim s,k
      s = ""
      For k = 1 To UBound(aBNumDaSvil)
         If aBNumDaSvil(k) Then
            s = s & Format2(k) & "."
         End If
      Next
      GetStringaNumDaSvil = RimuoviLastChr(s,".")
   End Function
   Private Sub InitArrayPuntatore
      Dim k
      ReDim aPuntatore(nClasse)
      For k = 1 To nClasse - 1
         aPuntatore(k) = 1
      Next
      aPuntatore(k) = 0
   End Sub
   Function GetComb(aComb)
      Dim nTmp,K,nPuntatore
      nPuntatore = nClasse
      nTmp = aPuntatore(nPuntatore) + 1
      Do While nTmp > nQNumPerRiga
         nPuntatore = nPuntatore - 1
         If nPuntatore <= 0 Then Exit Do
         nTmp = aPuntatore(nPuntatore) + 1
      Loop
      If nPuntatore > 0 Then
         For K = nPuntatore To nClasse
            aPuntatore(K) = nTmp
         Next
         ReDim aComb(nClasse)
         For K = 1 To nClasse
            aComb(K) = aRighe(K,aPuntatore(K))
         Next
         nSviluppate = nSviluppate + 1
         GetComb = True
      Else
         GetComb = False
      End If
   End Function
   Function GetQuantitaSviluppate
      GetQuantitaSviluppate = nSviluppate
   End Function
   Private Function AlimentArrayNumDaSvil(aNumeri)
      Dim k,q
      aBNumDaSvil = ArrayNumeriToBool(aNumeri)
      For k = 1 To 90
         If aBNumDaSvil(k) Then
            q = q + 1
         End If
      Next
      AlimentArrayNumDaSvil = q
   End Function
   Private Sub AlimentaArrayRighe
      Dim nRiga,k,aNumeri
      Call ArrayBNumToArrayNum(aBNumDaSvil,aNumeri)
      nQNumPerRiga =(nQNumeri - nClasse) + 1
      ReDim aRighe(nClasse,nQNumPerRiga)
      For nRiga = 1 To nClasse
         'i = 0
         For k = nRiga To(nRiga + nQNumPerRiga) - 1 '(nQNumeri - nClasse) + nRiga
            ' i = i + 1
            ' i = (k - nRiga )+1
            aRighe(nRiga,(k - nRiga) + 1) = aNumeri(k)
         Next
      Next
   End Sub
   Sub OutputARighe
      Dim k,j,s
      For k = 1 To nClasse
         s = ""
         For j = 1 To nQNumPerRiga
            s = s & Format2(aRighe(k,j)) & "."
         Next
         Call Scrivi(Format2(k) & ") " & RimuoviLastChr(s,"."))
      Next
   End Sub
End Class
Sub Main
   Dim clSvi
   Dim nClasse
   Dim nSorte
   Dim k,j
   Dim sNumeri
   Dim idComb
   Dim nInizio,nFine
   Dim idValoreDaAna
   Dim sValoreUsato
   Dim CombTot
   Dim aRuote
   Set clSvi = New clsSviluppo
   Dim quantirisultati
   Dim Col_Ord
   Dim Tipo_Ord
   Dim QNS
   ReDim aNum(0)
   QNS = ScegliNumeri(aNum)
   Dim classedisviluppodidefault
   classedisviluppodidefault = 3
   nClasse = ScegliEsito(classedisviluppodidefault,1,90)
   Call ScegliRuote(aRuote)
   nSorte = ScegliSorte
   idValoreDaAna = ScegliValoreDaAnalizzare(sValoreUsato)
   Col_Ord = CInt(InputBox("Colonna da ordinare (freq= 2; Rit= 3; RitMax= 4; Diff= 5; Incmax= 6).","colonna da ordinare ",3))
   Tipo_Ord = CInt(InputBox("Ordinamento (Crescente > 0 1; Decresc = 0).","Ordinamento ",1))
   nInizio = EstrazioneIni
   nFine = EstrazioneFin
   If nClasse > 0 And nSorte > 0 And nSorte <= nClasse And idValoreDaAna > 0 Then
      Call Messaggio("Sviluppo combinazioni di classe " & nClasse)
      CombTot = clSvi.InitSviluppo(aNum,nClasse)
      Call Messaggio("Lunghette totali da analizzare " & CombTot)
      ReDim aCombMigliori(CombTot,6)
      Call Messaggio("Statistica combinazioni in corso ")
      ReDim aCol(nClasse)
      Do While clSvi.GetComb(aCol) = True
         Call AnalisiComb(aCol,aRuote,nSorte,aCombMigliori,nInizio,nFine,idValoreDaAna)
         k = k + 1
         If k Mod 1 = 0 Then
            Call Messaggio("Statistica combinazioni in corso " & k & " di " & CombTot)
            Call AvanzamentoElab(1,CombTot,k)
            If ScriptInterrotto Then Exit Do
         End If
      Loop
      Call Messaggio("")
      '     ReDim aTitoli(6)
      '      aTitoli(1) = "Combinazione"
      '      aTitoli(2) = "Frequenza"
      '      aTitoli(3) = "Ritardo"
      '      aTitoli(4) = "RitardoMax"
      '      aTitoli(5) = "Differenza Aurea"
      '      aTitoli(6) = "IncMax"
      '
      Call Scrivi("Combinazioni di classe " & nClasse & " analizzate per punti " & nSorte & " sulle ruote " & GetRuoteUsate(aRuote))
      Call Scrivi("La seguente lista mostra le prime " & quantirisultati & " Combinazioni In Base al valore di " & sValoreUsato)
      Call Scrivi("Range analizzato " & GetInfoEstrazione(nInizio) & " fino a " & GetInfoEstrazione(nFine))
      Call Scrivi("Estrazioni analizzate totali : " &(nFine + 1) - nInizio)
      Call Scrivi
      For k = 1 To UBound(aCombMigliori)
         ReDim ADati(6)
         ADati(1) = aCombMigliori(k,4) 'combinazione
         ADati(2) = aCombMigliori(k,1) 'frequenza
         ADati(3) = aCombMigliori(k,2) 'ritardo
         ADati(4) = aCombMigliori(k,3) 'ritardo max
         ADati(5) = aCombMigliori(k,5) 'differenza aurea
         ADati(6) = aCombMigliori(k,6) ' incmax
         Dim ccolonna
         Dim contatore
         contatore = contatore + 1
         Dim diff
         'prova inserimento filtro by idea di abasul sotto riportata...
         '
         'Potremmo chiamare questa mia idea "Ritardi di lunghette prossimi allo storico" dove con la tua bravura dovresti
         'permettere a tutti noi di poter controllare solo quei ritardi distanti dallo storico tra il 45% e il 75%. Mi spiego:
         'Se ad esempio su una qualsiasi ruota una lunghetta di una terzina per ambo avesse un ritardo di 263 estrazioni
         'e lo storico fosse di 362, basterebbe dividere 263/362x100 per vedere se questa previsione rientrerebbe
         'nel range da Me definito: siccome 263:362x100= 72,65, allora questa previsione sarebbe da inserire;
         'se invece, tra i tanti ritardi ne avessimo uno sempre di una lunghetta In terzina per ambo di 389 estrazioni e
         'il ritardo storico fosse di 411, allora avremmo 389/411x100=94,64% e questa previsione sarebbe da non inserire.
         '
         'fine esposizione idea abasul
         Dim datoabasul
         If ADati(3) <> 0 And ADati(4) <> 0 Then
            datoabasul =(ADati(3)/ADati(4)) * 100
            'If ADati(5) <= 10 Then
               'Call Scrivi("formazione: " & ADati(1) & " -" & " FQ " & ADati(2) & " -" & " RA " & ADati(3) & " -" & " RS " & ADati(4) & " -" & diff & " <font color=red bgcolor=yellow>" & ADati(5) & " -" & " INCMAX " & ADati(6) & "</font>" & " -" & " contatore " & contatore)
            'Else
               'Call Scrivi("formazione: " & ADati(1) & " -" & " FQ " & ADati(2) & " -" & " RA " & ADati(3) & " -" & " RS " & ADati(4) & " - DIFF " & ADati(5) & " -" & " INCMAX " & ADati(6) & " -" & " contatore " & contatore)
            'End If
            'Scrivi
            'If datoabasul <> Null Then
            If(datoabasul >= 45) And(datoabasul <= 75) Then
            Call Scrivi("PROVA OUTPUT SECONDO FILTRO ABASUL con sole formazioni con ra distante dal rispettivo rs x A in terzina tra il 45% e 75%")
       
               Call Scrivi("<font color=green>OK la formazione ha passato il filtro abasul per A in 3ina con valore di filtro: </font>" & datoabasul)
               Call Scrivi("formazione: " & ADati(1) & " -" & " FQ " & ADati(2) & " -" & " RA " & ADati(3) & " -" & " RS " & ADati(4) & " - DIFF " & ADati(5) & " -" & " INCMAX " & ADati(6) & " -" & " contatore " & contatore)
      
            Else
               'Call Scrivi("<font color=red>NO la formazione NON ha passato il filtro abasul per A in 3ina con valore di filtro: </font>" & datoabasul)
            End If
         End If ' x controllo valori non nulli di ra e rs
         Scrivi
         'End If
      Next
      'Next
      Call Scrivi
      Call Scrivi("Tempo trascorso: " & TempoTrascorso)
      Call Scrivi
   Else
      MsgBox "Selezionare la classe di sviluppo e la Sorte , " & _
      "si ricorda che la Sorte non puo essere maggiore della classe di sviluppo " & _
      "e che bisogna scegliere quale valore statistico considerare per " & _
      "alimentare la lista delle prime N Combinazioni desiderate da mostrare in output "
   End If
End Sub
Sub AnalisiComb(aNum,aRuote,Sorte,aCombMig,nInizio,nFine,idValoreDaAna)
   Dim k,j
   Dim Rit
   Dim RitMax
   Dim Freq
   Dim Valore
   Dim diff
   Dim RetIncrRitMax
   Call StatisticaFormazioneTurbo(aNum,aRuote,Sorte,Rit,RitMax,RetIncrRitMax,Freq,nInizio,nFine)
   diff = RitMax - Rit
   Select Case idValoreDaAna
   Case 1
      Valore = Freq
   Case 2
      Valore = Rit
   Case 3
      Valore = RitMax
   End Select
   For k = 1 To UBound(aCombMig)
      If Valore >= aCombMig(k,0) Then
         For j = UBound(aCombMig) To(k + 1) Step - 1
            aCombMig(j,0) = aCombMig(j - 1,0)
            aCombMig(j,1) = aCombMig(j - 1,1)
            aCombMig(j,2) = aCombMig(j - 1,2)
            aCombMig(j,3) = aCombMig(j - 1,3)
            aCombMig(j,4) = aCombMig(j - 1,4)
            aCombMig(j,5) = aCombMig(j - 1,5)
            aCombMig(j,6) = aCombMig(j - 1,6)
         Next
         aCombMig(k,0) = Valore
         aCombMig(k,1) = Freq
         aCombMig(k,2) = Rit
         aCombMig(k,3) = RitMax
         aCombMig(k,4) = StringaNumeri(aNum)
         aCombMig(k,5) = diff
         aCombMig(k,6) = RetIncrRitMax
         Exit For
      End If
   Next
End Sub
Function ScegliSorte()
   ReDim aVoci(4)
   aVoci(0) = "Estratto"
   aVoci(1) = "Ambo"
   aVoci(2) = "Terno"
   aVoci(3) = "Quaterna"
   aVoci(4) = "Cinquina"
   ScegliSorte = ScegliOpzioneMenu(aVoci,1,"Scegli Sorte") + 1
End Function
Function ScegliValoreDaAnalizzare(sValore)
   ReDim aVoci(4)
   Dim i
   aVoci(0) = "Frequenza"
   aVoci(1) = "Ritardo"
   aVoci(2) = "Ritardo massimo"
   aVoci(3) = "Differenza Aurea"
   aVoci(4) = "IncMax"
   i = ScegliOpzioneMenu(aVoci,1,"Quale valore considerare per l'ordinamento ? ")
   sValore = aVoci(i)
   ScegliValoreDaAnalizzare = i + 1
End Function
Function GetRuoteUsate(aRuote)
   Dim k
   Dim s
   For k = 1 To UBound(aRuote)
      s = s & SiglaRuota(aRuote(k)) & " "
   Next
   GetRuoteUsate = Trim(s)
End Function

Ovviamente per avere l'analisi di ambi, terzine e quartine x ambo devi solo cambiare la relativa classe (in 2,3,4) nel primo campo input iniziale (con titolo della finestra leggermente fuorviante "seleziona esito") che ho impostato di default a 3. Ho scritto fuorviante perchè dovrebbe essere appunto "scegli classe" ma non so come si possa cambiare...
 
Ultima modifica:

abasul

Super Member >PLATINUM<
Scusami, ma lo script ci mette troppo tempo per mostrare i risultati, per cui qui servirebbe per forza una mano da parte di Luigi. E' alquanto impensabile che uno debba attendere giorni e giorni con un computer acceso affinché lo script finisca di passare in rassegna una alla volta 2555190 quartine.
 

claudio8

Premium Member
Inserito "Scegli Classe"
Codice:
Option Explicit
'by lotto_tom75 implementazione filtro abasul x A in 3ina
'lo script implementa anche il motore a sviluppo integrale senza limiti di classe dei mitici edo95 e luigib
Class clsSviluppo
   Private aBNumDaSvil
   Private nQNumeri
   Private nCombInt
   Private nClasse
   Private aRighe
   Private nQNumPerRiga
   Private aPuntatore
   Private nSviluppate
   Function InitSviluppo(aNumeri,Classe)
      nQNumeri = AlimentArrayNumDaSvil(aNumeri)
      nCombInt = Combinazioni(nQNumeri,Classe)
      nClasse = Classe
      nSviluppate = 0
      If nCombInt > 0 Then
         Call AlimentaArrayRighe
         Call InitArrayPuntatore
      End If
      InitSviluppo = nCombInt
   End Function
   Function GetQuantitaNumeriDaSvil
      GetQuantitaNumeriDaSvil = nQNumeri
   End Function
   Function GetStringaNumDaSvil
      Dim s,k
      s = ""
      For k = 1 To UBound(aBNumDaSvil)
         If aBNumDaSvil(k) Then
            s = s & Format2(k) & "."
         End If
      Next
      GetStringaNumDaSvil = RimuoviLastChr(s,".")
   End Function
   Private Sub InitArrayPuntatore
      Dim k
      ReDim aPuntatore(nClasse)
      For k = 1 To nClasse - 1
         aPuntatore(k) = 1
      Next
      aPuntatore(k) = 0
   End Sub
   Function GetComb(aComb)
      Dim nTmp,K,nPuntatore
      nPuntatore = nClasse
      nTmp = aPuntatore(nPuntatore) + 1
      Do While nTmp > nQNumPerRiga
         nPuntatore = nPuntatore - 1
         If nPuntatore <= 0 Then Exit Do
         nTmp = aPuntatore(nPuntatore) + 1
      Loop
      If nPuntatore > 0 Then
         For K = nPuntatore To nClasse
            aPuntatore(K) = nTmp
         Next
         ReDim aComb(nClasse)
         For K = 1 To nClasse
            aComb(K) = aRighe(K,aPuntatore(K))
         Next
         nSviluppate = nSviluppate + 1
         GetComb = True
      Else
         GetComb = False
      End If
   End Function
   Function GetQuantitaSviluppate
      GetQuantitaSviluppate = nSviluppate
   End Function
   Private Function AlimentArrayNumDaSvil(aNumeri)
      Dim k,q
      aBNumDaSvil = ArrayNumeriToBool(aNumeri)
      For k = 1 To 90
         If aBNumDaSvil(k) Then
            q = q + 1
         End If
      Next
      AlimentArrayNumDaSvil = q
   End Function
   Private Sub AlimentaArrayRighe
      Dim nRiga,k,aNumeri
      Call ArrayBNumToArrayNum(aBNumDaSvil,aNumeri)
      nQNumPerRiga =(nQNumeri - nClasse) + 1
      ReDim aRighe(nClasse,nQNumPerRiga)
      For nRiga = 1 To nClasse
         'i = 0
         For k = nRiga To(nRiga + nQNumPerRiga) - 1 '(nQNumeri - nClasse) + nRiga
            ' i = i + 1
            ' i = (k - nRiga )+1
            aRighe(nRiga,(k - nRiga) + 1) = aNumeri(k)
         Next
      Next
   End Sub
   Sub OutputARighe
      Dim k,j,s
      For k = 1 To nClasse
         s = ""
         For j = 1 To nQNumPerRiga
            s = s & Format2(aRighe(k,j)) & "."
         Next
         Call Scrivi(Format2(k) & ") " & RimuoviLastChr(s,"."))
      Next
   End Sub
End Class
Sub Main
    Dim clSvi
   Dim nClasse
   Dim nSorte
   Dim k,j
   Dim sNumeri
   Dim idComb
   Dim nInizio,nFine
   Dim idValoreDaAna
   Dim sValoreUsato
   Dim CombTot
   Dim aRuote
   Set clSvi = New clsSviluppo
   Dim quantirisultati
   Dim Col_Ord
   Dim Tipo_Ord
   Dim QNS
   ReDim aNum(0)
   QNS = ScegliNumeri(aNum)
   Dim classedisviluppodidefault
   classedisviluppodidefault = 3
   nClasse = ScegliClasse    ''''''''Esito(classedisviluppodidefault,1,90)
   Call ScegliRuote(aRuote)
   nSorte = ScegliSorte
   idValoreDaAna = ScegliValoreDaAnalizzare(sValoreUsato)
   Col_Ord = CInt(InputBox("Colonna da ordinare (freq= 2; Rit= 3; RitMax= 4; Diff= 5; Incmax= 6).","colonna da ordinare ",3))
   Tipo_Ord = CInt(InputBox("Ordinamento (Crescente > 0 1; Decresc = 0).","Ordinamento ",1))
   nInizio = EstrazioneIni
   nFine = EstrazioneFin
   If nClasse > 0 And nSorte > 0 And nSorte <= nClasse And idValoreDaAna > 0 Then
      Call Messaggio("Sviluppo combinazioni di classe " & nClasse)
      CombTot = clSvi.InitSviluppo(aNum,nClasse)
      Call Messaggio("Lunghette totali da analizzare " & CombTot)
      ReDim aCombMigliori(CombTot,6)
      Call Messaggio("Statistica combinazioni in corso ")
      ReDim aCol(nClasse)
      Do While clSvi.GetComb(aCol) = True
         Call AnalisiComb(aCol,aRuote,nSorte,aCombMigliori,nInizio,nFine,idValoreDaAna)
         k = k + 1
         If k Mod 1 = 0 Then
            Call Messaggio("Statistica combinazioni in corso " & k & " di " & CombTot)
            Call AvanzamentoElab(1,CombTot,k)
            If ScriptInterrotto Then Exit Do
         End If
      Loop
      Call Messaggio("")
      '     ReDim aTitoli(6)
      '      aTitoli(1) = "Combinazione"
      '      aTitoli(2) = "Frequenza"
      '      aTitoli(3) = "Ritardo"
      '      aTitoli(4) = "RitardoMax"
      '      aTitoli(5) = "Differenza Aurea"
      '      aTitoli(6) = "IncMax"
      '
      Call Scrivi("Combinazioni di classe " & nClasse & " analizzate per punti " & nSorte & " sulle ruote " & GetRuoteUsate(aRuote))
      Call Scrivi("La seguente lista mostra le prime " & quantirisultati & " Combinazioni In Base al valore di " & sValoreUsato)
      Call Scrivi("Range analizzato " & GetInfoEstrazione(nInizio) & " fino a " & GetInfoEstrazione(nFine))
      Call Scrivi("Estrazioni analizzate totali : " &(nFine + 1) - nInizio)
      Call Scrivi
      For k = 1 To UBound(aCombMigliori)
         ReDim ADati(6)
         ADati(1) = aCombMigliori(k,4) 'combinazione
         ADati(2) = aCombMigliori(k,1) 'frequenza
         ADati(3) = aCombMigliori(k,2) 'ritardo
         ADati(4) = aCombMigliori(k,3) 'ritardo max
         ADati(5) = aCombMigliori(k,5) 'differenza aurea
         ADati(6) = aCombMigliori(k,6) ' incmax
         Dim ccolonna
         Dim contatore
         contatore = contatore + 1
         Dim diff
         'prova inserimento filtro by idea di abasul sotto riportata...
         '
         'Potremmo chiamare questa mia idea "Ritardi di lunghette prossimi allo storico" dove con la tua bravura dovresti
         'permettere a tutti noi di poter controllare solo quei ritardi distanti dallo storico tra il 45% e il 75%. Mi spiego:
         'Se ad esempio su una qualsiasi ruota una lunghetta di una terzina per ambo avesse un ritardo di 263 estrazioni
         'e lo storico fosse di 362, basterebbe dividere 263/362x100 per vedere se questa previsione rientrerebbe
         'nel range da Me definito: siccome 263:362x100= 72,65, allora questa previsione sarebbe da inserire;
         'se invece, tra i tanti ritardi ne avessimo uno sempre di una lunghetta In terzina per ambo di 389 estrazioni e
         'il ritardo storico fosse di 411, allora avremmo 389/411x100=94,64% e questa previsione sarebbe da non inserire.
         '
         'fine esposizione idea abasul
         Dim datoabasul
         If ADati(3) <> 0 And ADati(4) <> 0 Then
            datoabasul =(ADati(3)/ADati(4)) * 100
            'If ADati(5) <= 10 Then
               'Call Scrivi("formazione: " & ADati(1) & " -" & " FQ " & ADati(2) & " -" & " RA " & ADati(3) & " -" & " RS " & ADati(4) & " -" & diff & " <font color=red bgcolor=yellow>" & ADati(5) & " -" & " INCMAX " & ADati(6) & "</font>" & " -" & " contatore " & contatore)
            'Else
               'Call Scrivi("formazione: " & ADati(1) & " -" & " FQ " & ADati(2) & " -" & " RA " & ADati(3) & " -" & " RS " & ADati(4) & " - DIFF " & ADati(5) & " -" & " INCMAX " & ADati(6) & " -" & " contatore " & contatore)
            'End If
            'Scrivi
            'If datoabasul <> Null Then
            If(datoabasul >= 45) And(datoabasul <= 75) Then
            Call Scrivi("PROVA OUTPUT SECONDO FILTRO ABASUL con sole formazioni con ra distante dal rispettivo rs x A in terzina tra il 45% e 75%")
      
               Call Scrivi("<font color=green>OK la formazione ha passato il filtro abasul per A in 3ina con valore di filtro: </font>" & datoabasul)
               Call Scrivi("formazione: " & ADati(1) & " -" & " FQ " & ADati(2) & " -" & " RA " & ADati(3) & " -" & " RS " & ADati(4) & " - DIFF " & ADati(5) & " -" & " INCMAX " & ADati(6) & " -" & " contatore " & contatore)
      
            Else
               'Call Scrivi("<font color=red>NO la formazione NON ha passato il filtro abasul per A in 3ina con valore di filtro: </font>" & datoabasul)
            End If
         End If ' x controllo valori non nulli di ra e rs
         Scrivi
         'End If
      Next
      'Next
      Call Scrivi
      Call Scrivi("Tempo trascorso: " & TempoTrascorso)
      Call Scrivi
   Else
      MsgBox "Selezionare la classe di sviluppo e la Sorte , " & _
      "si ricorda che la Sorte non puo essere maggiore della classe di sviluppo " & _
      "e che bisogna scegliere quale valore statistico considerare per " & _
      "alimentare la lista delle prime N Combinazioni desiderate da mostrare in output "
   End If
End Sub
Sub AnalisiComb(aNum,aRuote,Sorte,aCombMig,nInizio,nFine,idValoreDaAna)
   Dim k,j
   Dim Rit
   Dim RitMax
   Dim Freq
   Dim Valore
   Dim diff
   Dim RetIncrRitMax
   Call StatisticaFormazioneTurbo(aNum,aRuote,Sorte,Rit,RitMax,RetIncrRitMax,Freq,nInizio,nFine)
   diff = RitMax - Rit
   Select Case idValoreDaAna
   Case 1
      Valore = Freq
   Case 2
      Valore = Rit
   Case 3
      Valore = RitMax
   End Select
   For k = 1 To UBound(aCombMig)
      If Valore >= aCombMig(k,0) Then
         For j = UBound(aCombMig) To(k + 1) Step - 1
            aCombMig(j,0) = aCombMig(j - 1,0)
            aCombMig(j,1) = aCombMig(j - 1,1)
            aCombMig(j,2) = aCombMig(j - 1,2)
            aCombMig(j,3) = aCombMig(j - 1,3)
            aCombMig(j,4) = aCombMig(j - 1,4)
            aCombMig(j,5) = aCombMig(j - 1,5)
            aCombMig(j,6) = aCombMig(j - 1,6)
         Next
         aCombMig(k,0) = Valore
         aCombMig(k,1) = Freq
         aCombMig(k,2) = Rit
         aCombMig(k,3) = RitMax
         aCombMig(k,4) = StringaNumeri(aNum)
         aCombMig(k,5) = diff
         aCombMig(k,6) = RetIncrRitMax
         Exit For
      End If
   Next
End Sub
Function ScegliClasse()
   Dim x
   ReDim aVoci(90)
   For x = 1 To 90
   aVoci(x) = x
   Next
   ScegliClasse = ScegliOpzioneMenu (aVoci,3,"SCEGLI CLASSE")
End Function

Function ScegliSorte()
   ReDim aVoci(4)
   aVoci(0) = "Estratto"
   aVoci(1) = "Ambo"
   aVoci(2) = "Terno"
   aVoci(3) = "Quaterna"
   aVoci(4) = "Cinquina"
   ScegliSorte = ScegliOpzioneMenu(aVoci,1,"Scegli Sorte") + 1
End Function
Function ScegliValoreDaAnalizzare(sValore)
   ReDim aVoci(4)
   Dim i
   aVoci(0) = "Frequenza"
   aVoci(1) = "Ritardo"
   aVoci(2) = "Ritardo massimo"
   aVoci(3) = "Differenza Aurea"
   aVoci(4) = "IncMax"
   i = ScegliOpzioneMenu(aVoci,1,"Quale valore considerare per l'ordinamento ? ")
   sValore = aVoci(i)
   ScegliValoreDaAnalizzare = i + 1
End Function
Function GetRuoteUsate(aRuote)
   Dim k
   Dim s
   For k = 1 To UBound(aRuote)
      s = s & SiglaRuota(aRuote(k)) & " "
   Next
   GetRuoteUsate = Trim(s)
End Function
 

claudio8

Premium Member
Scusami, ma lo script ci mette troppo tempo per mostrare i risultati, per cui qui servirebbe per forza una mano da parte di Luigi. E' alquanto impensabile che uno debba attendere giorni e giorni con un computer acceso affinché lo script finisca di passare in rassegna una alla volta 2555190 quartine.
Ricerca lunghette è stato fatto apposta da Luigi x ridurre i tempi lunghi di analisi lunghette, ma come lui stesso ha detto non deve dare pronostici daltronde, se come tu richiedi, (evidenziare le formazioni in un determinato range di rapporto ritardo /ritMax) il programma dovrebbe analizzare e memorizzare i ritmax quindi elaborare i rit correnti e contemporaneamente selezionare quelli rientranti nel range desiderato.
I tempi anche in questo caso diventano esagerati.
ciao
 

abasul

Super Member >PLATINUM<
Claudio buonasera, se la mia idea come dici tu non può essere messa in pratica non fa niente. A questo punto possiamo anche chiudere qui il discorso. Credevo invece che fosse più semplice realizzarne la fattibilità. Comunque vi ringrazio a tutti. Buonanotte.
 
L

LuigiB

Guest
ilp rogramma serve per cercare i ritardi piu alti fa un sacco di salti e si perde un sacco di colonne per arrivare al suo obiettivo .. quello che chiede abasul con ricerca lunghette non c'entra nulla...forse si puo mettere questa colonna del rapporto se uno fa lo sviluppo completo devo capire bene che vuole abasul..
 

claudio8

Premium Member
Claudio buonasera, se la mia idea come dici tu non può essere messa in pratica non fa niente. A questo punto possiamo anche chiudere qui il discorso. Credevo invece che fosse più semplice realizzarne la fattibilità. Comunque vi ringrazio a tutti. Buonanotte.
Non vorrei aver dissolto le tue speranze di soluzione della richiesta, ma cerchiamo di capire meglio la tua richiesta e vediamo cosa Luigi può fare o indicarci per la soluzione.
un saluto.
 

lotto_tom75

Advanced Premium Member
Tom arrivato
L'elaborato sui rit. Max non ce l'hai?

Bene 🙂
No l'elaborato che ho fatto e' solo quello. Io per RS max intendevo che puoi ordinare la colonna degli RS max e vedere quanto sia quello massimo risultante dall'analisi generale e per quali ruote e coppie di posizioni relative.
 

abasul

Super Member >PLATINUM<
ilp rogramma serve per cercare i ritardi piu alti fa un sacco di salti e si perde un sacco di colonne per arrivare al suo obiettivo .. quello che chiede abasul con ricerca lunghette non c'entra nulla...forse si puo mettere questa colonna del rapporto se uno fa lo sviluppo completo devo capire bene che vuole abasul..
Buogiorno Luigi, ora cerco di spiegarti nel modo più semplice possibile quale sarebbe la mia idea da mettere in pratica.
Con il tuo programma "Ricerca Lunghette" ho richiesto le 20 terzine che hanno il maggior ritardo attuale nella ruota di Bari. Tra questi venti, però, solo 4 rientrano nei parametri da me richiesti:

1-3-37, perché rit.a 503/max.s 765= 65,75%
1-3-6, perché rit.a 392/ max.s 716= 54,74%
1-2-86, perché rit.a 230/max.s 476= 48,31%
1-2-90, perché rit.a 230/max.s 431= 53,36%
Snap1.jpg
 
Ultima modifica:

abasul

Super Member >PLATINUM<
Ovviamente lo stesso ragionamento dovrebbe essere esteso, oltre che per le terzine per ambo, anche per due numeri per ambo e per le quartine per ambo, e nello specchietto dovrebbe figurare anche la data di estrazione di quando si è verificato il ritardo storico relativo ad ogni combinazione da esaminare. Una volta che si ha un quadro completo della situazione per tutte le ruote, in modo "statistico matematico" vi potrò spiegare quali sarebbero quelle pochissime combinazioni più probabili da giocare.
 

lotto_tom75

Advanced Premium Member
Scusami, ma lo script ci mette troppo tempo per mostrare i risultati, per cui qui servirebbe per forza una mano da parte di Luigi. E' alquanto impensabile che uno debba attendere giorni e giorni con un computer acceso affinché lo script finisca di passare in rassegna una alla volta 2555190 quartine.

Ok a scapito dell'elaborazione integrale ho provato ad implementare il tuo filtro nello script selettivo che è molto veloce per qualsiasi classe fino alla 20 e per qualsiasi sorte fino alla 3 operando in modalità random e saltando quindi qualche formazione...

Io lo uso molte volte per sgrossare la massa numerica iniziale...
Guarda se per adesso ti può essere d'aiuto...

Codice:
Option Explicit
Sub Main
   'filtro abasul implementato in selettivo by lotto_tom75
   ' lo script opera correttamente fino alla sorte 3 e classe 20
   ' lo script opera in modalità a salti random e non integrale
   ' è possibile restringere la dimensione dei salti a scapito della velocità
   Dim nSorte,aRuote,Ini,fin,sMsg,nMoltip,nTrov,nNumSel
   Dim nCicloTeo,nRitMax,nRitMin,nClasseLunghetta,nRuoteSel,nLunghetteDaTrov
   Dim TimeStart
   Dim k,CollComb,cColonna
   Dim aN
   Dim TipoAlgo
   Dim RetRit,RetRitMax,RetIncrRitMax,RetFrq
   Dim nSuperficialita
   fin = EstrazioneFin
   Call Scrivi
   Call Scrivi("<font size=3>Data elaborazione: " & giorno(fin) & "-" & Mese(fin) & "-" & Anno(fin) & "</font>")
   Call Scrivi
   nTrov = 0 '
   nNumSel = ScegliNumeri(aN)
   'aN = Array(0,16,49,60)
   'nSorte = 2 ' ScegliEsito
   nSorte = InputBox("Scegli sorte di ricerca","Sorte di ricerca",2)
   'nClasseLunghetta = 4 'ScegliClassseLunghetta
   nClasseLunghetta = InputBox("Scegli classe di sviluppo","Classe di sviluppo",3)
   TipoAlgo = 4
   nSuperficialita = 0
   Dim contatore
   contatore = 0
   'nRuoteSel= 1 : ReDim aRuote(1) : aRuote(1) =RO_'SelRuote(aRuote)
   nRuoteSel = 1 : ReDim aRuote(1) : aRuote(1) = TT_ ' <- qui scegli la ruota
 'SelRuote(aRuote)
   nLunghetteDaTrov = 10000 ' Int(InputBox("Lunghette da trovare","Quantità lunghette",10))
   ReDim Preserve aRuote(nRuoteSel)
   nCicloTeo = CicloTeorico(nClasseLunghetta,nSorte,UBound(aRuote))
   nMoltip = 1
   'sMsg = "Inserire il ritardo massimo ipotizzato per la sorte voluta nella lunghetta" & vbCrLf
   'sMsg = sMsg & "Il valore mostrato è il CicloTeorico per la sorte di " & nSorte
   'sMsg = sMsg & " su " & nClasseLunghetta & " numeri su " & nRuoteSel & " ruote moltiplicato per " & nMoltip
   'nRitMax = 0' Int(InputBox(sMsg,,nCicloTeo * nMoltip))
   'sMsg = "Inserire il ritardo minimo ipotizzato per la sorte voluta nella lunghetta" & vbCrLf
   'sMsg = sMsg & "Il valore mostrato è il CicloTeorico per la sorte di " & nSorte
   'sMsg = sMsg & " su " & nClasseLunghetta & " numeri su " & nRuoteSel & " ruote moltiplicato per 3"
   nRitMin = 0 ' Int(InputBox(sMsg,,nCicloTeo * 3))
   fin = EstrazioneFin
   Ini = fin - nRitMax
   If Ini <= 0 Then Ini = 1
   TimeStart = Timer
   Call GetLunghettePiuRitardate(aN,aRuote,nClasseLunghetta,nSorte,CollComb,EstrazioneIni,EstrazioneFin,nRitMin,nRitMax,nLunghetteDaTrov,TipoAlgo,nSuperficialita)
   'Call GetLunghettePiuRitardate(aN,aRuote,EstrazioneIni,EstrazioneFin,nClasseLunghetta,nSorte,CollComb)
   Call OrdinaItemCollection(CollComb,"Ritardo",,,- 1)
   For Each cColonna In CollComb
      contatore = contatore + 1
      Call StatisticaFormazioneTurbo(cColonna.aNum,aRuote,nSorte,RetRit,RetRitMax,RetIncrRitMax,RetFrq,EstrazioneIni,EstrazioneFin)
      Dim diff
      Dim datoabasul
      datoabasul =(RetRit/RetRitMax) * 100
      diff = RetRitMax - RetRit
      If(RetRit >= 0) Then
         If(datoabasul >= 45) And(datoabasul <= 75) Then
            Call Scrivi("PROVA OUTPUT SECONDO FILTRO ABASUL con sole formazioni con ra distante dal rispettivo rs x A in terzina tra il 45% e 75%")
            Call Scrivi("<font color=green>OK la formazione ha passato il filtro abasul per A in 3ina con valore di filtro: </font>" & datoabasul)
            Call Scrivi(SiglaRuota(aRuote(1)) & " - " & cColonna.GetStringaNum & " Rit " & RetRit & " rit max " & RetRitMax & " incmax " & RetIncrRitMax & " frequenza " & RetFrq)
         Else
            'Call Scrivi("<font color=red>NO la formazione NON ha passato il filtro abasul per A in 3ina con valore di filtro: </font>" & datoabasul)
         End If
      End If ' x controllo valori non nulli di ra e rs
      Call Messaggio("trovata")
      'Call Scrivi("Sorte ricercata: " & nSorte & " classe: " & nClasseLunghetta)
      'Call Scrivi(SiglaRuota(aRuote(1)) & " - " & cColonna.GetStringaNum & " Rit " & RetRit & " rit max " & RetRitMax & " incmax " & RetIncrRitMax & " frequenza " & RetFrq)
      'Call Scrivi(cColonna.GetStringaNum)
      ' End If
   Next
   'Call Scrivi("Tempo di elaborazione : " & FormattaSecondi(Timer - TimeStart))
   Scrivi
   Call Scrivi("Tempo trascorso: " & TempoTrascorso)
   Scrivi
End Sub
Function ScegliClassseLunghetta
   Dim aVoci(30)
   Dim k,i
   For k = 2 To(2 - 1) + UBound(aVoci)
      i = i + 1
      aVoci(i) = k
   Next
   k = ScegliOpzioneMenu(aVoci,5,"Classe lunghetta")
   ScegliClassseLunghetta = Int(aVoci(k))
End Function
Function SelRuote(aRuote)
   Dim t,k,bTutte
   bTutte = False
   t = ScegliRuote(aRuote)
   For k = 1 To t
      If aRuote(k) = TT_ Then
         bTutte = True
         Exit For
      End If
   Next
   If bTutte Then
      ReDim aRuote(10)
      For k = 1 To 10
         aRuote(k) = k
      Next
      SelRuote = 10
   Else
      SelRuote = t
   End If
End Function
Function FormattaSecondi(s)
   'Questa Function trasforma il numero di secondi passato come parametro in una stringa
   ' passando i secondi si ottengono ore  minuti e secondi  in formato hh:mm:ss
   ' s ---> Numero di secondi da formattare
   ' ritorna una stringa il cui formato è hh:mm:ss (la function non funziona se in totale abbiamo piu di 99 ore )
   Dim hh
   Dim Mm
   Dim Ss
   Dim TimeStr
   hh = s \ 3600
   Mm =(s Mod 3600) \ 60
   Ss = s -((hh * 3600) +(Mm * 60))
   TimeStr = Format2(hh) & ":" & Format2(Mm) & ":" & Format2(Ss)
   FormattaSecondi = TimeStr
End Function
 
Ultima modifica:

abasul

Super Member >PLATINUM<
Buongiorno lotto_tom75 e grazie per questo script che per me potrebbe essere altro motivo di studio. Dall'esempio che ho fatto prima e che era rivolto a Luigi, devo sapere quali altre terzine per ambo ci sono a Cagliari, Firenze, Genova ecc, perché io poi solo quando le avrò tutte a disposizione ne dovrò scegliere solo alcune che abbiano dei criteri ben determinati.
 

lotto_tom75

Advanced Premium Member
Buongiorno lotto_tom75 e grazie per questo script che per me potrebbe essere altro motivo di studio. Dall'esempio che ho fatto prima e che era rivolto a Luigi, devo sapere quali altre terzine per ambo ci sono a Cagliari, Firenze, Genova ecc, perché io poi solo quando le avrò tutte a disposizione ne dovrò scegliere solo alcune che abbiano dei criteri ben determinati.

Ok...

In questa ultima implementazione hai l'operatività dello stesso selettivo con integrato il tuo filtro su TT separate.

Codice:
Option Explicit
Sub Main
   'implementazione filtro abasul x A in classe voluta (fino alla 20) in selettivo  by lotto_tom75
   Dim nSorte,aRuote,Ini,fin,sMsg,nMoltip,nTrov,nNumSel
   Dim nCicloTeo,nRitMax,nRitMin,nClasseLunghetta,nRuoteSel,nLunghetteDaTrov
   Dim TimeStart
   Dim k,CollComb,cColonna
   Dim aN
   Dim TipoAlgo
   Dim RetRit,RetRitMax,RetIncrRitMax,RetFrq
   Dim nSuperficialita
   nTrov = 0 '
   nNumSel = ScegliNumeri(aN)
   'aN = Array(0,16,49,60)
   'nSorte = 2 ' ScegliEsito
   'nClasseLunghetta = 3 'ScegliClassseLunghetta

nSorte = InputBox("Scegli sorte di ricerca","Sorte di ricerca",2)
nClasseLunghetta = InputBox("Scegli classe di ricerca","Classe di ricerca",3)


TipoAlgo = 4
   nSuperficialita = 0
   Dim contatore
   contatore = 0
   Call Scrivi
   Call Scrivi("Elaborazione effettuata con archivio lotto aggiornato all'estrazione del: " & giorno(EstrazioneFin) & "-" & Mese(EstrazioneFin) & "-" & Anno(EstrazioneFin))
   Call Scrivi
   'nRuoteSel= 1 : ReDim aRuote(1) : aRuote(1) =RO_'SelRuote(aRuote)
   Dim r
   For r = 1 To 12
      nRuoteSel = r : ReDim aRuote(r) : aRuote(r) = r
      nLunghetteDaTrov = 10000 ' Int(InputBox("Lunghette da trovare","Quantità lunghette",10))
      ReDim Preserve aRuote(nRuoteSel)
      nCicloTeo = CicloTeorico(nClasseLunghetta,nSorte,UBound(aRuote))
      nMoltip = 1
      'sMsg = "Inserire il ritardo massimo ipotizzato per la sorte voluta nella lunghetta" & vbCrLf
      'sMsg = sMsg & "Il valore mostrato è il CicloTeorico per la sorte di " & nSorte
      'sMsg = sMsg & " su " & nClasseLunghetta & " numeri su " & nRuoteSel & " ruote moltiplicato per " & nMoltip
      nRitMax = 0' Int(InputBox(sMsg,,nCicloTeo * nMoltip))
      'sMsg = "Inserire il ritardo minimo ipotizzato per la sorte voluta nella lunghetta" & vbCrLf
      'sMsg = sMsg & "Il valore mostrato è il CicloTeorico per la sorte di " & nSorte
      'sMsg = sMsg & " su " & nClasseLunghetta & " numeri su " & nRuoteSel & " ruote moltiplicato per 3"
      nRitMin = 0 ' Int(InputBox(sMsg,,nCicloTeo * 3))
      fin = EstrazioneFin
      Ini = fin - nRitMax
      If Ini <= 0 Then Ini = 1
      TimeStart = Timer
      Call GetLunghettePiuRitardate(aN,aRuote,nClasseLunghetta,nSorte,CollComb,EstrazioneIni,EstrazioneFin,nRitMin,nRitMax,nLunghetteDaTrov,TipoAlgo,nSuperficialita)
      'Call GetLunghettePiuRitardate(aN,aRuote,EstrazioneIni,EstrazioneFin,nClasseLunghetta,nSorte,CollComb)
      Call OrdinaItemCollection(CollComb,"Ritardo",,,- 1)
      For Each cColonna In CollComb
         contatore = contatore + 1
         Call StatisticaFormazioneTurbo(cColonna.aNum,aRuote,nSorte,RetRit,RetRitMax,RetIncrRitMax,RetFrq,EstrazioneIni,EstrazioneFin)
         Dim diff
         diff = RetRitMax - RetRit
         If(RetRit >= 0) Then
          
            Dim datoabasul
            datoabasul =(RetRit/RetRitMax) * 100
            diff = RetRitMax - RetRit
            If(RetRit >= 0) Then
               If(datoabasul >= 45) And(datoabasul <= 75) Then
                  Call Messaggio("trovata")
                  Call Scrivi("PROVA OUTPUT SECONDO FILTRO ABASUL con sole formazioni con ra distante dal rispettivo rs x A in terzina tra il 45% e 75%")
                  Call Scrivi("<font color=green>OK la formazione ha passato il filtro abasul per A in 3ina con valore di filtro: </font>" & datoabasul)
                  Call Scrivi("Sorte ricercata: " & nSorte & " classe: " & nClasseLunghetta)
                  Call Scrivi(SiglaRuota(aRuote(r)) & " - " & cColonna.GetStringaNum & " Rit " & RetRit & " rit max " & RetRitMax & " incmax " & RetIncrRitMax & " frequenza " & RetFrq)
               Else
                  'Call Scrivi("<font color=red>NO la formazione NON ha passato il filtro abasul per A in 3ina con valore di filtro: </font>" & datoabasul)
               End If
            End If ' x controllo valori non nulli di ra e rs
            'Call Scrivi("Sorte ricercata: " & nSorte & " classe: " & nClasseLunghetta)
            'Call Scrivi(SiglaRuota(aRuote(r)) & " " & cColonna.GetStringaNum & " Rit " & RetRit & " rit max " & RetRitMax & " incmax " & RetIncrRitMax & " frequenza " & RetFrq)
            'Call Scrivi(cColonna.GetStringaNum)
         End If
         If ScriptInterrotto Then Exit For
      Next
      Call Scrivi("------------------------------------------------------------------------------")
      If ScriptInterrotto Then Exit For
   Next 'secondo next aggiunto per tentativo di elaborare ogni ruota in una volta sola
   Call Scrivi("Tempo di elaborazione : " & FormattaSecondi(Timer - TimeStart))
End Sub
Function ScegliClassseLunghetta
   Dim aVoci(30)
   Dim k,i
   For k = 2 To(2 - 1) + UBound(aVoci)
      i = i + 1
      aVoci(i) = k
   Next
   k = ScegliOpzioneMenu(aVoci,5,"Classe lunghetta")
   ScegliClassseLunghetta = Int(aVoci(k))
End Function
Function SelRuote(aRuote)
   Dim t,k,bTutte
   bTutte = False
   't = ScegliRuote(aRuote)
   'For k = 1 To t
   'If aRuote(k) = TT_ Then
   'bTutte = True
   'Exit For
   'End If
   'Next
   If bTutte Then
      ReDim aRuote(10)
      For k = 1 To 10
         aRuote(k) = k
      Next
      SelRuote = 10
   Else
      SelRuote = t
   End If
End Function
Function FormattaSecondi(s)
   'Questa Function trasforma il numero di secondi passato come parametro in una stringa
   ' passando i secondi si ottengono ore  minuti e secondi  in formato hh:mm:ss
   ' s ---> Numero di secondi da formattare
   ' ritorna una stringa il cui formato è hh:mm:ss (la function non funziona se in totale abbiamo piu di 99 ore )
   Dim hh
   Dim Mm
   Dim Ss
   Dim TimeStr
   hh = s \ 3600
   Mm =(s Mod 3600) \ 60
   Ss = s -((hh * 3600) +(Mm * 60))
   TimeStr = Format2(hh) & ":" & Format2(Mm) & ":" & Format2(Ss)
   FormattaSecondi = TimeStr
End Function
 
Ultima modifica:

abasul

Super Member >PLATINUM<
Ok...

In questa ultima implementazione hai l'operatività dello stesso selettivo con integrato il tuo filtro su TT separate.

Codice:
Option Explicit
Sub Main
   'implementazione filtro abasul x A in classe voluta (fino alla 20) in selettivo  by lotto_tom75
   Dim nSorte,aRuote,Ini,fin,sMsg,nMoltip,nTrov,nNumSel
   Dim nCicloTeo,nRitMax,nRitMin,nClasseLunghetta,nRuoteSel,nLunghetteDaTrov
   Dim TimeStart
   Dim k,CollComb,cColonna
   Dim aN
   Dim TipoAlgo
   Dim RetRit,RetRitMax,RetIncrRitMax,RetFrq
   Dim nSuperficialita
   nTrov = 0 '
   nNumSel = ScegliNumeri(aN)
   'aN = Array(0,16,49,60)
   'nSorte = 2 ' ScegliEsito
   'nClasseLunghetta = 3 'ScegliClassseLunghetta

nSorte = InputBox("Scegli sorte di ricerca","Sorte di ricerca",2)
nClasseLunghetta = InputBox("Scegli classe di ricerca","Classe di ricerca",3)


TipoAlgo = 4
   nSuperficialita = 0
   Dim contatore
   contatore = 0
   Call Scrivi
   Call Scrivi("Elaborazione effettuata con archivio lotto aggiornato all'estrazione del: " & giorno(EstrazioneFin) & "-" & Mese(EstrazioneFin) & "-" & Anno(EstrazioneFin))
   Call Scrivi
   'nRuoteSel= 1 : ReDim aRuote(1) : aRuote(1) =RO_'SelRuote(aRuote)
   Dim r
   For r = 1 To 12
      nRuoteSel = r : ReDim aRuote(r) : aRuote(r) = r
      nLunghetteDaTrov = 10000 ' Int(InputBox("Lunghette da trovare","Quantità lunghette",10))
      ReDim Preserve aRuote(nRuoteSel)
      nCicloTeo = CicloTeorico(nClasseLunghetta,nSorte,UBound(aRuote))
      nMoltip = 1
      'sMsg = "Inserire il ritardo massimo ipotizzato per la sorte voluta nella lunghetta" & vbCrLf
      'sMsg = sMsg & "Il valore mostrato è il CicloTeorico per la sorte di " & nSorte
      'sMsg = sMsg & " su " & nClasseLunghetta & " numeri su " & nRuoteSel & " ruote moltiplicato per " & nMoltip
      nRitMax = 0' Int(InputBox(sMsg,,nCicloTeo * nMoltip))
      'sMsg = "Inserire il ritardo minimo ipotizzato per la sorte voluta nella lunghetta" & vbCrLf
      'sMsg = sMsg & "Il valore mostrato è il CicloTeorico per la sorte di " & nSorte
      'sMsg = sMsg & " su " & nClasseLunghetta & " numeri su " & nRuoteSel & " ruote moltiplicato per 3"
      nRitMin = 0 ' Int(InputBox(sMsg,,nCicloTeo * 3))
      fin = EstrazioneFin
      Ini = fin - nRitMax
      If Ini <= 0 Then Ini = 1
      TimeStart = Timer
      Call GetLunghettePiuRitardate(aN,aRuote,nClasseLunghetta,nSorte,CollComb,EstrazioneIni,EstrazioneFin,nRitMin,nRitMax,nLunghetteDaTrov,TipoAlgo,nSuperficialita)
      'Call GetLunghettePiuRitardate(aN,aRuote,EstrazioneIni,EstrazioneFin,nClasseLunghetta,nSorte,CollComb)
      Call OrdinaItemCollection(CollComb,"Ritardo",,,- 1)
      For Each cColonna In CollComb
         contatore = contatore + 1
         Call StatisticaFormazioneTurbo(cColonna.aNum,aRuote,nSorte,RetRit,RetRitMax,RetIncrRitMax,RetFrq,EstrazioneIni,EstrazioneFin)
         Dim diff
         diff = RetRitMax - RetRit
         If(RetRit >= 0) Then
    
            Dim datoabasul
            datoabasul =(RetRit/RetRitMax) * 100
            diff = RetRitMax - RetRit
            If(RetRit >= 0) Then
               If(datoabasul >= 45) And(datoabasul <= 75) Then
                  Call Messaggio("trovata")
                  Call Scrivi("PROVA OUTPUT SECONDO FILTRO ABASUL con sole formazioni con ra distante dal rispettivo rs x A in terzina tra il 45% e 75%")
                  Call Scrivi("<font color=green>OK la formazione ha passato il filtro abasul per A in 3ina con valore di filtro: </font>" & datoabasul)
                  Call Scrivi("Sorte ricercata: " & nSorte & " classe: " & nClasseLunghetta)
                  Call Scrivi(SiglaRuota(aRuote(r)) & " - " & cColonna.GetStringaNum & " Rit " & RetRit & " rit max " & RetRitMax & " incmax " & RetIncrRitMax & " frequenza " & RetFrq)
               Else
                  'Call Scrivi("<font color=red>NO la formazione NON ha passato il filtro abasul per A in 3ina con valore di filtro: </font>" & datoabasul)
               End If
            End If ' x controllo valori non nulli di ra e rs
            'Call Scrivi("Sorte ricercata: " & nSorte & " classe: " & nClasseLunghetta)
            'Call Scrivi(SiglaRuota(aRuote(r)) & " " & cColonna.GetStringaNum & " Rit " & RetRit & " rit max " & RetRitMax & " incmax " & RetIncrRitMax & " frequenza " & RetFrq)
            'Call Scrivi(cColonna.GetStringaNum)
         End If
         If ScriptInterrotto Then Exit For
      Next
      Call Scrivi("------------------------------------------------------------------------------")
      If ScriptInterrotto Then Exit For
   Next 'secondo next aggiunto per tentativo di elaborare ogni ruota in una volta sola
   Call Scrivi("Tempo di elaborazione : " & FormattaSecondi(Timer - TimeStart))
End Sub
Function ScegliClassseLunghetta
   Dim aVoci(30)
   Dim k,i
   For k = 2 To(2 - 1) + UBound(aVoci)
      i = i + 1
      aVoci(i) = k
   Next
   k = ScegliOpzioneMenu(aVoci,5,"Classe lunghetta")
   ScegliClassseLunghetta = Int(aVoci(k))
End Function
Function SelRuote(aRuote)
   Dim t,k,bTutte
   bTutte = False
   't = ScegliRuote(aRuote)
   'For k = 1 To t
   'If aRuote(k) = TT_ Then
   'bTutte = True
   'Exit For
   'End If
   'Next
   If bTutte Then
      ReDim aRuote(10)
      For k = 1 To 10
         aRuote(k) = k
      Next
      SelRuote = 10
   Else
      SelRuote = t
   End If
End Function
Function FormattaSecondi(s)
   'Questa Function trasforma il numero di secondi passato come parametro in una stringa
   ' passando i secondi si ottengono ore  minuti e secondi  in formato hh:mm:ss
   ' s ---> Numero di secondi da formattare
   ' ritorna una stringa il cui formato è hh:mm:ss (la function non funziona se in totale abbiamo piu di 99 ore )
   Dim hh
   Dim Mm
   Dim Ss
   Dim TimeStr
   hh = s \ 3600
   Mm =(s Mod 3600) \ 60
   Ss = s -((hh * 3600) +(Mm * 60))
   TimeStr = Format2(hh) & ":" & Format2(Mm) & ":" & Format2(Ss)
   FormattaSecondi = TimeStr
End Function
Ottimo lotto_tom75, questo tuo script è completo, solo che adesso accanto ad ogni Ritardo Max di ogni combinazione per ambo, io devo sapere anche la data di estrazione di quando il ritardo massimo è avvenuto. Dopo questo ultimo accomodo allo script, siamo in grado di spiegare alla lettera come mettere in gioco pochissime combinazioni con due numeri per ambo, tre numeri per ambo e quattro numeri per ambo. Luigi non me ne volere, ma a me, come credo a tutti gli altri, sarà più comodo utilizzare il lavoro di lotto_tom75. Tuttavia sia a te che a Claudio e Mike58, poi chiederò se potete aiutarci ad agevolarci il lavoro con un altro semplice script, oppure lo lasceremo fare a lotto_tom75 magari potendolo integrare a questo. Grazie a tutti.
 
Ultima modifica:

Ultima estrazione Lotto

  • Estrazione del lotto
    martedì 26 marzo 2024
    Bari
    30
    51
    17
    01
    53
    Cagliari
    13
    70
    25
    68
    47
    Firenze
    28
    30
    54
    70
    88
    Genova
    67
    87
    22
    03
    62
    Milano
    22
    34
    13
    47
    24
    Napoli
    20
    72
    59
    01
    52
    Palermo
    05
    72
    65
    52
    32
    Roma
    28
    43
    75
    54
    87
    Torino
    16
    08
    17
    24
    38
    Venezia
    67
    28
    55
    60
    29
    Nazionale
    15
    69
    22
    63
    39
    Estrazione Simbolotto
    Firenze
    44
    09
    31
    22
    16
Alto