Novità

ilegend se lo ritieni interessante potremmo lavorarci su

i legend

Premium Member
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.
:)
 

Giggio

Super Member >PLATINUM<
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
 

genios

Advanced Member >PLATINUM<
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,
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:

Giggio

Super Member >PLATINUM<
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.
 

Giggio

Super Member >PLATINUM<
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]
 

genios

Advanced Member >PLATINUM<
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
 

genios

Advanced Member >PLATINUM<
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
 

Giggio

Super Member >PLATINUM<
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.
 

genios

Advanced Member >PLATINUM<
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
 

Giggio

Super Member >PLATINUM<
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
 

genios

Advanced Member >PLATINUM<
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
 

Giggio

Super Member >PLATINUM<
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 .
 

Ultima estrazione Lotto

  • Estrazione del lotto
    giovedì 28 marzo 2024
    Bari
    49
    73
    67
    86
    19
    Cagliari
    64
    36
    37
    02
    04
    Firenze
    66
    27
    44
    90
    17
    Genova
    09
    44
    78
    85
    19
    Milano
    70
    14
    47
    38
    27
    Napoli
    80
    29
    28
    45
    39
    Palermo
    54
    59
    78
    47
    62
    Roma
    17
    22
    49
    52
    88
    Torino
    71
    35
    75
    74
    60
    Venezia
    40
    84
    02
    63
    29
    Nazionale
    08
    13
    44
    69
    85
    Estrazione Simbolotto
    Firenze
    06
    35
    16
    18
    05
Alto