Listato coppie di ambi mai usciti contemporaneamente su tutte

[i legend]

Cinzia grazie, mi fa piacere che i risultati ti tornino
ecco un piccolo script che ti fa capire quanti confronti bisogna calcolare

Option Explicit
Sub Main
   Dim n1,n2,M
   Dim aAmbi(4005)
   M = 0
   For n1 = 1 To 89
      For n2 = n1 + 1 To 90
         M = M + 1
         aAmbi(M) = Array(0,n1,n2)
      Next
   Next
   M = 0
   For n1 = 1 To UBound(aAmbi) - 1
      For n2 = n1 + 1 To UBound(aAmbi)
         M = M + 1
      Next
   Next
   Scrivi "Combinazioni= " & M
End Sub

per 3916 combinazioni impieghi il tempo calcolato con lo script
per farti un idea fai una proporzione per tutte le combinazioni all incirca
per il mio pc sarebbe troppo tempo
in un array non posso allocare tanto spazio
facendo i calcoli on the fly e filtrando solo quelli a zero forse sarebbe possibile ma il tempo sarebbe ugualmente lungo ed ho paura che si impallerebbe il pc.
sicuramente lo script si potrebbe ottimizzare ma dovrei pensarci . vediamo se mi viene in mente qualcosa ti aggiorno
se non ho fatto male i calcoli impiegerei circa 12 ore

 

[Cinzia27]

Capisco. E se facessimo confontare un piccolo numero di ambi per volta con gli altri 4005 ?

 

[i legend]

Ciao potremmo costruire tanti piccoli file txt , in una cartella.
Ora non so quante righe possa contenere la funzione leggifile.
Esempio può contenere 10000 righe
Si dividono le 8000000 e oltre colonne per ottenere 800 file e in 100 utenti in pochi minuti il lavoro è fatto .
Bisognerebbe dividere il lavoro in piccoli pezzi.
Questo è quello che mi viene in mente
Una volta calcolati si memorizzano quelli a zero uscite in un file txt e poi si aggiornano solo quelli .
Al Momento non mi viene in mente nulla.
Sicuramente esiste una ricerca più veloce
Bisogna ingegnarsi un po.
Cmq per ora un piccolo passo in velocità è già fatto.
Se non tieni nulla in memoria questo script è già una base.
Ma 8000000 milioni di combinazioni per tutte le ruote è impegnativo.
Ciao vada a nanna che tra un po vado a lavoro.
Notte

 

[Cinzia27]

Le mie possibilità sono limitate.Lascio a te la guida dell' operazione. Ci dirai cosa fare.
Per il momento, buon riposo

 

[i legend]

Ciao Cinzia, non ho trovato un modo per filtrare qualche ambo.
Ciclare 4005 ambi è un lavoro arduo.
Bisognerebbe dividere la ricerca in segmenti più piccoli in modo tale da avere più pc che la portano insieme.
Ci penso ancora ma non credo di venirne a capo.

 

[Cinzia27]

Ciao Cinzia, non ho trovato un modo per filtrare qualche ambo.
Ciclare 4005 ambi è un lavoro arduo.
Bisognerebbe dividere la ricerca in segmenti più piccoli in modo tale da avere più pc che la portano insieme.
Ci penso ancora ma non credo di venirne a capo.

Lasciamo stare, Ilegend. Non vale la pena, ho fatto lavorare il pc partendo da capogioco 1 per poi passare a 2, ecc. , già al capogioco 1 mi vengono fuori più di mille ambi. Accontentiamoci delle coppie di ambi consecutivi e teniamo le energie per qualcosa di più proficuo.
Grazie per la condivisione

 

[palas]

per controllo, se potete

Tempo esecuzione 9 secondi
doppi ambi mai usciti in contemporanea esempio su Bari n.3751 su 3828, dal 1871 ad oggi

 

[palas]

da controllare è una bozza e non so se ho capito il quesito, ho letto superficialmente.





