Novità

quesito sistemistico come gioco cerebrale rompicapo...

lotto_tom75

Advanced Premium Member
Tom per favore prova a verificare che lo script che hai postato funzi.
Credo manchino righe di codice.
Manca la sub main l End sub la dichiarazione di aNum
Almeno credo.
Grazie 😉👍

Quello non è infatti uno script "funzionante" è solo... il codice del "motore" x lo sviluppo integrale senza limite di classe che puoi implementare dove vuoi al posto della classica funzione di sviluppo integrale con il limite a 20 elementi ;)
 

lotto_tom75

Advanced Premium Member
Se volessi sviluppare la lunghetta di 36 elementi in classe 35 come devo fare?

Una domanda di questo tipo da te legend non me la sarei mai aspettata :eek:😃

Basta che sostituisci la funzione di sviluppo integrale

Codice:
 ColTot = InitSviluppoIntegrale(aNum,Classe)

e

Codice:
 Do While GetCombSviluppo(aCol) = True

con quella del nuovo motore di Edoardo.

Ovviamente prima devi aggiungere il codice della classe necessaria che ti ho sopra riportato.


Prova...

Ad ogni modo se vuoi uno script già da me modificato che analizzi integralmente le formazioni senza limite di classe te lo ricerco e ti condivido anche quello. Fammi sapere. 👋🙂
 

lotto_tom75

Advanced Premium Member
Non ho mai fatto mistero che mi sto rinco 🤣🤣🤣🤣🤣👍
Provo a utilizzare spaziolight 😉
Magari è anche più veloce

Ok prova pure a velocizzarlo con spazio light ma il motore without class limit :) è nato inizialmente per gli script di spaziometria. Non so se funzia anche nell'altro ambiente. 👋🙂
 

lotto_tom75

Advanced Premium Member
Tom se puoi potresti postare lo script funzionante? Grazie:)
Se non puoi va bene uguale.
Mi faccio il ciclo for

Cose incredibili succedono a questo mondo... :eek:
Tipo... che un mostro sacro di scripter s'impantani... per una semplice implementazione di code e chieda aiuto per questo a un incasinatissimo e vulcaniano... :alien:🌋 pasticcere... 🧑‍🍳😛 suo discepolo... 🙃

Codice:
Option Explicit

