Scriptologia utile e divertente...

[lotto_tom75]

Qui proverò ad elencare talvolta alcuni scriptini utili per fare qualche cosa e non solo per elaborare riduzioni o fare statistica ma anche che so... per individuare i colori per la scrittura in output ad esempio... come questo sottostante... ??✍

Sub Main

For pcolor=0 To 15

Scrivi "Test x Individuare Numero Colore " & "pcolor=" & pcolor,True,,- 1,pcolor,3,"verdana"

Next

End Sub

Ben vengano altri eventuali scriptini da parte vostra che possano velocizzare la risoluzione di taluni problemi statistico riduzionali e/o elaborazionali o di strutturazione per script + complessi o semplicemente di abbellimento e potenziamento di script pre esistenti...

 

[lotto_tom75]

Verificatore Universale Per Eventuali Funzioni Aggiuntive In Cascata offerto dalla Script Pasticceria di Lotto_tom75 ?‍???? come scrive spesso l'amico claudio8 che saluto ? sicuramente migliorabile e ottimizzabile in ogni sua parte. Controllare sempre per eventuali errori e/o dimenticanze. In questa versione base si limita a verificare il contenuto di un file txt qualsiasi. Nell'esempio file77.txt ovviamente modificabile con qualsivoglia proprio file txt. I numeri al suo interno dovranno essere distanziati l'uno dall'altro dal carattere punto a meno di non cambiare la relativa riga di codice che li interpreta. Dato che è frutto di continui aggiustamenti, cancellazioni e rimodellazioni è molto probabile che vi siano anche molti refusi ovvero righe di codice non necessario alla sua attivazione e al suo utilizzo. Rispetto ad un qualsiasi altro tipo di script verificatore standard questo permette la potenziale aggiunta in cascata di qualsiasi altra funzione statistico riduzionale e la verifica della formazione finale elaborata dopo tutti gli eventuali precedenti passaggi di sviluppo.

Option Explicit

'MODULO e STRUTTURA VERIFICATORE per analisi di qualsiasi tipo custom by lotto_tom75
'lo script in oggetto non ha funzione predittiva ma solo di verifica per qualsiasi eventuale
'funzione statistico-riduzionale si decida eventualmente di implementarvi in cascata...

Sub Main

Dim filetxtscelto
Dim contaesitipos 'contatore contenente il numero degli esiti positivi
Dim contaesitineg 'contatore contenente il numero degli esiti negativi
Dim contacasinongiocabili 'contatore contenente il numero dei casi non giocabili
Dim sDir,Inizio,Fine,sFile,sFileCompleto,aRuote,Sorte
Dim numerominimoincrementiattsto
Dim valoreincmaxmassimo
Dim nqincr
Dim ntotlunghetteok
Dim bOk,idFiltro,qIncr
Dim bPrimaEstrFissa,nDistanza

sDir = GetDirectoryAppData & "ArchiviVirtuali\"
sFile = ScegliFileArchivioVirt(sDir)
bPrimaEstrFissa = False

If sFile <> "" Then

sFileCompleto = sDir & sFile & ".dat"
bOk = ApriFileBaseDati(sFileCompleto)
bPrimaEstrFissa = True
nDistanza = GetValoreFraSeparatori(sFile,"(",")")

Else

bOk = True

nDistanza = 0

End If

If bOk Then

Dim counterrange
Dim Inizio1,Fine1
Dim quanteestrazioniverificare
Dim nclasse
Dim Valorefinalediclassedestroyer,Valoreinizialediclassedestroyer
Dim fin
fin = EstrazioneFin

Call Scrivi
Call Scrivi("<font size=3>Data elaborazione: " & giorno(fin) & "-" & Mese(fin) & "-" & Anno(fin) & "</font>")
Call Scrivi

Call Messaggio("Scegli quante estrazioni vuoi verificare...")

quanteestrazioniverificare = CInt(InputBox("Quante estrazioni vuoi verificare nel passato? ",,60))

Dim numerocasi

Call Messaggio("Quanti CASI vuoi verificare prima che la ricerca si blocchi autonomamente? ")

numerocasi = CInt(InputBox("Quanti CASI vuoi verificare prima che la ricerca si blocchi autonomamente? ",,1))

