Novità

ilegend se lo ritieni interessante potremmo lavorarci su

Eugenio ho solo pochi giorni di ferie,
Finiamo l altro script, non ne comincio un altro ,che magari non porterei a termine, perché il lavoro mi stanca troppo.
Sicuramente ti aiuterà qualcun altro.
:)
 
Ciao , quando si parla di segreti ci si incuriosisce sempre,questo dovrebeb essere un riscontro per gl iambi ripetuti , da vedere se espone risultati corretti.

Codice: 
Option Explicit
Sub Main
  
  Dim Ru,id,idTmp,p,nEstrTot,qNumRimasti,nMaxColpiGestito
  Dim aEstrattiTmp,aNumUsciti,aEstratti
  Dim aTitoli
  
  
  nEstrTot = EstrazioniArchivio
  aTitoli = Array("","Numeri","Prima estrazione","Seconda estrazione","Dopo estrazioni","Esito","Colpi","Estratti","Estrazione di uscita")
  nMaxColpiGestito = 11
  
  For Ru = 1 To 12
     
      

     If Ru <> 11 Then
        ReDim aQEsitiAlColpo(nMaxColpiGestito)
        Call Scrivi("RUOTA : " & NomeRuota(Ru))
        Call InitTabella(aTitoli,vbBlue,,,vbWhite)
        For id = EstrazioneIni To EstrazioneFin
           Call Messaggio(NomeRuota(Ru) & " - " & GetInfoEstrazione(id))
        '   ReDim aEstratti (0)
           Call GetArrayNumeriRuota(id,Ru,aEstratti)
           If aEstratti(1) > 0 Then
              idTmp = id + 1
              If idTmp <= nEstrTot Then
                 Do
              '      ReDim aEstrattiTmp (0)
              '      ReDim aNumUsciti(0)
                    Call GetArrayNumeriRuota(idTmp,Ru,aEstrattiTmp)
                    p = CalcolaPuntiAzzeraUsciti(aEstratti,aEstrattiTmp,aNumUsciti,qNumRimasti)
                    If p >= 2 Then
                       Call GestioneVerificaEsito(aNumUsciti,id,idTmp,Ru,aQEsitiAlColpo,nMaxColpiGestito)
                       Exit Do
                    End If
                    If qNumRimasti >= 2 Then
                       idTmp = idTmp + 1
                    Else
                       Exit Do
                    End If
                 Loop While idTmp <= nEstrTot
              End If
           End If
           If ScriptInterrotto Then Exit Sub
           
        Next
        Call SetTableHeight(5)
        Call CreaTabella
        Call CreaTabellaEsitiPerColpo(aQEsitiAlColpo)
     End If
     Call AvanzamentoElab( 1,12, Ru )   
      
     If ScriptInterrotto Then Exit Sub
      
      
  Next
  
 
End Sub
Function CalcolaPuntiAzzeraUsciti(aE,aETmp,aNumUsciti,qNumRimasti)
   Dim i,ii,p
   ReDim aNumUsciti(5)
   p = 0
   qNumRimasti = 0
   
   For i = 1 To 5
      For ii = 1 To 5
         If aE(i) > 0 Then
            If aE(i) = aETmp(ii) Then
                p = p + 1
                aNumUsciti(p) = aE(i)
                aE(i) = 0
            End If
         End If
      Next
      If aE(i) > 0 Then
         qNumRimasti = qNumRimasti + 1
      End If
   Next

   ReDim Preserve aNumUsciti(p)
   CalcolaPuntiAzzeraUsciti = p
   
End Function