Option Explicit Sub Main '''''''SVILUPPA doppi ambi consecutivi mai usciti in contemporanea ''''''' Dim ct,j,r,sor,fine,retrit,retfre,qt,cx,a,b,c,d,tc ReDim anr(90),ar(1) r = InputBox("Ruota",,1) fine = InputBox("Estraz.n.",,EstrazioneFin) sor = InputBox("Sorte",,2) '''' ar(1) = r ' Scrivi "Script Ricerca doppio ambo di consecutivi mai usciti in contemporanea ",1 Scrivi "Ruota di " & NomeRuota(r),1,2,3 Scrivi "Range Estr. " & EstrazioneIni & " : " & EstrazioneFin,1 Scrivi ReDim nm(2),num(4) ' For a = 1 To 89 b = a + 1 ' ct = 0 For c = b + 1 To 89 d = c + 1 ct = ct + 1 tc = tc + 1 Messaggio(Format2(a) & " " & Format2(b) & " " & Format2(c) & " " & Format2(d) & " / " & ct) '' num(1) = Format2(a) num(2) = Format2(b) num(3) = Format2(c) num(4) = Format2(d) '' Call StatisticaFormazioneTurbo(num,ar,4,retrit,,,retfre,EstrazioneIni,fine) ''''se vergine controlla se ci sono presenti 2 ambi consecutivi altrimenti scarta If retfre = 0 Then cx = cx + 1 '''verifica se presenti 2 ambi consecutivi Scrivi StringaNumeri(num," ") & " Rc " & FormattaStringa(retrit,"0000") & " Fr." & FormattaStringa(retfre,"000"),1 End If Next Next Scrivi "Totale Quaterna Vergine " & cx & " su totale doppio Ambo contemporaneo " & tc,1 Scrivi TempoTrascorso End Sub

 

[Cinzia27]

Grazie, Palas, ma non è quello che stavamo cercando di fare.
Ti spiego, abbiamo già il listato sulla ricerca di coppie di ambi consecutivi mai usciti insieme su tutte le ruote.
E quindi questa ricerca è conclusa e ho pubblicato i risultati , si è ottenuto un numero ragionevole di coppie.
La stessa volevamo farla per tutti gli ambi e non solo per quelli consecutivi. L' attrezzatura c'è ( lo script), sono i tempi che sono improponibili e ancor di più il numero altissimo di coppie.
Esempio qualsiasi di coppia di ambi usciti insieme su tutte è 51.80 e 64.07 (estr. 11/03/21)
Esempio qualsiasi di coppia di ambi MAI usciti insieme su tutte 03.07 - 35.42

 

[palas]

va bene, come non detto.
si tratta di elaborare i 2milione e 500mila quaterne, ci vogliono all'incirca 12-13 minuti, circa con uno script, piu o meno

 

[i legend]

va bene, come non detto.
si tratta di elaborare i 2milione e 500mila quaterne, ci vogliono all'incirca 12-13 minuti, circa con uno script, piu o meno

Una quaterna da origine a sei ambi credo
Questi sei ambi possono non aver dato origine e ad una quaterna na potrebbero essere sortiti uno su bari e l altro su Napoli e sarebbero ugualmente da scartare.
Ho tentato anche questa strada , come filtro ma fa poco.

Il mio pc è un po datato quindi 13 minuti sono un sogno per elaborare le quaterna a me partono ore.
Potresti postare il tuo script ? Mi piacerebbe testarlo.
Grazie

 

[i legend]

Nel messaggio sopra intendevo dire che anche la sorte di un terno potrebbe invaludare la ricerca.
Esempio ipotetico
3,24 ,55,6 1
Potrebbe non aver dato quaternevma magari un terno che invaliderebbe la ricerca .
Spero di essermi spiegato.
Ciao

 

[Cinzia27]

Ciao, Ilegend e Palas.
Per coppia di ambi mai usciti nella stessa estrazione, intendevo qualsiasi coppia di ambi, anche componenti terno o quaterna. Quindi vanno escluse a priori le coppie di ambi uscite nella stessa ruota che compongono terno o quaterna.

 

[lotto_tom75]

ciao cinzia ho caricato i risultati su un foglio di calcolo
iconfrontato le colonne 1 ad 1 con stessa formattazione
non ho trovato differenze ma potrei sbagliare
controlla anche tu i dati per favore
fammi sapere che ne pensi