Dim EstrazioneFinalevirtuale,EstrazioneFinalevirtualedidefault

EstrazioneFinalevirtualedidefault = EstrazioneFin '- quanteestrazioniverificare ' di default visto i numerosi esiti positivi sui 60 colpi è di 55 estrazioni

EstrazioneFinalevirtuale = CInt(InputBox("Quale estrazione finale virtuale vuoi impostare? ",,EstrazioneFinalevirtualedidefault))

Fine = EstrazioneFin

Inizio1 = EstrazioneFinalevirtuale - quanteestrazioniverificare ' qui si sceglie il numero di estrazioni da verificare a partire dall'ultima in archivio.

Sorte = ScegliEsito(2) '<- QUI SI SCEGLIE LA SORTE DA ANALIZZARE (da 1 a 5)

Dim RuoteSelezionate

Dim Modalitaanalisiruote,S,N
Dim RuoteSelezionatexlaverifica
ReDim aRuoteSelxverifica(12)

ReDim aRuotetmp(1)

Dim k

ReDim aRuoteSelxverifica(12)

Call Messaggio("Scegli ruota di verifica...")

RuoteSelezionate = ScegliRuote(aRuoteSelxverifica)

For k = 1 To RuoteSelezionate

ReDim aRuotetmpxverifica(1)

aRuotetmpxverifica(1) = aRuoteSelxverifica(k)

Next

Dim po(2),co
Dim Sortediverifica
Dim Valorediconfrontotemporale

Call Messaggio("Scegli colpi di verifica...")

co = CInt(InputBox("Quanti colpi verificare? ",,1))

Call Messaggio("Scegli sorte di verifica...")

Sortediverifica = ScegliEsito(2)

Dim ramindes

ramindes = CInt(InputBox("Ritardo minimo desiderato? ",,0))

ReDim aRuoteSel(1)

For counterrange = Inizio1 To EstrazioneFinalevirtualedidefault

For k = 1 To RuoteSelezionate

ReDim aRuotetmp(1)

aRuotetmp(1) = aRuoteSel(k)

If(counterrange > Inizio) Then

Inizio = EstrazioneIni

Call Scrivi
Call Scrivi("<font size=3>Data elaborazione: " & giorno(counterrange) & "-" & Mese(counterrange) & "-" & Anno(counterrange) & "</font>" & " N. Estrazione " & counterrange)
Call Scrivi

Call AnalisiLunghetteFromTXTOriginateDaQualsiasiTipoSviluppo(Inizio,EstrazioneFinalevirtuale,aRuotetmp,Sorte,idFiltro,qIncr,counterrange,nDistanza,po,co,Sortediverifica,nclasse,numerominimoincrementiattsto,nqincr,valoreincmaxmassimo,ntotlunghetteok,contaesitipos,contaesitineg,contacasinongiocabili,aRuotetmpxverifica,ramindes,quanteestrazioniverificare,numerocasi,Inizio1,Valorefinalediclassedestroyer,Valoreinizialediclassedestroyer)

End If

If ScriptInterrotto Then Exit For

Next

Next ' counterrange

Dim reportlunghettadocb,reportlunghettadocc,reportlunghettadocd,reportlunghettadoce,reportlunghettadoccc,reportlunghettadocccc

Dim percentualecasinongiocabili,percentualecasipositivi,percentualecasinegativi
percentualecasinongiocabili =(quanteestrazioniverificare *(contacasinongiocabili))/100
percentualecasipositivi =(quanteestrazioniverificare * contaesitipos)/100
percentualecasinegativi =(quanteestrazioniverificare * contaesitineg)/100

Call Scrivi("CASI POSITIVI: " & contaesitipos) '& " % " & percentualecasipositivi)
Call Scrivi("CASI NEGATIVI: " & contaesitineg) '& " % " & percentualecasinegativi)
Call Scrivi("CASI NON ESAMINATI: " & contacasinongiocabili - 1) '& " % " & percentualecasinongiocabili)
Call Scrivi("CASI TOTALI: " & quanteestrazioniverificare)
Call Scrivi("Tempo trascorso: " & TempoTrascorso)

End If

End Sub