Sub GestioneVerificaEsito(aNumUsciti,id,idTmp,Ru,aQEsitiAlColpo,nMaxColpiGestito)
   Dim sRetEsito,nRetColpi,sRetEstratti,nRetIdEstr
   ReDim aDati(8)
   ReDim aRuote(1)
   aRuote(1) = Ru
   If VerificaEsito(aNumUsciti,aRuote,idTmp + 1,1,,,sRetEsito,nRetColpi,sRetEstratti,nRetIdEstr) Then
      aDati(1) = StringaNumeri(aNumUsciti)
      aDati(2) = GetInfoEstrazione(id)
      aDati(3) = GetInfoEstrazione(idTmp)
      aDati(4) =(idTmp - id)
      aDati(5) = sRetEsito
      aDati(6) = nRetColpi
      aDati(7) = sRetEstratti
      aDati(8) = GetInfoEstrazione(nRetIdEstr)

    
       If nRetColpi >= nMaxColpiGestito Then
          aQEsitiAlColpo(nMaxColpiGestito) = aQEsitiAlColpo(nMaxColpiGestito) + 1
       Else
          aQEsitiAlColpo(nRetColpi) = aQEsitiAlColpo(nRetColpi) + 1

       End If
       
   Else
      aDati(1) = StringaNumeri(aNumUsciti)
      aDati(2) = GetInfoEstrazione(id)
      aDati(3) = GetInfoEstrazione(idTmp)
      aDati(4) =(idTmp - id) + 1
      aDati(5) = ""
      aDati(6) = ""
      aDati(7) = ""
      aDati(8) = ""

   

   End If
   Call AddRigaTabella(aDati,vbYellow)
      
End Sub

Sub CreaTabellaEsitiPerColpo(aQEsitiAlColpo)
   Dim qT,i
   
   For i = 1 To UBound(aQEsitiAlColpo)
      qT = qT + aQEsitiAlColpo(i)
   Next
   
   Scrivi "Esiti totali : " & qT 
   
   ReDim aV(3)
   aV(1) = "Al Colpo"
   aV(2) = "Quantità"
   aV(3) = "%"
   
   Call InitTabella(aV,vbRed,,,vbWhite)
   For i = 1 To UBound(aQEsitiAlColpo) - 1
      aV(1) = i
      aV(2) = aQEsitiAlColpo(i)
      aV(3) = Round ( ProporzioneX( aQEsitiAlColpo(i) , qT , 100 ) ,3) 
      Call AddRigaTabella(aV,vbCyan)
   Next
   aV(1) = ">=" & i
   aV(2) = aQEsitiAlColpo(i)
   aV(3) = Round ( ProporzioneX( aQEsitiAlColpo(i) , qT , 100 ) ,3) 

   Call AddRigaTabella(aV,vbCyan)

   Call SetTableHeight(5)
   Call CreaTabella
   
   Call Scrivi
   Call Scrivi
    
End Sub
 
Giggio di primo acchitto con quelle poche righe di codice hai fatto una meraviglia . Devo comunque controllare .
quando si parla di segreti ci si incuriosisce sempre,
Clicca per espandere...
Allora al secondo segreto :):):):):) anche se non sono riuscito a capirlo bene . Vediamo se insieme riusciamo ad interpretare cosa scrisse Franco Archimede.


Ciao Eugenio
 
Ultima modifica:
ho notato un caso di un ambo triplicato , pensa un po' ma non mi ricordo piu dove .... su milano mi pare ...
non saprei cosa voleva dire Archimede.
 
A ben guardare casi di ambi sortiti 3 volte nel giro di poche estrazionì ce ne sono diversi .
Con questa modifica vengono evidenziati di rosso
Codice: 
Option Explicit
Dim sOldKey 

Sub Main
  
  Dim Ru,id,idTmp,p,nEstrTot,qNumRimasti,nMaxColpiGestito
  Dim aEstrattiTmp,aNumUsciti,aEstratti
  Dim aTitoli
  
  
  nEstrTot = EstrazioniArchivio
  aTitoli = Array("","Numeri","Prima estrazione","Seconda estrazione","Dopo estrazioni","Esito","Colpi","Estratti","Estrazione di uscita")
  nMaxColpiGestito = 11
  
  For Ru = 1 To 12
     
      

     If Ru <> 11 Then
        ReDim aQEsitiAlColpo(nMaxColpiGestito)
        Call Scrivi("RUOTA : " & NomeRuota(Ru))
        Call InitTabella(aTitoli,vbBlue,,,vbWhite)
        sOldKey    = ""
        For id = EstrazioneIni To EstrazioneFin
           Call Messaggio(NomeRuota(Ru) & " - " & GetInfoEstrazione(id))
        '   ReDim aEstratti (0)
           Call GetArrayNumeriRuota(id,Ru,aEstratti)
           If aEstratti(1) > 0 Then
              idTmp = id + 1
              If idTmp <= nEstrTot Then
                 Do
              '      ReDim aEstrattiTmp (0)
              '      ReDim aNumUsciti(0)
                    Call GetArrayNumeriRuota(idTmp,Ru,aEstrattiTmp)
                    p = CalcolaPuntiAzzeraUsciti(aEstratti,aEstrattiTmp,aNumUsciti,qNumRimasti)
                    If p >= 2 Then
                       Call GestioneVerificaEsito(aNumUsciti,id,idTmp,Ru,aQEsitiAlColpo,nMaxColpiGestito)
                       Exit Do
                    End If
                    If qNumRimasti >= 2 Then
                       idTmp = idTmp + 1
                    Else
                       Exit Do
                    End If
                 Loop While idTmp <= nEstrTot
              End If
           End If
           If ScriptInterrotto Then Exit Sub
           
        Next
        Call SetTableHeight(5)
        Call CreaTabella
        Call CreaTabellaEsitiPerColpo(aQEsitiAlColpo)
     End If
     Call AvanzamentoElab(1,12,Ru)
      
     If ScriptInterrotto Then Exit Sub
      
      
  Next
  
 