Option Explicit
' script per Cinzia utente lotto ced
' non si garantisce la corretttezza dei dati
' lo script potrebbe essere ottimizzato ulteriormente
' caricare tutte le 4005 combinazioni di ambi porterebbe tempi di attesa molto lunghi
' i calcoli impiegherebbero troppa memoria
' o si fa il calcolo on the fly oppure si scompongono tutte le colonne in piu file di testo
' entrambe le soluzioni comportano una notevole spesa di tempo
Sub Main
   Dim i,j,m,k,E
   Dim nColT
   Dim nConv
   Dim aR(1)
   Dim aAmbi(89)
   Dim sConv
   Dim IniRange,FinRange
   IniRange = 1
   FinRange = EstrazioneFin
   nColT = Combinazioni(89,2)
   ReDim aStat(nColT,3)
   aR(1) = 11
   '
   ' comincio eleborazioni dati
   Call ResetTimer
   ' carico gli ambi consecutivi
   Call CaricaArrayAmbiConsecutivi(aAmbi)
   m = 0
   ' ciclo l array che contiene gli ambi in modo da accoppiarli
   For i = 1 To UBound(aAmbi) - 1
      If ScriptInterrotto Then Exit For
      ReDim aRit(0),aIdE(0)
      ' lancio la funzione elenco ritardi e trovo le estrazioni in cui l ambo è presente
      Call ElencoRitardiTurbo(aAmbi(i),aR,2,IniRange,FinRange,aRit,aIdE)
      For j = i + 1 To UBound(aAmbi)
         If ScriptInterrotto Then Exit For
         ' lancio la funzione per trovare gli id estrazioni in cui è presente l altra coppia di ambi da confrontare
         ReDim aRit1(0),aIdE1(0)
         Call ElencoRitardiTurbo(aAmbi(j),aR,2,IniRange,FinRange,aRit1,aIdE1)
         m = m + 1
         nConv = 0
         sConv = ""
       '  ciclo  l elenco estrazioni e verifico se queste estrazioni sono presenti anche nell altra lista
         For k = 1 To UBound(aIdE1) - 1
            If ScriptInterrotto Then Exit For
            E = aIdE1(k)
            ' questa funzione sembra funzionare correttamente dalle verifiche fatte , ma non si escludono possibili errori
            ' presupposto fondamentale che la lista sia una lista ordinata
            If RicercaElementoInLista(aIdE,E) = 1 Then ' non cambiare questa riga =1 è il risultato che la funzione da se l elemento è presente nella lista
               nConv = nConv + 1
               sConv = sConv & E & ";"
            End If
         Next

         aStat(m,1) = StringaNumeri(aAmbi(i),,True) & "[ " & FormatSpace(aRit(UBound(aRit)),3) & "] - " & StringaNumeri(aAmbi(j),,True) & "[ " & FormatSpace(aRit1(UBound(aRit1)),3) & "]  "
         aStat(m,2) = nConv
         aStat(m,3) = RimuoviLastChr(sConv,";")
         Call AvanzamentoElab(1,nColT,m)
      Next
   Next
   ' ordino la matrice in modo da avere i risultati in ordine crescente
   ' anche gli ambi vengono ordinati
   Dim aIdCol(2),aIdV(2)
   aIdCol(1) = 2:aIdCol(2) = 1
   aIdV(1) = 1:aIdV(2) = 1
   Call OrdinaMatrice2(aStat,aIdCol,aIdV)
   Scrivi TempoTrascorso
  ' scrivo In Output i risultati ottenuti
   Dim sChrSep
   For i = 1 To UBound(aStat)
      For j = 1 To UBound(aStat,2)
         sChrSep = "  |  "
         If j > 2 Then sChrSep = " "
         Scrivi aStat(i,j) & sChrSep,,0
      Next
      Scrivi
   Next
End Sub
Sub CaricaArrayAmbiConsecutivi(aAmbi)
   Dim n1,n2
   For n1 = 1 To 89
      n2 = n1 + 1
      aAmbi(n1) = Array(0,n1,n2)
   Next