Function ScegliFileArchivioVirt(sDir)
Dim i
ReDim aFile(0)
Call ElencoFileInDirectory(sDir,aFile,".dat")
aFile(0) = "Archivio reale"
i = ScegliOpzioneMenu(aFile,0,"Scegli archivio virtuale")
If i > 0 Then
ScegliFileArchivioVirt = aFile(i)
Else
ScegliFileArchivioVirt = ""
End If
End Function

Function ScegliFiletxt(sDir)

sDir = "./" '<--- SI PUO' QUESTO PERCORSO DI DEFAULT con quello che si preferisce.
' lo script leggerà... i file txt disponibili dando la possibilità all'utente di sceglierli per analizzare quello che vuole

Dim i

ReDim aV(0)
Call ElencoFileInDirectory(sDir,aV,".txt")

Call Messaggio("Scegli il file txt da elaborare")

i = ScegliOpzioneMenu(aV,,"Scegli il file txt desiderato")

'For i = 1 To UBound (aV)
ScegliFiletxt = sDir & aV(i) & ".txt"
'Call Scrivi("file" & i)

Dim filetxtscelto

filetxtscelto = aV(i) & ".txt"

'Next

End Function

Dim sFiles
Dim aLunghette
Dim sFiletxt
Dim contatore

Dim i
                                                                                                                  
Dim c

sFiletxt = ScegliFiletxt(sFiles)

LeggiRigheFileDiTesto sFiletxt,aLunghette

Sub AnalisiLunghetteFromTXTOriginateDaQualsiasiTipoSviluppo(inizio,EstrazioneFinalevirtuale,aRuotetmp,Sorte,idFiltro,qIncr,counterrange,nDistanza,po,co,Sortediverifica,nclasse,numerominimoincrementiattsto,nqincr,valoreincmaxmassimo,ntotlunghetteok,contaesitipos,contaesitineg,contacasinongiocabili,aRuotetmpxverifica,ramindes,quanteestrazioniverificare,numerocasi,Inizio1,Valorefinalediclassedestroyer,Valoreinizialediclassedestroyer)

Dim sFile,aLunghette',ntotlunghette',nclasse
Dim ntotlunghette
Dim nTrov,nProdotte,sNumReal
Dim clsL,collLunghette,uLunghette
ReDim aSelNum(0)
Set collLunghette = GetNewCollection
Dim k

Call Messaggio("Lettura file di testo")
ReDim aRighe(0)

LeggiRigheFileDiTesto sFiletxt,aRighe

For k = 0 To UBound(aRighe)
If aRighe(k) <> "" Then
ReDim aSelNum(0)
'Call SplitByChar("," & aRighe(k),",",aSelNum)
Call SplitByChar("." & aRighe(k),".",aSelNum)

End If
Next

ntotlunghette = 1 ' ntotlunghetteok  ' metterlo uguale a 1 ovvero > 0 mi serve solo ad evitare gli if...

If ntotlunghette > 0 Then 'And Sorte > 0 And Sorte < 6 Then

nTrov = 0
nProdotte = 0

Do While ntotlunghette > 0

nProdotte = nProdotte + 1

' CALL QUALSIASI FUNZIONE OPERATIVA RIDUZIONALE O ALTRO… la prima della
' eventuale sequenza…

Dim filexformazionidiverifica
ReDim Valoredecisoxformazionidiverifica(0)

filexformazionidiverifica = ".\file77.txt" ' qui si mette il nome del file con classe dello sviluppo finale da verificare...

LeggiRigheFileDiTesto filexformazionidiverifica,Valoredecisoxformazionidiverifica

ReDim vettoredastringaformazione(0)
Dim Va
Va = "0"
vettoredastringaformazione(0) = Va

Dim STRINGAVETTORECLASSEFINALE

STRINGAVETTORECLASSEFINALE = Valoredecisoxformazionidiverifica(0)

Call SplitByChar(STRINGAVETTORECLASSEFINALE,".",vettoredastringaformazione)

If UBound(vettoredastringaformazione) > 0 Then nTrov = nTrov + 1:Call ImpostaGiocata(1,vettoredastringaformazione,aRuotetmpxverifica,po,co,Sortediverifica):_