End Sub
Function CalcolaPuntiAzzeraUsciti(aE,aETmp,aNumUsciti,qNumRimasti)
   Dim i,ii,p
   ReDim aNumUsciti(5)
   p = 0
   qNumRimasti = 0
   
   For i = 1 To 5
      For ii = 1 To 5
         If aE(i) > 0 Then
            If aE(i) = aETmp(ii) Then
                p = p + 1
                aNumUsciti(p) = aE(i)
                aE(i) = 0
            End If
         End If
      Next
      If aE(i) > 0 Then
         qNumRimasti = qNumRimasti + 1
      End If
   Next

   ReDim Preserve aNumUsciti(p)
  
   
   CalcolaPuntiAzzeraUsciti = p
   
End Function

Sub GestioneVerificaEsito(aNumUsciti,id,idTmp,Ru,aQEsitiAlColpo,nMaxColpiGestito)
   Dim sRetEsito,nRetColpi,sRetEstratti,nRetIdEstr
   Dim sKey 
   ReDim aDati(8)
   ReDim aRuote(1)
   aRuote(1) = Ru
   
   
   
   If VerificaEsito(aNumUsciti,aRuote,idTmp + 1,1,,,sRetEsito,nRetColpi,sRetEstratti,nRetIdEstr) Then
      aDati(1) = StringaNumeri(aNumUsciti)
      aDati(2) = GetInfoEstrazione(id)
      aDati(3) = GetInfoEstrazione(idTmp)
      aDati(4) =(idTmp - id)
      aDati(5) = sRetEsito
      aDati(6) = nRetColpi
      aDati(7) = sRetEstratti
      aDati(8) = GetInfoEstrazione(nRetIdEstr)

    
       If nRetColpi >= nMaxColpiGestito Then
          aQEsitiAlColpo(nMaxColpiGestito) = aQEsitiAlColpo(nMaxColpiGestito) + 1
       Else
          aQEsitiAlColpo(nRetColpi) = aQEsitiAlColpo(nRetColpi) + 1

       End If
       
   Else
      aDati(1) = StringaNumeri(aNumUsciti)
      aDati(2) = GetInfoEstrazione(id)
      aDati(3) = GetInfoEstrazione(idTmp)
      aDati(4) =(idTmp - id) + 1
      aDati(5) = ""
      aDati(6) = ""
      aDati(7) = ""
      aDati(8) = ""

   

   End If
   
   Call OrdinaMatrice  (aNumUsciti,1 ) 
   sKey   = StringaNumeri  ( aNumUsciti)
   If sKey  = sOldKey Then 
       Call AddRigaTabella(aDati,vbRed)
   Else
       Call AddRigaTabella(aDati,vbYellow)   
   End If 
   sOldKey   = sKey
     
      
End Sub

Sub CreaTabellaEsitiPerColpo(aQEsitiAlColpo)
   Dim qT,i
   
   For i = 1 To UBound(aQEsitiAlColpo)
      qT = qT + aQEsitiAlColpo(i)
   Next
   
   Scrivi "Esiti totali : " & qT
   
   ReDim aV(3)
   aV(1) = "Al Colpo"
   aV(2) = "Quantità"
   aV(3) = "%"
   
   Call InitTabella(aV,vbRed,,,vbWhite)
   For i = 1 To UBound(aQEsitiAlColpo) - 1
      aV(1) = i
      aV(2) = aQEsitiAlColpo(i)
      aV(3) = Round(ProporzioneX(aQEsitiAlColpo(i),qT,100),3)
      Call AddRigaTabella(aV,vbCyan)
   Next
   aV(1) = ">=" & i
   aV(2) = aQEsitiAlColpo(i)
   aV(3) = Round(ProporzioneX(aQEsitiAlColpo(i),qT,100),3)

   Call AddRigaTabella(aV,vbCyan)

   Call SetTableHeight(5)
   Call CreaTabella
   
   Call Scrivi
   Call Scrivi
    
