LOTTO CON 30 NUMERI!!!

[claudio8]

x Filotto questo gira, ma voglio capirci meglio. Grazie

 

[fillotto]

x Filotto questo gira, ma voglio capirci meglio. Grazie

occhio a funzionare funziona solo che chiede 2 volte la posizione nella prima volta bisogna dare la posiz vera nella seconda richiesta bisogna la posiz precedente -1 esempo si desidera che si facciano le rilevazioni sulla 5^ pos alla prima richiesta si mette 5 alla seconda richiesta si mette 4 !!! .... funziona in questa maniera
Dalle prove tova la soluzione fino a 18 -20 cicli ma alcune volte, raramente, non la trova neanche a 12 e quindi bisogna abbassare i cicli.
Mi piacerebbe di poter fare delle ricerche in un arco di estrazioni predefinite da me (per fare delle prove)ma non ci sono riuscito per cui per adesso non devo aggiornare l'archivio di 3 estr (pur conoscendole)per vedere come va il programma.
L'ultima prova che ho fatto con l'archivio aggiornato a 3 estraz. fa dei 10 numeri pronosticati al terzo colpo ne sono usciti 4 .... puoi provare
se non ci credi . Se riesci a migliorarlo comunque è meglio!!

 

[claudio8]

  Sub Main()
    Call ApriBaseDatiFT("D:\Documents and Settings\claudio\Dati applicazioni\SpazioMetria\ArchivioPensy\PENSY.txt",5,",",30)
    Dim nr(2) ' i nr in gioco sono 2
    Dim pta(1) ' la puntata che faccio è l'ambata
    pta(1) = 0.50 'la puntata sull'ambata((1) è di 1 euro
    SetPremioPagatoFT 2,1,2.25,0.50 ' Ambo per Ambata
    Dim pnr(2) ' i prossimi nr in gioco sono 2
    'Dim po(5)
    cicli = InputBox("Inserire il num dei cicli(cicli di 3 estraz) di cui si vuol conoscere gli esiti ...",,12)
    estraz = cicli*3
    po = CInt(InputBox("Quale posizione conteggio Qui VERA ",,1))
    dal = EstrazioniArchivioFT - estraz
    al = EstrazioniArchivioFT
    k = 3 ' i Kolpi in gioco sono 3
    Scrivi FormatSpace("Range Statistico        : " & GetInfoEstrazioneFT(dal) & " - - " & GetInfoEstrazioneFT(al),86),True,True,,vbRed,3
    Scrivi FormatSpace("Intervallo estrazioni   : " & al - dal,86),True,True,,vbRed,3
    Scrivi FormatSpace("N° CICLI di 3 ESTRAZIONI: " & cicli,86),True,True,,vbRed,3
    Call GetCipECiop(dal,al,k,cip,ciop,po)
    If cip > 0 And ciop > 0 Then 'se sia CIP sia CIOP sono superiori a 0.....
        For n = dal To al Step 3 'questa riga dice che per fare i calcoli ci avvaliamo non degli indici
            'mensili ma di un'estrazione ogni 3 a cominciare dalla variabile " dal " ...+ 3.....+ 3 ecc fino alla fine
            'al 1° numero di ognuna di queste estrazioni che troverà fino alla fine si aggiungerà col fuori 90 una volta
            '"cip" ottenendo così un numero e una volta " ciop " per l'ultreiore numero
            Scrivi ">>Giochiamo su PE e aggiungiamo al " & po & "° Estratto di  ------> " & StringaEstrattiFT(n) & " i fissi " & cip & " e " & ciop
            'ng = 0
            nr(1) = FuoriX(EstrattoFT(n,po) + ciop,30)
            nr(2) = FuoriX(EstrattoFT(n,po) + cip,30)
            If VerificaEsitoFT(nr,n+1,1,k,resito,rcolpi,restratti,ridestr) Then '
                Scrivi "  Con i numeri  "  &Format2(nr(1)) & " e " & Format2(nr(2))  & "  Esito di " & resito & " al " & rcolpi & "° colpo :  [" & StringaEstrattiFT(n + rcolpi) & " ]"
            Else
                Scrivi "                         Esito negativo"
            End If
            For x= 1 To 3
            Scrivi " al " & x & "° colpo :  [" & StringaEstrattiFT(n+x) &"]"
            Next
            Call ImpostaGiocataFT(1,nr,pta,k,1) ' imposto la giocata e la stoppo all'uscita dell'ambata = 1
            GiocaFT n,,,1
        Next
        es = EstrazioniArchivioFT + 1
        pnr(1) = FuoriX(EstrattoFT(es - 1,po) + cip,30)
        pnr(2) = FuoriX(EstrattoFT(es - 1,po) + ciop,30)
        Scrivi " La prossima giocata va effettuata dall'estr n° " & n & " aggiungendo al " & po & "° estr. di " & StringaEstrattiFT(n) & _
        " i fissi " & cip & " e " & ciop & " cosi da avere i num da giocare " & pnr(1) & " - " & pnr(2)
        'pnr(1) = FuoriX(EstrattoFT(es - 1,po) + cip,30)
        'pnr(2) = FuoriX(EstrattoFT(es - 1,po) + ciop,30)
        ScriviResocontoFT
    Else
        MsgBox "Ambo da sommare impossibile da trovare per ottenere il risultato voluto !"
    End If
End Sub
Sub Sviluppoambi(aRetAmbi)' questa seconda routine combina i numeri in ambi
    ReDim aN(30)
    Dim k
    For k = 1 To 30 ' k sono i 30 numeri
        aN(k) = k
    Next
    aRetAmbi = SviluppoIntegrale(aN,2)
End Sub
Sub GetCipECiop(Inizio,Fine,Colpi,Cip,Ciop,po)'Questa Sub cerca la prima coppia che soddisfa la condizione ed esce.
    Dim arrAmbi
    Dim k,i,e,idEstr
    Dim bFound
    'po = CInt(InputBox("Metti la posiz Vera -1 (0 per la 1^, 1 x la 2^ ..4 per la 5^ ",,0))
    Cip = 0
    Ciop = 0
    Call Sviluppoambi(arrAmbi)
    For k = 1 To UBound(arrAmbi)
        bFound = True ' bFound è una variabile che assume il valore di vero
        For idEstr = Inizio To Fine - 1 Step 3'ciclo delle estrazioni
            ReDim aNumInGioco(2)
            i = 0
            e = 1 '  "e" è la posizione
            aNumInGioco(e) = FuoriX(EstrattoFT(idEstr,po) + arrAmbi(k,1),30)
            aNumInGioco(i) = FuoriX(EstrattoFT(idEstr,po) + arrAmbi(k,2),30)
            'Next
            If VerificaEsitoFT(aNumInGioco,idEstr + 1,1,Colpi) = False Then
                bFound = False
                Exit For
            End If
        Next
        If bFound = True Then
            Call Scrivi("Questa coppia di numeri " & arrAmbi(k,1) & " e " & arrAmbi(k,2) & " sommati all'estrazione Base (step 3) ha sempre generato un' ambata")
            Call Scrivi("")
            'Call Scrivi(StringaNumeri(aNumInGioco))
            Cip = arrAmbi(k,1)
            Ciop = arrAmbi(k,2)
            Exit For
        End If
    Next
End Sub

eliminata la 2a richiesta posizione, controlla se funziona correttamente.

 

[fillotto]

Grazie Claudio delle migliorie va bene ovvio io ho un percorso diverso da quello indicato da te ma funziona !!!
Ti confermo che il mio archivio è fermo all '1/2/16 ho fatto la stessa prova e dei 10 num proposti (anzi 9 perchè 11 era ripetuto) ho centrato una quaterna al terzo colpo, chiaramente non giocati come è mio solito!!

 

[tonixx]

Ragazzi novità??..

 

[fillotto]

Ragazzi novità??..

Sei riuscito a istallare " Spaziometria"? se si prova a far girare lo script di cui al # 43 con le correzioni fatte da Claudio8

 

[Alien.]

non si aggiorna all'ultimo post ?!
Alien hai sistemato?

NIENTE DA FARE MESSO IN SPAZIOMETRIA MA LO SCRIPT NON GIRA MI HA BLOCCATO SPAZIOMETRIA......ACC....MI DA ERRORE IL FILE DI TESTO NON ESISTE eppure l'ho messo in cartella giocate

 

[tonixx]

è la prima volta che uso spaziometria ,ho scaricato l ultima versione ho salvato il file script..ma come faccio a farlo girare??? help me...

 

[Alien.]

bhe a mi girano altamente le pallas citroen ho provato tre volte ma rien da faire

 

[fillotto]

NIENTE DA FARE MESSO IN SPAZIOMETRIA MA LO SCRIPT NON GIRA MI HA BLOCCATO SPAZIOMETRIA......ACC....MI DA ERRORE IL FILE DI TESTO NON ESISTE eppure l'ho messo in cartella giocate

Alien non so che dire ti dice che il file di testo non esiste perchè se tu hai copiato paro paro lo script di cui al #43 di claudio il percorso questo qui sotto lo devi cambiare [TABLE="border: 0, cellpadding: 0, cellspacing: 0"]
[TR]
[TD="class: xl65, width: 133"]Call ApriBaseDatiFT("D:\Documents and Settings\claudio\Dati applicazioni\SpazioMetria\ArchivioPensy\PENSY.txt" ,5,",",30)[/TD]
[/TR]
[/TABLE]
qiuindi si curamente non ci sarà "claudio" e poi perchè hai messo PENSY.txt (il file di testo che ho messo nel #28PENSY.txt) nella cartella giocate? segui quello che ti ho scritto al punto 34 cioè:
1° passo Apri Spaziometria in alto sulla tua sinistra sotto la B di Base dati c'è un simbolino di un contenitore di Cartelle Klic su di esso questa cartella (IN ALTO TROVI IL PERCORSO Tipo: utente-> AppData->Roaming->SpazioMetria) a sua volta contiene altre cartelle la prima delle quali dovrebbe essere
"Agenda Giocate" e varie altre .
Tu ne metti una tua esattamente come ho fatto io Inserendo una cartella "ArchivioPensy" perchè piu' esplicativa dentro la quale metterai L'archivio che ho mandato io .
A questo punto spaziometria è pronta a ricevere lo script che ho inviato Mettici un nome che ti pare PENSY o pippobaudo .....fammi sapere
Segui quanto sopra e.. non puoi sbagliare questo vale anche per tonixx

 

[fillotto]

IL mio percorso è questo:Call ApriBaseDatiFT("C:\Documents and Settings\utente\Dati applicazioni\SpazioMetria\ArchivioPensy\PENSY.txt" ,5,",",30)
vedi che è diverso da quello indicato da claudio
Call ApriBaseDatiFT("D:\Documents and Settings\claudio\Dati applicazioni\SpazioMetria\ArchivioPensy\PENSY.txt ",5,",",30) occhio alla D a voi sara quasi certamente la C

 

[tonixx]

allora sono riuscito a trovare il bottone esegui!!!! lo script parte ma dopo che ho messo i cicli si blocca dicendo cicli variabile non definita

 

[fillotto]

allora sono riuscito a trovare il bottone esegui!!!! lo script parte ma dopo che ho messo i cicli si blocca dicendo cicli variabile non definita

Non so hai messo lo script nell'Elabora script? sicuro di averlo copiato bene e di aver cambiato il percorso? dopo di che hai cliccato sul fulmine "esegui script" ? di più non saprei

 

[tonixx]

ho risolto dovevo togliere sopra il sub main la scritta option request..
diabolico questo programma ora pero come lo sfrutto?? sono appena entrato nel mondo spaziometria..

 

[Alien.]

ho gettato la spugna mi son messo a lavare l'auto

 

[tonixx]

Alien è semplicissimo una volta che hai copiato lo script, vai su base dati -->apri directory dati e poi ti cerchi l archivio pensy.txt dopodiché tasto destro proprietà e ti copi il percorso del file e sostituisci il percorso dello script che trovi all inizio dopo callapribasedatift..e il gioco è fatto..

 

[tonixx]

domanda x fillotto: se mi divertissi a trasformare l archivio txt in exel potrei usare le altre funzioni del programma??

 

[fillotto]

domanda x fillotto: se mi divertissi a trasformare l archivio txt in exel potrei usare le altre funzioni del programma??

l'archivio txt si può trasformare facilmente in excel con uno script ad hoc di spaziometria veramente poche righe rivolgiti agli scripters nella sezione download con una richiesta oppure vedi uno dei tanti script che hanno come output una tabella che si esporta in Excel e lo modifichi secondo i tuoi bisogni.
Le funzioni del programma sono del programma, in excel non si possono utilizzare almeno di fare delle macro e funzioni nei moduli appositi di excel. Una cosa sensata sarebbe di fare degli script che prevedono un output organizzato in tabella e esportabile in excel perchè magari sei abituato a questa visione ma ripeto spaziometria già fa tutto questo , in definitiva ti consiglio (ora che hai spaziometria) nella sezione download e provare qualche script per vedere le potenzialità del programma.

 

[fillotto]

Per tonixx questo è uno script (NON MIO E' DEL GRANDE I LEGEND io l'ho soltanto modificato per Pensilvania) addirittura il percorso se lo trova da solo vedi comunque

sFileCompleta = GetDirectoryAppData & "ArchivioPensy\PENSY.txt"
If ApriBaseDatiFT(sFileCompleta,05,",",30) Then

.Cosa fa? 3 diversi algoritmi (ricerche) e le mette in tabella simile a excel se vuoi l'output lo puoi esportare in excel .....divertiti

 Option Explicit
Sub Main
Dim Ini
Dim sFileCompleta
Dim idAlg
sFileCompleta = GetDirectoryAppData & "ArchivioPensy\PENSY.txt"
If ApriBaseDatiFT(sFileCompleta,05,",",30) Then
Ini = ScegliInizio
idAlg = ScegliAlgoritmo
Select Case idAlg
Case 0
Call LanciaAlgoritmoSommativo(Ini)
Case 1
Call AlgoritmoRipetizionePosiazioneAcolpo(Ini)
Case 2
Call RipetizioneCoppiaAColpo(Ini)
End Select
End If
End Sub
Sub LanciaAlgoritmoSommativo(Ini)
'Lo script è solo un abbazzo va Corretto
' non si garantisce che i calcoli restituiti siano corretti
' I risultati restituiti non sono previsioni
Dim sFileCompleta
Dim Fin,idEstr
Dim pos,E,iAdattatore
Dim Freq,Rit,RitMax,Incr
Dim nAlg,idSviluppo
Dim uE,uNum,ttNum,sorte
Dim T1,T2,nTotEstr
Fin = EstrazioniArchivioFT
sorte = 1
nTotEstr = Fin - Ini
nAlg = 30*5*(Fin - Ini)' lo calcolo per valorizzare progress barr
Call GetTestoTab
idSviluppo = 0
T1 = Timer
For iAdattatore = 1 To 30
For pos = 1 To 5
' azzero le variabili per ogni estratto
Rit = 0
RitMax = 0
Freq = 0
Incr = 0
' ciclo sino alla penultima estrazione per valorizzare l ultimo ritardo a colpo
For idEstr = Ini To Fin - 1
idSviluppo = idSviluppo + 1
If idEstr = Fin - 1 Then
Call Messaggio("StoElaborando: " & nTotEstr & "Estr.[Alg(  pos: " & pos & "+Adat. " & iAdattatore & ")]")
Call AvanzamentoElab(1,nAlg,idSviluppo)
End If
If ScriptInterrotto Then Exit For
E = EstrattoFT(idEstr,pos)
ttNum = FuoriX(E + iAdattatore,30)
If PosizioneFT(idEstr + 1,ttNum) > 0 Then
Rit = 0
Incr = 0
Freq = Freq + 1
Else
Rit = Rit + 1
If Rit > RitMax Then
RitMax = Rit
Incr = Incr + 1
End If
End If
Next
uE = EstrattoFT(Fin,pos)
uNum = FuoriX(uE + iAdattatore,30)
If ScriptInterrotto Then Exit For
ReDim aTab(8)
Call GetTabalella(aTab,pos,iAdattatore,Rit,RitMax,Incr,Freq,uNum)
Call AddRigaTabella(aTab)
Next
Next
T2 = Timer
Call ScriviTesto(Ini,Fin,nTotEstr,T2,T1,sorte)

Call CreaTabellaOrdinabile
End Sub
Sub GetTestoTab
Dim aTitoli
aTitoli = Array("","Posizione","Adatt","Rit","RitMax","IncrRit","ScartoRit","Freq","Numero")
Call InitTabella(aTitoli)
End Sub
Sub GetTabalella(aTab,Pos,iAdattatore,Rit,RitMax,Incr,Freq,Num)
aTab(1) = "P_" & Pos
aTab(2) = "+" & iAdattatore
aTab(3) = Rit
aTab(4) = RitMax
aTab(5) = Incr
aTab(6) = RitMax - Rit
aTab(7) = Freq
aTab(8) = Num
End Sub
Function FormattaSecondi(s)
Dim HH
Dim MM
Dim SS
Dim strTime
HH = s\3600
MM =(s Mod 3600)\60
SS = s -(HH*3600 + MM*60)
FormattaSecondi = Format2(HH) & " : " & Format2(MM) & " : " & Format2(SS)
End Function
Function ScegliInizio()
ReDim aV(EstrazioniArchivioFT)
Dim k
For k = 1 To UBound(aV)
aV(k) = GetInfoEstrazioneFT(k)
Next
ScegliInizio = ScegliOpzioneMenu(aV,1,"Inizio Ricerca")
End Function
Sub AlgoritmoRipetizionePosiazioneAcolpo(Ini)
'Lo script è solo un abbazzo va Corretto
' non si garantisce che i calcoli restituiti siano corretti
' I risultati restituiti non sono previsioni
Dim sFileCompleta
Dim nTotEstr,Fin,idEstr
Dim pos,E,iAdattatore
Dim Freq,Rit,RitMax,Incr
Dim nAlg,idSviluppo
Dim uE,uNum,ttNum
Dim T1,T2,sorte
sorte = 1
Fin = EstrazioniArchivioFT
nTotEstr = Fin - Ini
nAlg = 5*((Fin - 1) - Ini)
Call GetTestoTab1
T1 = Timer
idSviluppo = 0
For pos = 1 To 5
' azzero le variabili per ogni estratto
Rit = 0
RitMax = 0
Freq = 0
Incr = 0
' ciclo sino alla penultima estrazione per valorizzare l ultimo ritardo a colpo
For idEstr = Ini To Fin - 1
idSviluppo = idSviluppo + 1
If idEstr = Fin - 1 Then
Call Messaggio("StoElaborando: " & nTotEstr & " Estr.[Alg(  pos: " & pos & ")]")
Call AvanzamentoElab(1,nAlg,idSviluppo)
End If
If ScriptInterrotto Then Exit For
ttNum = EstrattoFT(idEstr,pos)
' Calcolo ultimo metodo
'Verifico se c'è ripetizione a colpo
If PosizioneFT(idEstr + 1,ttNum) > 0 Then
Rit = 0
Incr = 0
Freq = Freq + 1
Else
Rit = Rit + 1
' questa Formula è da controllare
' se ritardo Max e Incrementi sono
'calcolati correttamente
If Rit > RitMax Then
RitMax = Rit
Incr = Incr + 1
End If
End If
Next
uNum = EstrattoFT(Fin,pos)
If ScriptInterrotto Then Exit For
ReDim aTab(7)
Call GetTabalella1(aTab,pos,Rit,RitMax,Incr,Freq,uNum)
Call AddRigaTabella(aTab)
Next
T2 = Timer
Call ScriviTesto(Ini,Fin,nTotEstr,T2,T1,sorte)

Call CreaTabellaOrdinabile
End Sub
Sub GetTestoTab1
Dim aTitoli
aTitoli = Array("","Posizione","Rit","RitMax","IncrRit","ScartoRit","Freq","Numero")
Call InitTabella(aTitoli)
End Sub
Sub GetTabalella1(aTab,Pos,Rit,RitMax,Incr,Freq,Num)
aTab(1) = Pos
aTab(2) = Rit
aTab(3) = RitMax
aTab(4) = Incr
aTab(5) = RitMax - Rit
aTab(6) = Freq
aTab(7) = Num
End Sub
Function ScegliAlgoritmo
Dim aAlg
aAlg = Array("AlgoritmoRipetizioneSommativo_aColpo","RipetizionePosizione_aColpo","Ripetizione Coppia a Colpo")
ScegliAlgoritmo = ScegliOpzioneMenu(aAlg,0,"SelezionaRoutine")
End Function
Sub RipetizioneCoppiaAColpo(Ini)
'Lo script è solo un abbazzo va Corretto
' non si garantisce che i calcoli restituiti siano corretti
' I risultati restituiti non sono previsioni
Dim sFileCompleta
Dim Fin,idEstr
Dim pos1,pos2,E,iAdattatore
Dim Freq,Rit,RitMax,Incr
Dim nAlg,idSviluppo
Dim sNum,nTotEstr
Dim sorte
Dim T1,T2
ReDim aNum(2)
T1 = Timer
' scegliRange non ce nel help ho la versione 1.5.71
Fin = EstrazioniArchivioFT
nTotEstr = Fin - Ini
sorte = Sceglisorte
nAlg = 21*((Fin - 1) - Ini)
Call GetTestoTab1
idSviluppo = 0
For pos1 = 1 To 4
For pos2 = pos1 + 1 To 5
' azzero le variabili per ogni estratto
Rit = 0
RitMax = 0
Freq = 0
Incr = 0
' ciclo sino alla penultima estrazione per valorizzare l ultimo ritardo a colpo
For idEstr = Ini To Fin - 1
idSviluppo = idSviluppo + 1
If idEstr Mod 1500 = 0 Then
Call Messaggio("StoElaborando: idestr=" & idEstr & "  pos: " & pos1 & "-" & pos2)
Call AvanzamentoElab(1,nAlg,idSviluppo)
End If
If ScriptInterrotto Then Exit For
aNum(1) = EstrattoFT(idEstr,pos1)
aNum(2) = EstrattoFT(idEstr,pos2)
' Calcolo ultimo metodo
'Verifico se c'è ripetizione a colpo
If SerieFreqFT(idEstr + 1,idEstr + 1,aNum,sorte) > 0 Then
Rit = 0
Incr = 0
Freq = Freq + 1
Else
Rit = Rit + 1
' questa Formula è da controllare
' se ritardo Max e Incrementi sono
'calcolati correttamente
If Rit > RitMax Then
RitMax = Rit
Incr = Incr + 1
End If
End If
Next
aNum(1) = EstrattoFT(Fin,pos1)
aNum(2) = EstrattoFT(Fin,pos2)
sNum = StringaNumeri(aNum,,True)
If ScriptInterrotto Then Exit For
ReDim aTab(7)
Call GetTabalella1(aTab,pos1 & "-" & pos2,Rit,RitMax,Incr,Freq,sNum)
Call AddRigaTabella(aTab)
Next
Next
T2 = Timer
Call ScriviTesto(Ini,Fin,nTotEstr,T2,T1,sorte)

Call CreaTabellaOrdinabile
End Sub
Function Sceglisorte
Dim aSorte
aSorte = Array("Estratto","Ambo")
Sceglisorte = ScegliOpzioneMenu(aSorte,0,"SelezionaEsito") + 1
End Function
Function ScriviTesto(Ini,Fin,nTotEstr,T2,T1,sorte)

Scrivi FormatSpace(" Il Gioco è vietato ai minori di anni 18,puo comportare grave dipendenze patologiche ",86),True,True,,vbRed,3
Scrivi FormatSpace(" PER CHI GIOCA , FARLO SOLO SE E' LEGALE ,E, DOVE E' LEGALE ",86),True,True,,vbRed,3

Scrivi FormatSpace(" LO SCRIPT RESTITUISCE DATI STATISTICI (da verificare sempre) NON CONSIGLIA PREVISIONI",85),True,True,,vbRed,3

Scrivi
Scrivi "Range Statistico     : " & GetInfoEstrazioneFT(Ini) & "-" & GetInfoEstrazioneFT(Fin)
Scrivi "Estrazioni Esaminate : " & nTotEstr
Scrivi "Tempo elaborazione   : " & FormattaSecondi((T2 + 1) - T1)
Scrivi "Sorte Analizzata     : " & NomeSorte(sorte)

End Function

 

[tonixx]

hey fill calmo sei partito in quarta!!!..non mi sono spiegato bene,ok per l archivio excel non ci sono problemi; se sostituissi l'archivio lotto italiano con quello pennsilvania il programma funzionerebbe alllo stesso modo??

grazie fillotto