' QUI VOLENDO E' POSSIBILE AGGIUNGERE QUALSIASI FUNZIONE ULTERIORE… IN
' CASCATA… il file finale dell'elaborazione complessiva poi sarà letto dall'ultima funzione verificatutto             

: Call Verificatutto (inizio,counterrange,Sortediverifica,vettoredastringaformazione,aRuotetmp,co,nProdotte,nclasse,contaesitipos,contaesitineg,contacasinongiocabili,quanteestrazioniverificare,aRuotetmpxverifica)  '<<< E' QUESTA LA RIGA CHE FUNZIA! :)                                                                                                                                              
Dim sFilesound
Dim sFileAlertEmail
Dim reportlunghettadoc
Dim esito

If nProdotte Mod 10 = 0 Then

Dim crt
crt = co -(EstrazioneFin - counterrange)

Call Messaggio(inizio & "-" & counterrange & "Rr" & StringaRuote(aRuotetmp) & "r" & nProdotte & "V" & nTrov & "Rg" & StringaRuote(aRuotetmp) & "c" & nclasse & "Sr" & Sorte & "Sv" & Sortediverifica & "clp" & co & "Rm" & ramindes & "P" & contaesitipos & "N" & contaesitineg & "crt" & crt & "nm" & numerominimoincrementiattsto & "im" & valoreincmaxmassimo & "ftxt" & sFiletxt)

Call AvanzamentoElab(1,ntotlunghette,nProdotte)

Call DoEventsEx

'If ScriptInterrotto Or(contaesitipos + contaesitineg = numerocasi) Or counterrange = EstrazioneFin Then Exit Do 'termina ricerca al primo risultato utile...

If ScriptInterrotto Or counterrange = EstrazioneFin Then Exit Do 'termina ricerca al primo risultato utile...

Stop ' evidenzia solo un risultato utile per ruota per avere alla fine minor scelta e meno confusione...

'Exit Do ' provo ad uscire dall'estrazione esaminata al primo caso utile riscontrato

End If

ntotlunghette = ntotlunghette - 1

Loop

Scrivi "Ecco la configurazione testata"
Scrivi

Call Scrivi(inizio & "-" & counterrange & "Rr" & StringaRuote(aRuotetmp) & "r" & nProdotte & "V" & nTrov & "Rg" & StringaRuote(aRuotetmp) & "c" & nclasse & "Sr" & Sorte & "Sv" & Sortediverifica & "clp" & co & "Rm" & ramindes & "P" & contaesitipos & "N" & contaesitineg & "crt" & crt & "nm" & numerominimoincrementiattsto & "im" & valoreincmaxmassimo & "ftxt" & sFiletxt)
Scrivi

Scrivi
Scrivi "Esiti positivi: " & contaesitipos
Scrivi
Scrivi "Esiti negativi: " & contaesitineg
Scrivi
Scrivi "Estrazioni non esaminate: " & quanteestrazioniverificare -(contaesitipos + contaesitineg)
Scrivi

End If

End Sub

Function SelRuote(aRuote)
Dim t,k,bTutte
bTutte = False
t = ScegliRuote(aRuote)
For k = 1 To t
If aRuote(k) = TT_ Then
bTutte = True
Exit For
End If
Next
If bTutte Then
ReDim aRuote(10)
For k = 1 To 10
aRuote(k) = k
Next
SelRuote = 10
Else
SelRuote = t
End If
End Function

Function FormattaSecondi(s)

Dim hh
Dim Mm
Dim Ss
Dim TimeStr
hh = s \ 3600
Mm =(s Mod 3600) \ 60
Ss = s -((hh * 3600) +(Mm * 60))
TimeStr = Format2(hh) & ":" & Format2(Mm) & ":" & Format2(Ss)
FormattaSecondi = TimeStr

End Function

Function Verificatutto (Inizio,counterrange,sortediverifica,vettoredastringaformazione,aruotetmp,co,nprodotte,nclasse,contaesitipos,contaesitineg,contacasinongiocabili,quanteestrazioniverificare,aRuotetmpxverifica)

sFiletxt = ".\file77.txt"

Call Messaggio("Lettura file di testo")
ReDim aRighe(0)
'Call LeggiRigheFileDiTesto(sFile,aRighe)