End Sub









[ /code]
 
Giggio eccone uno trovato con il tuo script .

Domani se riesco pubblico la 2 parte della legge segreta di franco archimede . Io non ho capito molto vediamo se con il tuo aiuto e quello di i legend riusciamo a capirne di più .fi 90 47.JPG

Ciao Eugenio
 
I LEGEND GIGGIO ecco un altro parametro della legge segreta del lotto . Io non sono riuscito a capire molto di questo parametro voi che ne pensate ?
Riusciremo a farne uno script?

Ciao Eugenio

2 settembre 1990-1.jpg
2 settembre 1990-2.jpg

2 settembre 1990-3.jpg
 
mha io constato due cose
la prima è che questo studioso considera i ritardi a partire da 0
la seconda che sta introducendo il concetto di ritardo del ritardo ...che lui chiam aritardo temporale.
Non so se ho capito bene.. ma sembrerebe cosi.
 
Giggio Analizzando la seguente tabella :

Codice: 
Da zero a 9 estrazioni
 
Per concludere in maniera fruttuosa questa seconda puntata dedicata alla Legge Segreta del Lotto vi voglio fornire i dati relativi ai ritardi temporali più interessanti che si incontrano per quantità di settimane di ritardo che vanno da 0 a 9.

    Ruota                           Ritardo Temporale     
2 estrazioni    Torino     ( 14 estrazioni )    numeri interessati 65 19 48 85 9
3 estrazioni    Napoli     ( 10 estrazioni  )    numeri interessati 38 43 47 50 51
4 estrazioni    Napoli     ( 10 estrazioni  )    numeri interessati 1 39 86
5 estrazioni    Bari           ( 16 estrazioni  )    numeri interessati 27 31 48
6 estrazioni    Venezia    ( 17 estrazioni  )    numeri interessati 61
7 estrazioni    Firenze     ( 11 estrazioni  )    numeri interessati 14 28
8 estrazioni    Roma        ( 21 estrazioni  )    numeri interessati 21 57 64
9 estrazioni    Firenze     ( 18 estrazioni  )    numeri interessati 43  83 87

considerando la ruota di Napoli nell' estrazione del 28-07-1990

napoli 18 agosto rit. 3 estrazioni.JPG

all' estrazione del 18-08-1990 abbiamo un ritardo di 3 estrazioni della cinquina sincrona 43-51-47-38-50

la tabella sopra indica come ritardo alla ruota di Napoli come Ritardo Temporale di 10 estrazioni vuol forse dire che è da 10 estrazioni che a ritardo 3 non esce nessun numero ?

ciao Eugenio
 
esattamente , come testimonia lo script fatto apposta

Codice: 
Option Explicit
Sub Main
   Dim idEst,Rt,e,aEstratti,Rit , idEstrIni , idEstrFin 
   Dim nMaxRitGestito
   
   nMaxRitGestito = 11
   idEstrIni = EstrazioneIni
   idEstrFin = EstrazioneFin  
   
   For Rt = 1 To 12
      ReDim aRDR(nMaxRitGestito)
      ReDim aRDRMax(nMaxRitGestito)
      ReDim aRDRFrq(nMaxRitGestito)
      If Rt <> 11 Then
         For idEst = idEstrIni To idEstrFin 
            Call GetArrayNumeriRuota(idEst,Rt,aEstratti)
            ' incrementa tutti i ritardi dei ritardi
            For e = 0 To nMaxRitGestito
               aRDR(e) = aRDR(e) + 1
            Next
            ' azzera i ritardi dei ritardi usciti
            For e = 1 To 5
               Rit = EstrattoRitardoTurbo(Rt,aEstratti(e),,idEst - 1)
               If Rit >= nMaxRitGestito Then
                  If aRDR(nMaxRitGestito) > aRDRMax(nMaxRitGestito) Then aRDRMax(nMaxRitGestito) = aRDR(nMaxRitGestito)
                  aRDRFrq(nMaxRitGestito) = aRDRFrq(nMaxRitGestito) + 1
                  aRDR(nMaxRitGestito) = 0
               Else
                  If aRDR(Rit) > aRDRMax(Rit) Then aRDRMax(Rit) = aRDR(Rit)
                  aRDRFrq(Rit) = aRDRFrq(Rit) + 1
                  aRDR(Rit) = 0
               End If
            Next
         Next
         Call CreaReport(Rt,aRDR,aRDRMax,aRDRFrq ,idEstrFin ,nMaxRitGestito)
         Call AvanzamentoElab(1,12,Rt)
         If ScriptInterrotto Then Exit Sub
      End If
   Next