'implementazione, del motore di sviluppo integrale senza limite di classe di Edo78 (Edoardo), nello script 'di sviluppo integrale con limite di classe 20 e con possibilità di ordinamento + alcuni filtri doc by 'lotto_tom75 con aggiunta opzione voce x i casi 'rispettanti il filtro impostato eventualmente trovati :)

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 
            ' 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)
   Dim rsmindiriferimento
   rsmindiriferimento = EstrazioneFin
   QNS = ScegliNumeri(aNum)
   nClasse = CInt(InputBox("classe ",,UBound(aNum) - 2)) ' UBound(aNum) - 1)) 'ScegliEsito(7,1,90)
   Dim fqmaxrilevata
   fqmaxrilevata = 0
   Dim fqminrilevata
   fqminrilevata = EstrazioneFin
   Dim rsminrilevato
   rsminrilevato = EstrazioneFin
   Dim Stringaformazioneconfqmaxrilevataersminrilevato
   Dim Stringaformazioneconfqminrilevataersminrilevato
   ReDim aRuote(1)
   '   aRuote(1) = BA_
   '   aRuote(2) = CA_
   '   aRuote(3) = FI_
   '   aRuote(4) = GE_
   '   aRuote(5) = MI_
   '   aRuote(6) = NA_
   '   aRuote(7) = PA_
   '   aRuote(8) = RO_
   '   aRuote(9) = TO_
   '   aRuote(10) = VE_
   aRuote(1) = 9 'ScegliRuota
   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("")
      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
      '    Call InitTabella(aTitoli)
      For k = 1 To UBound(aCombMigliori)
         ReDim ADati(6)
         ADati(1) = aCombMigliori(k,4)
         ADati(2) = aCombMigliori(k,1)
         ADati(3) = aCombMigliori(k,2)
         ADati(4) = aCombMigliori(k,3)
         ADati(5) = aCombMigliori(k,5)
         ADati(6) = aCombMigliori(k,6)
         Dim ccolonna
         Dim contatore
         contatore = contatore + 1
         'Call StatisticaFormazioneTurbo(cColonna.aNum,aRuote,nSorte,RetRit,RetRitMax,RetIncrRitMax,RetFrq,EstrazioneIni,EstrazioneFin)
         Dim diff
         If ADati(4) < rsmindiriferimento Then
            rsmindiriferimento = ADati(4)
         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
         If ADati(2) >= fqmaxrilevata And ADati(4) <= rsminrilevato Then
            fqmaxrilevata = ADati(2)
            rsminrilevato = ADati(4)
            Stringaformazioneconfqmaxrilevataersminrilevato = "formazione: " & ADati(1) & " -" & " FQ " & ADati(2) & " -" & " RA " & ADati(3) & " -" & " RS " & ADati(4) & " - DIFF " & ADati(5) & " -" & " INCMAX " & ADati(6) & " -" & " contatore " & contatore & " classe " & nClasse
         End If
         If ADati(2) < fqminrilevata Then 'And ADati(4) <= rsminrilevato Then
            fqminrilevata = ADati(2)
            rsminrilevato = ADati(4)
            Stringaformazioneconfqminrilevataersminrilevato = "formazione: " & ADati(1) & " -" & " FQ " & ADati(2) & " -" & " RA " & ADati(3) & " -" & " RS " & ADati(4) & " - DIFF " & ADati(5) & " -" & " INCMAX " & ADati(6) & " -" & " contatore " & contatore & " classe " & nClasse
            Scrivi
            Call Scrivi("<font color=red>formazione: " & ADati(1) & " -" & " FQ " & ADati(2) & " -" & " RA " & ADati(3) & " -" & " RS " & ADati(4) & " - DIFF " & ADati(5) & " -" & " INCMAX " & ADati(6) & " -" & " contatore " & contatore & " classe " & nClasse)
            Scrivi
         End If
         '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
   Scrivi
   Scrivi "<font color=red>Formazione con fq min e rs min " & Stringaformazioneconfqminrilevataersminrilevato
   Scrivi
   Scrivi
   Scrivi "<font color=green>Formazione con fq max e rs min " & Stringaformazioneconfqmaxrilevataersminrilevato
   Scrivi
   Scrivi "Tt " & TempoTrascorso
   Scrivi
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,2,"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
Sub PlayWav(sFile,nRepeat,sTesto)
   Dim oVoice,oSpFileStream
   Dim k
   Set oVoice = CreateObject("SAPI.SpVoice")
   Set oSpFileStream = CreateObject("SAPI.SpFileStream")
   For k = 1 To nRepeat
      oSpFileStream.Open sFile
      oVoice.SpeakStream oSpFileStream
      oSpFileStream.Close
   Next
   oVoice.Speak sTesto
   'Next
End Sub
'Call PlayWav("C:\silenzio.wav",1,"Lunghette potenziali per ambo su ruota unica trovate e di classe " & i2)

Good headache... 😄

👋😉
 

i legend

Premium Member
Tom scusa se non riesco a copiare subito il listato . Ho il PC che mi è sndato in ripristino. L ho acceso e si è spento. Spero di non aver perso nulla . Tutti gli script :(
 

i legend

Premium Member
Tom Ho copiato lo script .
Ora provo capire come funzia :) se riesco.
Domanda . Teniamo buoni i numeri dell altra volta o studiamo qualcosa di nuovo sempre su Torino,?
In teoria avendo dato il terno non saprei.
 

lotto_tom75

Advanced Premium Member
Tom Ho copiato lo script .
Ora provo capire come funzia :) se riesco.
Domanda . Teniamo buoni i numeri dell altra volta o studiamo qualcosa di nuovo sempre su Torino,?
In teoria avendo dato il terno non saprei.

Io li rigioco solo per questa volta e se la lotto:poop: ci legge... e non li rifa uscire pazienza... :LOL:


👋🙂
 

i legend