LeggiRigheFileDiTesto sFiletxt,aRighe

For k = 0 To UBound(aRighe)
If aRighe(k) <> "" Then
ReDim aSelNum(0)
'Call SplitByChar("," & aRighe(k),",",aSelNum)
Call SplitByChar("." & aRighe(k),".",vettoredastringaformazione)

End If
Next

Dim L,T,V,Ini,fin,r,s,so,rit,max,Incr,fre,es,clp,estr,id,k,esito,sfilereport,reportlunghettadoc',contaesitipos,contaesitineg','Ru(1),k
   Ini = Inizio ' qui si sceglie l'inizio del range di verifica
   fin = counterrange ' qui si sceglie la fine dle range di verifica
   s = sortediverifica
   so = NomeSorte(s)
   L = vettoredastringaformazione
   T = Array(T,"Ruota","Lunghetta","Freq","Rit.Att","Max Sto","InCr","Sorte di Verifica")
   Call InitTabella(T)
   Call StatisticaFormazioneTurbo(L,aRuotetmpxverifica,s,rit,max,Incr,fre,Ini,fin)
   V = Array(V,StringaRuote(aRuotetmpxverifica),StringaNumeri(L),fre,rit,max,Incr,so)
   Call AddRigaTabella(V)
   CreaTabella
   Scrivi ".............................................Verifica..........................................................................."
   For es = counterrange To counterrange + co
      Call VerificaEsitoTurbo(L,aRuotetmpxverifica,es,s,1,,esito,clp,estr,id)
      If esito <> "" Then
         k = k + 1
         ReDim Preserve aRetRit(k)
         aRetRit(k) = es
         ReDim Preserve ess(k)
         ess(k) = aRetRit(k) - aRetRit(k - 1)
         Scrivi FormatSpace(k,4) & vbTab & GetInfoEstrazione(es) & vbTab,0,0
         Scrivi estr & vbTab & vbTab & FormatSpace(fin - id,4) & " > Estrazioni Trascorse < " & " Elenco Ritardi ... " & ess(k)
      End If
   Next
   Scrivi String(130,".")
   Scrivi "Tempo Trascorso : " & TempoTrascorso
Dim estrazionidiverificagiuste
estrazionidiverificagiuste = counterrange + 1
If VerificaEsito(vettoredastringaformazione,aRuotetmpxverifica,estrazionidiverificagiuste,sortediverifica,co) = True Then

Call Scrivi("ESITO di almeno " & sortediverifica & " punti <font color=green><strong>VERIFICATO</strong></font> nei " & co & " COLPI STABILITI")
Dim Infoestrazione
Infoestrazione = GetInfoEstrazione(counterrange)

Call Scrivi
contaesitipos = contaesitipos + 1
Call Scrivi("ESITI POSITIVI: " & contaesitipos)
Else
Call Scrivi
Call Scrivi("ESITO di almeno " & sortediverifica & " punti <font color=red><strong>NON VERIFICATO</strong></font> nei " & co & " COLPI STABILITI")
Call Scrivi

contaesitineg = contaesitineg + 1

Call Scrivi("ESITI NEGATIVI: " & contaesitineg)

End If

contacasinongiocabili = quanteestrazioniverificare -(contaesitipos + contaesitineg)

Call Scrivi("CASI NON ESAMINATI: " & contacasinongiocabili)

End Function

Function array_push(arr,vars)
  ' Dimensiono le variabili interne alla funzione
  Dim k,newelem,newarrsize,elem
  ' Verifico se arr è una array
  If IsArray(arr) Then
    ' Verifico che vars non sia vuoto
    If Len(vars) > 0 Then
      ' Verifico se vars ospita una o più virgole e quindi
      ' se è uno solo o un elenco di elementi.
      ' Se è un solo elemento...
      If InStr(vars,",") = False Then
        ' Incremento di uno il numero di elementi
        newarrsize = CInt(UBound(arr) + 1)
        ReDim Preserve arr(newarrsize)
        ' Aggiungo in coda il nuovo elemento
        arr(newarrsize) = vars
      ' Se vars è un elenco di elementi...
      Else
        ' Definisco un contatore interno con valore di partenza
        ' pari al numero di elementi dell'array originale + 1
        k =(UBound(arr) + 1)
        ' Creo una array con tutti i nuovi elementi da aggiungere
        newelem = Split(vars,",")
        ' Incremento il numero di elementi per contenere quelli nuovi
        newarrsize = CInt(UBound(arr) + UBound(newelem) + 1)
        ReDim Preserve arr(newarrsize)
        ' Ciclo i nuovi elementi per aggiungerli all'array originale
        For Each elem In newelem
          arr(k) = Trim(elem)
          k = k + 1
        Next
      End If
    End If
    array_push = arr
  ' Se arr non è una array la nostra funzione restituisce false
  Else
    array_push = False
  End If