End Sub
' ho utilizzato la funzione fix per ottenere l id colonna senza parte decimale
' spero che non vengano saltate colonne ,  dalle verifiche che ho fatto sembra di no
'ma potrebbero esserci dei casi o per lo meno non mi sento di escluderlo
' questo è un algoritmo di ricerca binaria in una lista
' in rete si trovano varie spiegazioni
' '
Function RicercaElementoInLista(aLista,E)
   Dim Primo_
   Dim Ultimo
   Dim Mezzo
   Dim tro
   tro = - 1
   Primo_ = 1
   Ultimo = UBound(aLista) - 1
   Do While(Primo_ <= Ultimo And tro = - 1)
      Mezzo = Fix((Primo_ + Ultimo)/2)
      If aLista(Mezzo) < E Then
         Primo_ = Mezzo + 1
      ElseIf aLista(Mezzo) = E Then
         tro = 1
      ElseIf aLista(Mezzo) > E Then
         Ultimo = Mezzo - 1
      End If
   Loop
   RicercaElementoInLista = tro
End Function

Come ha scritto prima Cinzia, che saluto, complimenti per il "Grandioso" script i legend . Penso che ultra figo sarebbe poterlo potenziare anche con lo sviluppo integrale di tutti gli ambi partendo da una base numerica contenuta e scelta di volta in volta anzichè dai 90. Potrebbe essere un altro modo per diminuire notevolmente il carico di elaborazione rispetto agli 8 MLN e passa di risultati che hai brillantemente anticipato...

 

[i legend]

ciao Cinzia,Palas
Ho lanciato lo script di palas
è molto veloce , ma non considera gli ambi a coppia se sono sortiti su tutte .
cmq deve avere un pc velocissiomo per ottenere quei tempi, io ho un vecchio macinino
ciao a dopo

 

[i legend]

Ciao Tom
grazie
il controllo e il ciclo dei 4005 ambi ossia l integrale di tutte le coppie , è la strada piu elementare e semplice, sicuramente esiste una scorciatoia, basta trovarla
cmq se serve solo gli ambi a zero incroci
basta fare una piccola modifica allo script iniziale, ma perdiamo tutti gli altri ossia quante volte si sono incrociati e in che date
a mio avviso una statistica sulle frequenze sarebbe interessante
faccio un esempio
ho l ambo 1.2 su tutte
gioco quello che si è mai accoppiato , quello che si è accoppiato meno o quello che si è accoppiato piu spesso?
con questo nuovo script questo non è piu possibile
cmq lo script guadagna in velocità.
fatemi sapere che ne pensate
eccolo , sperando che i risultati siano esatti.
purtoppo se ci dovessero essere errori non si possono piu eliminare gli script con bug , quindi guardare sempre all ultimo