End Sub
Sub CreaReport(Rt,aRDR,aRDRMax,aRDRFrq ,idEstrFin , nMaxRitGestito)
   Dim i  
   Call Scrivi("RUOTA DI : " & NomeRuota(Rt))
   
   ReDim aRtiN(90)
   For i = 1 To 90 
      aRtiN(i) = EstrattoRitardoTurbo(Rt, i,,idEstrFin)

   Next
   
   
   ReDim aV(5)
   aV(1) = "Ritardo"
   aV(2) = "Rit"
   aV(3) = "RitMax"
   aV(4) = "Freq"
   aV(5) = "Numeri interessati"
   
   
   Call InitTabella(aV,vbBlue,,,vbWhite)
   For i = 0 To UBound(aRDR) - 1
      aV(1) = i
      aV(2) = aRDR(i)
      aV(3) = aRDRMax(i)
      aV(4) = aRDRFrq(i)
      aV(5) = GetNumeriAlRitardo (i ,aRtiN,nMaxRitGestito)
      Call AddRigaTabella(aV,vbYellow)
   Next
   aV(1) = ">= " & i
   aV(2) = aRDR(i)
   aV(3) = aRDRMax(i)
   aV(4) = aRDRFrq(i)
   aV(5) = GetNumeriAlRitardo (i ,aRtiN,nMaxRitGestito)

   Call AddRigaTabella(aV,vbYellow)
   Call SetTableHeight(5)
   Call CreaTabella
End Sub

Function GetNumeriAlRitardo  ( Rit , aRitardoNumeri , nMaxRitGestito )

   Dim sNumeri , i 
   sNumeri = ""
   
   If Rit = nMaxRitGestito  Then
      For i =1 To 90 
         If aRitardoNumeri(i) >= Rit  Then 
            sNumeri = sNumeri & Format2(i) & "."
         End If 
      Next

   Else
      For i =1 To 90 
         If aRitardoNumeri(i) = Rit  Then 
            sNumeri = sNumeri & Format2(i) & "."
         End If 
      Next
   End If 
   
   GetNumeriAlRitardo  = RimuoviLastChr ( sNumeri , ".")
   
End Function
 
Giggio ottimo script . Anche se a prima impressione non ho capito come si potrebbe sfruttare .
E su tuo consiglio ritardo dei ritardi ho visto che è già implementato in spaziometria . Vedi foto .

ritardo dei ritardi.JPG
 
Credo sia il solito discorso si individuano situazioni vicine ai limiti conosciuti e ci si affida alla sorte
a logica mi verrebbe da dire che più numeri allo stesso ritardo dovrebbero sfaldarsi brevemente per almeno 1
ma da qui a renderlo un metodo proficuo penso passi molta strada .
 
Devi accedere o registrarti per poter rispondere.

Ultima estrazione Lotto

  • Estrazione del lotto
    martedì 14 gennaio 2025
    Bari
    41
    25
    12
    73
    55
    Cagliari
    54
    20
    48
    32
    67
    Firenze
    75
    23
    68
    10
    38
    Genova
    33
    27
    81
    70
    64
    Milano
    68
    01
    64
    86
    87
    Napoli
    47
    75
    45
    10
    21
    Palermo
    55
    86
    33
    53
    70
    Roma
    88
    78
    61
    06
    07
    Torino
    76
    08
    23
    61
    82
    Venezia
    25
    15
    49
    21
    81
    Nazionale
    70
    10
    32
    78
    07
    Estrazione Simbolotto
    Bari
    07
    14
    28
    45
    31
    Archivio estrazioni lotto Ritardi top 15 Frequenze top 15

Ultimi Messaggi

Indietro
Alto