End Function

 

[lotto_tom75]

in questo spazio (in questo unico post all'interno di questo thread), che modificherò di volta in volta, proverò a riportare tutte le "soluzioni" trovate sia empiricamente che attraverso la guida o aiuti riguardanti particolari problemi non sempre facilmente risolvibili... come memorandum personale e anche per cercare di evitare a tutti coloro che si trovassero in analoghe situazioni inutili versamenti di bile come spesso è successo al sottoscritto...? ?

Comincio con la simpatica funzione ?

Gioca

Limite max di colpi impostabili: 300 altrimenti viene fuori un ancor + simpatico msg di errore che fa pensare al for next non facendoti trovare il motivo del blocco nemmeno se piangi in cinese... ???㊗

Nel caso si voglia testare su un ciclo di estrazioni in run time al posto del parametro 1 consigliato di default basterà mettere il parametro idestrazione dinamico utilizzato (es. Gioca idestrazione)

La funzione gioca prende in considerazione solo vettori di classe max 10 in quanto valuta solo formazioni di tipo " giocabile " e non quelle estese oltre tale limite.

Ovviamente chi volesse contribuire alla stesura di simili "soluzioni" per facilitare la vita ai cibernauti programmatori lotto script in continuo divenire è più che benvenuto/a

 

[claudio8]

Ciao Tom.
innanzitutto sii preciso:
non è la funzione "Gioca" che gestisce il parametro dei colpi, bensi "ImpostaGiocata"
io uso ancora la versione 1.6.14 ma credo che nelle successive non sia cambiato nulla.
il mio limite di colpi è 255 come da test successivo:

Option Explicit
Sub Main
    Dim idEstr,Ruota
    Dim Inizio,Fine
    Inizio = 9000 'EstrazioneIni
    Fine = EstrazioneFin
    Ruota = BA_ 'ScegliRuota
    ReDim aR(1)
    Dim aP(3)
    aR(1) = 1
    aP(2) = 1
    If Ruota > 0 Then
        For idEstr = Inizio To Inizio
            ReDim aN(4)
            aN(1) = 1
            aN(2) = 2
            'aN(3) = 3
            'aN(4) = 4
            Call ImpostaGiocata(1,aN,aR,aP,255,2)
            Gioca(idEstr)
            Call AvanzamentoElab(Inizio,Fine,idEstr)
            If ScriptInterrotto Then Exit For
        Next
    End If
    ScriviResoconto
End Sub

Te credo, che piangi in cinese... ???㊗

salutoni

 

[i legend]

Limite max di colpi impostabili: 300 altrimenti viene fuori un ancor + simpatico msg di errore che fa pensare al for next non facendoti trovare il motivo del blocco nemmeno se piangi in cinese... ???㊗

????????
Tu non ci crederai ma non riesco a smettere di ridere ????
Simpaticissimo questo messaggio ?

 

[salvo50]

Ciao a Tutti.

E quando ti dice - Invalido uso di Null - e tu Null non l'hai messo da nessuna parte, altro che piangere in cinese, la bava alla bocca, adesso non più perchè a forza di prove ho scoperto che questo errore lo da quando c'è una variabile usata ma vuota.

 

[lotto_tom75]

Un saluto a tutti gli intervenuti ?? Confermo quanto detto da claudio. Il limite menzionato dei colpi max impostabili si riferisce alla funzione ImpostaGiocata e in effetti non è 300 ma 255 anche nell'ultima versione 1.6.34