Lotteria MillionDay

[i legend]

Ciao a tutti
Io non gioco , ma se posso essere utile (tempo permettendo ) a livello di script mi fa piacere esserci.
ciao a tutti e buon lavoro

 

[*blacklotto*]

Ciao,

avrei bisogno di un aiuto in fatto di listato, mi occorrerebbe capire il procedimento di questa ricerca :

vorrei sviluppare integralmente 10 numeri, ma nel resoconto non dovrò trovare cinquine con 5 numeri consecutivi, e nemmeno 4 numeri consecutivi. Ok per 2, per 3.
Questo mi servirà poi per cercare di modificare il procedimento per lasciare i consecutivi e inserire a parte, o insieme nello stesso listato altro gruppo numerico.

Ringrazio chi mi potrà accontentare, blacklotto

 

[*blacklotto*]

Ciao,

intanto che aspetto una possibile risposta inserisco un listato che ho modificato per Millionday.
Un listato di SALVO50 letto in altro discorso, spero non ci siano problemi se mi divertirò a modificare listati presi qua e la, e aggiungo, che se nelle modifiche da me fatte ci sono errori non esitate nel comunicarmelo.
Questo lo faccio per me, e per a chi potrebbe interessare, eventualmente, senza alcun problema, se necessario potrei aprire altro post dove inserirò, e chiunque lo voglia faccia la stessa cosa, solo listati che comportano modifiche dal gioco del lotto al Millionday.
Cioè, se non ricevo lamentela, proseguo, sennò provvederò immediatamente, dato che non vedo altro post con discorso al riguardo di questa lotteria.

 [SIZE=12px][COLOR=#000000]Scrivi Space(50) & "IL QUADRATO MIRABILE "
Scrivi Space(52) & "SCRIPT by SALVO50 modificato x Millionday "
Scrivi
Sub Main
Dim Clp,K,Caso,Casi,K1,sfile
Dim A(5),B(5),AB(5),Ambata(1)
Dim S1,S2,D1,D2,D3,D4,D5
Dim Posta(5)
Posta(1) = 1
sfile = GetDirectoryAppData & " ***************************"
Call ApriBaseDatiFT(sfile,5,";",55)
ini = 1
Fin = EstrazioniArchivioFT
For Es = ini To Fin
AvanzamentoElab ini,Fin,Es
Clp = 15
Caso = 0
'Le 5 estrazioni
A(1) = EstrattoFT((Es),1):If A(1) > 0 Then
A(2) = EstrattoFT((Es),2)
A(3) = EstrattoFT((Es),3)
A(4) = EstrattoFT((Es),4)
A(5) = EstrattoFT((Es),5)
B(1) = EstrattoFT((Es + 1),1):If B(1) > 0 Then
B(2) = EstrattoFT((Es + 1),2)
B(3) = EstrattoFT((Es + 1),3)
B(4) = EstrattoFT((Es + 1),4)
B(5) = EstrattoFT((Es + 1),5)
'Risultati centrali tra 2 estrazioni
AB(1) = Fuori90(55 +(B(1) - A(1)))
If AB(1) > 55 Then
AB(1) = AB(1) - 55
End If
AB(2) = Fuori90(55 +(B(2) - A(2)))
If AB(2) > 55 Then
AB(2) = AB(2) - 55
End If
AB(3) = Fuori90(55 +(B(3) - A(3)))
If AB(3) > 55 Then
AB(3) = AB(3) - 55
End If
AB(4) = Fuori90(55 +(B(4) - A(4)))
If AB(4) > 55 Then
AB(4) = AB(4) - 55
End If
AB(5) = Fuori90(55 +(B(5) - A(5)))
If AB(5) > 55 Then
AB(5) = AB(5) - 55
End If
'Le somme delle estrazioni
S1 = Fuori90(A(1) + A(2) + A(3) + A(4) + A(5))
If S1 > 55 Then
S1 = S1 - 55
End If
S2 = Fuori90(B(1) + B(2) + B(3) + B(4) + B(5))
If S2 > 55 Then
S2 = S2 - 55
End If
'La differenza delle somme
D1 = Fuori90(55 +(S2 - S1))
If D1 > 55 Then
D1 = D1 - 55
End If
D2 = Fuori90(55 +(D1 - S1))
If D2 > 55 Then
D2 = D2 - 55
End If
D3 = Fuori90(55 +(S2 - D1))
If D3 > 55 Then
D3 = D3 - 55
End If
D4 = Fuori90(55 +(D3 - D2))
If D4 > 55 Then
D4 = D4 - 55
End If
D5 = Fuori90(55 +(D4 - B(1)))
If D5 > 55 Then
D5 = D5 - 55
End If
Ambata(1) = Fuori90(D5 + D1)
If Ambata(1) > 55 Then
Ambata(1) = Ambata(1) - 55
End If
'Fine calcoli--------------------------------------------------
Caso = Caso + 1
Casi = Casi + 1
ColoreTesto 1
Scrivi String(89,"*") & " Casi Totali " & FormattaStringa(Casi,"0000")
ColoreTesto 2
Scrivi String(80,"*") & " Estrazione " &(Es) & " caso " & FormattaStringa(Caso,"0000")
ColoreTesto 0
Scrivi
Scrivi(" Estrazione n." & Format2(Es) & " del " & DataEstrazioneFT(Es)),1,0
Scrivi " " & StringaEstrattiFT(Es),1
Scrivi(" Estrazione n." & Format2(Es + 1) & " del " & DataEstrazioneFT(Es + 1)),1,0
Scrivi " " & StringaEstrattiFT(Es + 1),1
Scrivi
For K1 = 1 To 5
Scrivi Space(20) & Format2(A(K1)) & " " & Format2(AB(K1)) & " " & Format2(B(K1)),1
Next
ColoreTesto 2
Scrivi Space(22) & Format2(D2) & " " & Format2(D3),1
ColoreTesto 1
Scrivi Space(24) & Format2(D4) & Space(4) & Format2(B(1)),1
ColoreTesto 2
Scrivi Space(27) & Format2(Ambata(1)),1
ColoreTesto 1
Scrivi Space(24) & Format2(D5) & Space(4) & Format2(D1),1
ColoreTesto 0
ImpostaGiocataFT 1,Ambata,Posta,Clp,1
GiocaFT Es,1
End If
End If
Next
ScriviResocontoFT
End Sub[/COLOR][/SIZE]

ciao, blacklotto

 

[i legend]

Ciao black
se utilIzzi il fuorix ( numero,55) non devi fare altri calcoli.

ciao

 

[*blacklotto*]

Ciao,

non ho capito ! A cosa ti riferisci ?

... già che sei in zona, mi potresti aiutare nella mia richiesta ?

blacklotto

 

[i legend]

Mi riferivo allo script che hai postato.
ma forse non ho capito cosa volevi ottenere.
Ciao

 

[salvo50]

Ciao,

non ho capito ! A cosa ti riferisci ?

... già che sei in zona, mi potresti aiutare nella mia richiesta ?

blacklotto

Ciao Blacklotto

I Leggend vuole dire che per fare il fuori55 non c'è bisogno di fare quattro linee di programma, ne basta una

'Queste 4 righe le puoi eliminare

AB(1) = Fuori90(55 +(B(1) - A(1)))
If AB(1) > 55 Then
AB(1) = AB(1) - 55
End If

'e sostituirle con

AB(1) = FuoriX (55 + (B(1) - A(1)), 55)

'nota, il primo 55 lo metti solo se c'è la possibilità
'che il risultato possa essere negativo, altrimenti
'puoi non metterlo, esempio se faccio una addizione

AB(1) = FuoriX ( (B(1) + A(1)), 55)

 

[*blacklotto*]

Grazie ragazzi, gentilissimi

la mia richiesta rimane sempre di capire il procedimento che mi permette di lanciare uno script di 10 numeri che sviluppando le cinquine integrali possa scartare le cinquine e quaterne con numeri consecutivi.

grazie

 

[Mike58]

Ciao BlackLotto,uno script del genere porta a poco se entriamo nella sistemistica.
Sarebbe meglio farlo con l'apposito modulo dei sistemi condizionati.

Tuttavia ingegnandosi si può fare ma chiaro che la condizione è vincolata alla cinquina sviluppata ed allacciata alle condizioni if-then.
Se ti serve per imparare va bene, per successive modifiche devi ingegnarti.

Faccio un uscita fuori tema accontentandoti in questo ma poi sarebbe più opportuno riportare la discussione al tema delle statistiche MILLIONDAY e le richieste diverse in Thread appositi.

Ciao

Sub Main
   Dim Colonne
   Dim numeri(10)
   Dim classe
   Dim sColonna
   classe = 5
   For k = 1 To 10
      numeri(k) = k
   Next
   Colonne = SviluppoIntegrale(numeri,classe)
   For k = 1 To UBound(Colonne)
      sColonna = ""
      For j = 1 To classe
         '......... Calcolo if then consecutivi ..................
         If Differenza(Colonne(k,1),Colonne(k,2)) = 1 Then c1 = 1
         If Differenza(Colonne(k,2),Colonne(k,3)) = 1 Then c2 = 1
         If Differenza(Colonne(k,3),Colonne(k,4)) = 1 Then c3 = 1
         If Differenza(Colonne(k,4),Colonne(k,5)) = 1 Then c4 = 1
         '---------------------------------------------------------
         If Differenza(Colonne(k,1),Colonne(k,2)) > 1 Then c1 = 0
         If Differenza(Colonne(k,2),Colonne(k,3)) > 1 Then c2 = 0
         If Differenza(Colonne(k,3),Colonne(k,4)) > 1 Then c3 = 0
         If Differenza(Colonne(k,4),Colonne(k,5)) > 1 Then c4 = 0
         '---------------------------------------------------------
         cons = c1 + c2 + c3 + c4
         sColonna = sColonna & Format2(Colonne(k,j)) & " "
      Next
      If cons = < 2 Then ' da variare per impostare consecutivi
         kk = kk + 1
         Call Scrivi(sColonna & vbTab & " Consecutivi = " & cons & vbTab & kk)
      End If
   Next
End Sub

 

[i legend]

Ciao Mike vedo che anche anche tu hai accontentato BlackLotto
Visto che l ho fatto , posto anche il mio che è un po diverso
salvo errori sempre possibili

Option Explicit
'Prova script per Eliminare formazioni consecutive dopo sviluppo integrale
' verificare se lo script fa quanto richiesto
' richiesta  BlackLotto
'la mia richiesta rimane sempre di capire il procedimento che mi permette di lanciare uno script di 10 numeri che sviluppando le cinquine integrali possa scartare le cinquine e quaterne con numeri consecutivi.
'grazie
' script di esempio non statistico o previsionistico
Sub Main
   Dim i,m,ColT,id,s,aCol(4),Ck,j,bRet
   Dim Classe:Classe = GetClasse
   Dim sFiltro,sForm
   Dim Fil:Fil = Filtra(sFiltro,sForm)
   If Fil + 1 > Classe - 1 Then
      Scrivi "Il Filtro non puo essere maggiore dellaClasse"
      Exit Sub
   End If
   ReDim aNum(10) ' non aumentare il numero si potrebbe esaurire la memoria o causare la chiusura del programma
   For i = 1 To UBound(aNum)
      aNum(i) = i
   Next
   ColT = InitSviluppoIntegrale(aNum,Classe)
   aCol(3) = RGB(243,242,255)
   Call SetColorSezione(aCol(3))
   Scrivi "  Classe di sviluppo:   " & Classe,1
   Scrivi "  Formazioni escluse:   " & sForm,1
   Scrivi "  Numeri: " & UBound(aNum) & "   " & "Colonneintegrali=  " & ColT,1
   Scrivi
   Scrivi "  ",,0
   Scrivi FormatSpace("ID",6,1) & " ",1,0,RGB(210,210,210),,3
   Scrivi FormatSpace("  Formazione",(Classe*2 + Classe)) & "   ",1,,RGB(210,210,210),,3
   Do While GetCombSviluppo(aNum)
      s = "":bRet = True
      For i = 1 To Classe - 1
         If Abs(aNum(i) - aNum(i + 1)) = 1 Then m = 1:Else m = 0
         s = s & m
      Next
      For j = 1 To Len(s)
         If Mid(s,j,Int(Fil + 1)) = sFiltro Then bRet = False
      Next
      If bRet Then
         Ck = Ck + 1
         aCol(1) = RGB(82,144,233)
         aCol(2) = RGB(243,248,254)
         aCol(4) = RGB(55,55,55)
      Else
         aCol(1) = RGB(224,76,86)
         aCol(2) = RGB(254,235,240)
         aCol(4) = RGB(180,180,200)
      End If
      id = id + 1
      Scrivi "  ",,0,aCol(3)
      Scrivi FormatSpace(id,6,1) & "   ",1,0,aCol(1),aCol(2)
      Scrivi "  " & FormatSpace(StringaNumeri(aNum,,True),11) & "  ",1,,vbWhite,aCol(4),3
      Call AvanzamentoElab(1,ColT,id)
      If ScriptInterrotto Then Exit Do
   Loop
   Scrivi
   EndColorSezione
   Scrivi "Colonne Valide:   " & Ck
End Sub
Function Filtra(sFiltro,sForm)
   Dim av:av = Array("Ambi Consecutivi","Terni Consecutivi","Quartine Consecutive","Cinquine Consecutive")
   Dim aFiltro:aFiltro = Array("1","11","111","1111")
   Filtra = ScegliOpzioneMenu(av,0,"Escludi formazioni")
   sFiltro = aFiltro(Filtra)
   sForm = av(Filtra)
End Function
Function GetClasse
   Dim aV:aV = Array("Ambo","Terno","Quaterna","Cinquina","Sestina","Settina")
   GetClasse = ScegliOpzioneMenu(aV,0,"Seleziona Classe") + 2
End Function

 

[Mike58]

Ottimo iLegend, gran bel lavoro sia in termini di approccio al progetto e costrutto script.
Bravo davvero.

 

[i legend]

Grazie mike

 

[*blacklotto*]

Grazie per i listati inseriti, molto gentili.

buon proseguimento, blacklotto

 

[i legend]

Grazie per i listati inseriti, molto gentili.

buon proseguimento, blacklotto

Ciao blacklotto ,non c'è di che.
se vuoi chiarimenti chiedi pure.
per aiuti script ,come suggerito da Mike , conviene aprire dei post appositi , così quello che si scrive potrebbe essere utile a più utenti e non si va fuori Topic.
ciao

pensavo che anche altri avrebbero postato algoritmi alternativi.

 

[salvo50]

pensavo che anche altri avrebbero postato algoritmi alternativi.

Ciao a Tutti

Se ti riferisci all'ultima richiesta di Blacklotto, anch'io avevo fatto il mio scriptino, però non l'ho postato perchè aspetto che Blacklotto apra un altro 3D, come si è scritto più volte non è regolare mischiare le richieste di aiuto con il vero scopo che Mike ha aperto questo 3D.

 

[lotto_tom75]

Ciao Mike vedo che anche anche tu hai accontentato BlackLotto
Visto che l ho fatto , posto anche il mio che è un po diverso
salvo errori sempre possibili

Option Explicit
'Prova script per Eliminare formazioni consecutive dopo sviluppo integrale
' verificare se lo script fa quanto richiesto
' richiesta BlackLotto
'la mia richiesta rimane sempre di capire il procedimento che mi permette di lanciare uno script di 10 numeri che sviluppando le cinquine integrali possa scartare le cinquine e quaterne con numeri consecutivi.
'grazie
' script di esempio non statistico o previsionistico
Sub Main
Dim i,m,ColT,id,s,aCol(4),Ck,j,bRet
Dim Classe:Classe = GetClasse
Dim sFiltro,sForm
Dim Fil:Fil = Filtra(sFiltro,sForm)
If Fil + 1 > Classe - 1 Then
Scrivi "Il Filtro non puo essere maggiore dellaClasse"
Exit Sub
End If
ReDim aNum(10) ' non aumentare il numero si potrebbe esaurire la memoria o causare la chiusura del programma
For i = 1 To UBound(aNum)
aNum(i) = i
Next
ColT = InitSviluppoIntegrale(aNum,Classe)
aCol(3) = RGB(243,242,255)
Call SetColorSezione(aCol(3))
Scrivi " Classe di sviluppo: " & Classe,1
Scrivi " Formazioni escluse: " & sForm,1
Scrivi " Numeri: " & UBound(aNum) & " " & "Colonneintegrali= " & ColT,1
Scrivi
Scrivi " ",,0
Scrivi FormatSpace("ID",6,1) & " ",1,0,RGB(210,210,210),,3
Scrivi FormatSpace(" Formazione",(Classe*2 + Classe)) & " ",1,,RGB(210,210,210),,3
Do While GetCombSviluppo(aNum)
s = "":bRet = True
For i = 1 To Classe - 1
If Abs(aNum(i) - aNum(i + 1)) = 1 Then m = 1:Else m = 0
s = s & m
Next
For j = 1 To Len(s)
If Mid(s,j,Int(Fil + 1)) = sFiltro Then bRet = False
Next
If bRet Then
Ck = Ck + 1
aCol(1) = RGB(82,144,233)
aCol(2) = RGB(243,248,254)
aCol(4) = RGB(55,55,55)
Else
aCol(1) = RGB(224,76,86)
aCol(2) = RGB(254,235,240)
aCol(4) = RGB(180,180,200)
End If
id = id + 1
Scrivi " ",,0,aCol(3)
Scrivi FormatSpace(id,6,1) & " ",1,0,aCol(1),aCol(2)
Scrivi " " & FormatSpace(StringaNumeri(aNum,,True),11) & " ",1,,vbWhite,aCol(4),3
Call AvanzamentoElab(1,ColT,id)
If ScriptInterrotto Then Exit Do
Loop
Scrivi
EndColorSezione
Scrivi "Colonne Valide: " & Ck
End Sub
Function Filtra(sFiltro,sForm)
Dim av:av = Array("Ambi Consecutivi","Terni Consecutivi","Quartine Consecutive","Cinquine Consecutive")
Dim aFiltro:aFiltro = Array("1","11","111","1111")
Filtra = ScegliOpzioneMenu(av,0,"Escludi formazioni")
sFiltro = aFiltro(Filtra)
sForm = av(Filtra)
End Function
Function GetClasse
Dim aV:aV = Array("Ambo","Terno","Quaterna","Cinquina","Sestina","Settina")
GetClasse = ScegliOpzioneMenu(aV,0,"Seleziona Classe") + 2
End Function

Ciao i legend! Stra complimenti per questo tuo nuovo gioiellino!!! Davvero una chicca! Se fosse possibile poi estrapolare e visualizzare in output solo le formazioni "filtrate" sarebbe la ciliegina sulla torta! Spettacolare davvero! Grazie miticooo

PS: Ho provato anche ad implementarlo per le mie necessità elaborazionali con questo codice:

Dim quantitanumeriscelti

ReDim aNum(0)
quantitanumeriscelti = ScegliNumeri(aNum)

Ma purtroppo non mi considera il gruppo immesso da tabella se non per il solo numero dei suoi elementi e non capisco proprio dove si possa ottimizzare per far si che lo script elabori correttamente qualsiasi tipo di gruppo numerico desiderato immesso appunto da tabella colorata. TNX! Per adesso se immetto 30 numeri o 45 numeri "casuali" ecc... mi elabora sempre (fregandosene dei numeri immessi) da 1 a 30 o 1 a 45... nel secondo caso

 

[i legend]

Ciao a tutti
ciao tom piacere rileggerti.
ciao magia
lo script che ho postato è al solo scopo didattico.
ossia blacklotto ha fatto una richiesta e dato che vuole imparare mi sembrava utile mostrargli una delle possibili soluzioni.
ma questo espediente non velocizza anzi perché filtra dopo lo sviluppo integrale. Utilizzare il modulo dei sistemi come suggerito da Mike è la soluzione migliore .
chi modifica lo script lo fa assumendosi tutti i rischi che potrebbe comportare. (Perdita dati o di altro tipo)
ho espressamente specificato di non aumentare il numero degli elementi di anum (10)
magia ovviamente questo non è rivolto a te ,
ma sapete quante settine si sviluppano con 45 o piu numeri?il tempo e la potenza di calcolo che comporta per un PC datato ?

ribadisco il concetto. Lo script è al solo scopo didattico.

 

[i legend]

Ciao i legend! Stra complimenti per questo tuo nuovo gioiellino!!! Davvero una chicca! Se fosse possibile poi estrapolare e visualizzare in output solo le formazioni "filtrate" sarebbe la ciliegina sulla torta! Spettacolare davvero! Grazie miticooo

PS: Ho provato anche ad implementarlo per le mie necessità elaborazionali con questo codice:

Dim quantitanumeriscelti

ReDim aNum(0)
quantitanumeriscelti = ScegliNumeri(aNum)

Ma purtroppo non mi considera il gruppo immesso da tabella se non per il solo numero dei suoi elementi e non capisco proprio dove si possa ottimizzare per far si che lo script elabori correttamente qualsiasi tipo di gruppo numerico desiderato immesso appunto da tabella colorata. TNX! Per adesso se immetto 30 numeri o 45 numeri "casuali" ecc... mi elabora sempre (fregandosene dei numeri immessi) da 1 a 30 o 1 a 45... nel secondo caso

Ciao tom dato che hai provato ad intervenire sul codice hai letto che scrivo espressamente di non aumentare i numeri .

se hai già lanciato lo script con quella quantità numerica, molto probabilmente hai un PC molto potente . Ma noi dobbiamo pensare anche a chi utilizza pc datati.
per questo motivo non intendo modificare lo script.
fatti sentire più spesso
ciao

non so quante righe di scrittura in output gestisce spaziometria, bisogna tener conto anche di questo fattore.

 

[lotto_tom75]

Buonasera,
Per lotto_tom75 , in attesa che intervenga i legend ,
Provi a sostuire le seguenti linee del listato originale .

'ReDim aNum(10) ' non aumentare il numero si potrebbe esaurire la memoria o causare la chiusura del programma
'For i = 1 To UBound(aNum)
' aNum(i) = i
'Next
ReDim anum(00)
Call ScegliNumeri(anum)
ColT = InitSviluppoIntegrale(anum,Classe)
aCol(3) = RGB(243,242,255)
Call SetColorSezione(aCol(3))
Scrivi " Numeri scelti: " & StringaNumeri(anum,,True),1
Scrivi " Classe di sviluppo: " & Classe,1
Scrivi " Formazioni escluse: " & sForm,1
Scrivi " Numeri: " & UBound(anum) & " " & "Colonneintegrali= " & ColT,1

Controllare Sempre .
Salvo Errori ed Omisis .

Funziona perfettamente magia con qualsiasi gruppo desiderato! Grazie ps: Non riesco ancora a mostrare in output solo le colonne "filtrate" ma pazienza

 

[lotto_tom75]

Ciao tom dato che hai provato ad intervenire sul codice hai letto che scrivo espressamente di non aumentare i numeri .

se hai già lanciato lo script con quella quantità numerica, molto probabilmente hai un PC molto potente . Ma noi dobbiamo pensare anche a chi utilizza pc datati.
per questo motivo non intendo modificare lo script.
fatti sentire più spesso
ciao

non so quante righe di scrittura in output gestisce spaziometria, bisogna tener conto anche di questo fattore.

Ok Ancora complimenti comunque grande ilegend!