Option Explicit
' non si garantisce la corretttezza dei dati
' lo script potrebbe essere ottimizzato ulteriormente
' caricare tutte le 4005 combinazioni di ambi porterebbe tempi di attesa molto lunghi
' i calcoli impiegherebbero troppa memoria
' o si fa il calcolo on the fly oppure si scompongono tutte le colonne in piu file di testo
' entrambe le soluzioni comportano una notevole spesa di tempo
Sub Main
   Dim i,j,m,k,E,y
   Dim nColT
   Dim nConv
   Dim aR(1)
   Dim aAmbi(89)
   ReDim aAmbiaZero(0)
   Dim sConv
   Dim IniRange,FinRange
   IniRange = 1
   FinRange = EstrazioneFin
   nColT = Combinazioni(89,2)
   ReDim aStat(nColT,3)
   aR(1) = 11
   '
   ' comincio eleborazioni dati
   Call ResetTimer
   ' carico gli ambi consecutivi
   Call CaricaArrayAmbiConsecutivi(aAmbi)
   m = 0
   ' ciclo l array che contiene gli ambi in modo da accoppiarli
   For i = 1 To UBound(aAmbi) - 1
      If ScriptInterrotto Then Exit For
      ReDim aRit(0),aIdE(0)
      ' lancio la funzione elenco ritardi e trovo le estrazioni in cui l ambo è presente
      Call ElencoRitardiTurbo(aAmbi(i),aR,2,IniRange,FinRange,aRit,aIdE)
      For j = i + 1 To UBound(aAmbi)
         If ScriptInterrotto Then Exit For
         ' lancio la funzione per trovare gli id estrazioni in cui è presente l altra coppia di ambi da confrontare
         ReDim aRit1(0),aIdE1(0)
         Call ElencoRitardiTurbo(aAmbi(j),aR,2,IniRange,FinRange,aRit1,aIdE1)
         m = m + 1
         nConv = 0
         sConv = ""
         '  ciclo  l elenco estrazioni e verifico se queste estrazioni sono presenti anche nell altra lista
         For k = 1 To UBound(aIdE1) - 1
            If ScriptInterrotto Then Exit For
            E = aIdE1(k)
            ' questa funzione sembra funzionare correttamente dalle verifiche fatte , ma non si escludono possibili errori
            ' presupposto fondamentale che la lista sia una lista ordinata
            If RicercaElementoInLista(aIdE,E) = 1 Then nConv = 1: Exit For' non cambiare questa riga =1 è il risultato che la funzione da se l elemento è presente nella lista
         Next
         If nConv = 0 Then
            y = y + 1
            ReDim Preserve aAmbiaZero(y)
            aAmbiaZero(y) = StringaNumeri(aAmbi(i),,True) & "[ " & FormatSpace(aRit(UBound(aRit)),3) & "] - " & StringaNumeri(aAmbi(j),,True) & "[ " & FormatSpace(aRit1(UBound(aRit1)),3) & "]  "
         End If
         Call AvanzamentoElab(1,nColT,m)
      Next
   Next
   For y = 1 To UBound(aAmbiaZero)
      Scrivi aAmbiaZero(y)
   Next
   Scrivi TempoTrascorso
End Sub
Sub CaricaArrayAmbiConsecutivi(aAmbi)
   Dim n1,n2
   For n1 = 1 To 89
      n2 = n1 + 1
      aAmbi(n1) = Array(0,n1,n2)
   Next
End Sub
Function RicercaElementoInLista(aLista,E)
   Dim Primo_
   Dim Ultimo
   Dim Mezzo
   Dim tro
   tro = - 1
   Primo_ = 1
   Ultimo = UBound(aLista) - 1
   Do While(Primo_ <= Ultimo And tro = - 1)
      Mezzo = Fix((Primo_ + Ultimo)/2)
      If aLista(Mezzo) < E Then
         Primo_ = Mezzo + 1
      ElseIf aLista(Mezzo) = E Then
         tro = 1
      ElseIf aLista(Mezzo) > E Then
         Ultimo = Mezzo - 1
      End If
   Loop
   RicercaElementoInLista = tro
End Function

 

[lotto_tom75]

Non so se questo tuo ultimo script lo fa già maestro ma io intendevo questo:

Partendo da un gruppo base scelto da tabella colorata molto contenuto rispetto i 90 (esempio i primi 30 numeri) poter conservare il tipo di analisi indicata da Cinzia ma appunto valutando tutte le coppie generabili dai 30 elementi scelti e non solo le coppie di consecutivi come fa adesso.



ps: cosa intendi con "non si possono piu eliminare gli script con bug" ?

 

[i legend]

Se uno script avesse un bug , purtroppo resta lì , perché non si possono più modificare i post.
Pertanto guardare sempre l ultimo
Script.

 

[i legend]

Ciao, qualcuno ha testato lo script per gli ambi consecutivi?
Se co fossero errori per favore comunicateli così pensiamo a come migliorarlo.
Grazie

X tom
Ciao tom per te fare questa modifica è uno scherzo da ragazzi. Lo script è commentato.
Devi caricare lo sviluppo degli ambi nel vettore che ora sviluppa i consecutivi e poi e tutto uguale.
È facile.
Ciao

 

[Cinzia27]

L' ho provato, I legend. E' ottimo e velocissimo. Ho confrontato i risultati coi miei e corrispondono esattamente.
Ecco, lo vorrei così : ambi che non si sono mai presentati insieme non rivolto ai soli ambi consecutivi ma esteso a tutti gli ambi. Complimenti a I legend e anche a lotto_Tom25 e a Palas.
Onorata con questo mio modesto argomento di aver destato l' attenzione di questi big dei listati.