Premium Member
Oggi non ho studiato nulla.e non ho giocato nulla. Sono rimasto a casa a spiegare a mio fratello come si fa il pane 🤣🤣🤣 videolezioni lui impastava e io dicevo come fare .poi , ho pensato un piccolo script ,una richiesta in area download, che ho passato a mio fratello xhe ho il pc che non funzia :(
Il tutto accompagnato da dolori che nonostante le medicine quelle " buone" mi hanno fatto vedere le stelle.
La cura migliore è la famiglia, sarà banale ,ma ti distrae e ti tiene su nei momenti di sconforto.
In bocca al lupo per stasera tom. Se domani sto meglio porto il PC ad aggiustare credo che sia roba da poco.
Un problema di ripristino .
Cmq se domani ho il PC ho intenzione di filtrare i dati con 2 nuovi studi.
 

i legend

Premium Member
Sub PlayWav(sFile,nRepeat,sTesto) Dim oVoice,oSpFileStream Dim k Set oVoice = CreateObject("SAPI.SpVoice") Set oSpFileStream = CreateObject("SAPI.SpFileStream") For k = 1 To nRepeat oSpFileStream.Open sFile oVoice.SpeakStream oSpFileStream oSpFileStream.Close Next oVoice.Speak sTesto 'Next End Sub 'Call PlayWav("C:\silenzio.wav",1,"Lunghette
Tom cosa è questa funzione?
Quella che legge le stringhe che vengono fuori?
 

i legend

Premium Member
Purtroppo a me non funzia , ma è una cosa pazzesca, me la voglio studiare.
Miei complimenti:) qua ora mi domando chi è l allievo ? Sicuro che sei te?
 

lotto_tom75

Advanced Premium Member
Oggi non ho studiato nulla.e non ho giocato nulla. Sono rimasto a casa a spiegare a mio fratello come si fa il pane 🤣🤣🤣 videolezioni lui impastava e io dicevo come fare .poi , ho pensato un piccolo script ,una richiesta in area download, che ho passato a mio fratello xhe ho il pc che non funzia :(
Il tutto accompagnato da dolori che nonostante le medicine quelle " buone" mi hanno fatto vedere le stelle.
La cura migliore è la famiglia, sarà banale ,ma ti distrae e ti tiene su nei momenti di sconforto.
In bocca al lupo per stasera tom. Se domani sto meglio porto il PC ad aggiustare credo che sia roba da poco.
Un problema di ripristino .
Cmq se domani ho il PC ho intenzione di filtrare i dati con 2 nuovi studi.

E hai fatto bene (y). Uscito solo il 31 🙃

Auguri di pronta guarigione tua e del tuo pc 😜e concordo con te sul potere anche terapeutico della family 😉
 

lotto_tom75

Advanced Premium Member
Tom cosa è questa funzione?
Quella che legge le stringhe che vengono fuori?

Esattamente 🙂 è il code che legge e riporta a voce il testo che uno desidera (ad esempio appunto l'output delle varie elaborazioni). L'unica cosa che devi fare per poterlo utilizzare oltre a mettere la riga di esempio decommentata dove preferisci... è che devi mettere al posto di silenzio.wav un file muto o con un audio .wav cortissimo prima del testo che vuoi riprodurre a voce.


'Call PlayWav("C:\silenzio.wav",1,"Lunghette potenziali per ambo su ruota unica trovate e di classe " & i2)

Purtroppo a me non funzia , ma è una cosa pazzesca, me la voglio studiare.
Miei complimenti:) qua ora mi domando chi è l allievo ? Sicuro che sei te?

Se non ti funzia la voce ok mancava quell'appunto x il corretto utilizzo che ti ho postato appena sopra. Se ti riferisci invece allo script non ho idea sul perchè a te non funzioni... 🤔 Che versione di spaziomertria stai utilizzando? Io la 1.6.34.

Grazie per il complimento, + grande per me non me lo potevi fare 🤗, ma ci corre un visibilio tra la tua attenzione, ingegno e abilità nel crearli e la mia improvvisazione e assemblamento "barocco" alla McGiver anche se a me, in effetti, come ho ribadito più volte, basta che la creaturina che assemblo funzioni... Non m'importa del fatto che sia troppo elegante e snella a livello di codice anche se ammiro coloro, a cominciare da te, che riescono a farlo 😉

👋🙂
 

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

Ultimi Messaggi

Alto