Script Presenza nei casi

i legend · 24 Marzo 2015

Lo script di seguito da me realizzato , vede la sua nascita grazie al preziosissimo aiuto di joe,senza il quale non ci sarei riuscito
Come scritto nello script non ci sono certezze solo statistica dei casi nel passato.
L'output si può migliorare
l'ultimo caso se la verifica è gia cominciata ci rileva se i numeri in tabella sono gia sortiti...
Testatelo e fatemi sapere.
Aspetto vostre nuove..
Per joe e surmang provatelo per favore

Codice:

Option Explicit
Sub Main
    ' controllare dati di input e di output
    ' se si dovessero rilevare bugs segnalarli
    ' lo script è lungo l'errore puo essere dietro l'angolo
    ' l'algoritmo principe  di rilevazione degli estratti  è scritto  da Joe
    '  script by I legend
    ' Lo script è a carattere statistico , ci rivela dei dati del passato ma nessuna certezza per il futuro.
    '
    Dim PEU,UEU,iF_E1,iP_E1,iR_E1,sE1,sF_E1
    Dim iF_E2,iP_E2,iR_E2,sE2,sF_E2
    Dim iF_E3,iP_E3,iR_E3,sE3,sF_E3
    Dim Ind_EspRic,Str_EspRic,risultatoespressione
    Dim casoTro
    Dim eE1,eE2,eE3 ' estrattosemplice
    Dim cF_E1,cF_E2,cF_E3 ' CalcoloFunzioneEstratto
    Dim risultatoEspressioneSto
    Dim EstrR,idEstr,Ini,Fin
    Dim aTitolo,K
    Dim Id,Metodo,nColpi,nNegativi,RuG
    Dim filtroPari,filtroPariSto
    Dim IniGioco,FinGioco,Es,Estrazioni,KK,C,PG,E,X
    ReDim PrCi(90),TmP(90)
    If ImpostaParametri(PEU,UEU,iF_E1,iP_E1,iR_E1,sE1,sF_E1,iF_E2,iP_E2,iR_E2,sE2,sF_E2,iF_E3,iP_E3,iR_E3,sE3,sF_E3,Ind_EspRic,Str_EspRic,nColpi,nNegativi,RuG) = False Then
        MsgBox "I Parametri inseriti non sono corretti",vbCritical
        Exit Sub
    End If
    EstrR = UEU
    eE1 = Estratto(EstrR,iR_E1,iP_E1)
    eE2 = Estratto(EstrR,iR_E2,iP_E2)
    eE3 = Estratto(EstrR,iR_E3,iP_E3)
    cF_E1 = CalcFunPar(iF_E1,eE1) ' questa funzione restituisce il valore finale dell'estratto
    cF_E2 = CalcFunPar(iF_E2,eE2) ' questa funzione restituisce il valore finale dell'estratto
    cF_E3 = CalcFunPar(iF_E3,eE3) ' questa funzione restituisce il valore finale dell'estratto
    risultatoespressione = EseguiCalcolo(Ind_EspRic,cF_E1,cF_E2,cF_E3)
    If risultatoespressione = 0 Then
        MsgBox "la formula scelta Restituisce zero"
        Exit Sub
    End If
    MsgBox DataEstrazione(EstrR) & "  ;   " & Str_EspRic & "   ;   " & cF_E1 & " , " & cF_E2 & " , " & cF_E3 & _
    "          RangeRisultato= " & risultatoespressione
    Ini = PEU
    Fin = UEU
    aTitolo = Array("","Estratto","CasiPos.")
    InitTabella aTitolo,RGB(240,240,240),,3,vbBlack
    Scrivi "Estratti presenti nei casi    :  "
    Scrivi
    For idEstr = Ini To Fin
        Messaggio "Sto Contando un Attimo Grazie :)" & casoTro
        AvanzamentoElab Ini,Fin,idEstr
        eE1 = Estratto(idEstr,iR_E1,iP_E1)
        eE2 = Estratto(idEstr,iR_E2,iP_E2)
        eE3 = Estratto(idEstr,iR_E3,iP_E3)
        cF_E1 = CalcFunPar(iF_E1,eE1) ' questa funzione restituisce il valore finale dell'estratto
        cF_E2 = CalcFunPar(iF_E2,eE2) ' questa funzione restituisce il valore finale dell'estratto
        cF_E3 = CalcFunPar(iF_E3,eE3) ' questa funzione restituisce il valore finale dell'estratto
        risultatoEspressioneSto = EseguiCalcolo(Ind_EspRic,cF_E1,cF_E2,cF_E3)
        If risultatoEspressioneSto = risultatoespressione Then
            casoTro = casoTro + 1
            IniGioco = idEstr + 1
            FinGioco = idEstr + nColpi
            If IniGioco <= EstrazioneFin Then 'Controllo validità iniziale del cicl'
                If FinGioco > EstrazioneFin Then FinGioco = EstrazioneFin 'Controllo/limitazione lunghezza del ciclo.
                KK = 0
                ReDim TmP(90)
                For C = IniGioco To FinGioco
                    KK = KK + 1
                    For PG = 1 To 5
                        E = Estratto(C,RuG,PG)
                        TmP(E) = True
                    Next
                Next
            Else
                Exit For
            End If
            Scrivi DataEstrazione(idEstr) & "  ",1,False
            Scrivi Format2(casoTro) & ") ",1,False
            For X = 1 To 90
                If TmP(X) = True Then PrCi(X) = PrCi(X) + 1 : Scrivi Format2(X) & " ",True,False
            Next
            Scrivi
        End If
    Next
    For X = 1 To 90
        ReDim aRis(2)
        Call alimentaArray(aRis,X,CInt(PrCi(X)))
        If CInt(PrCi(X)) >= casoTro - nNegativi Then Call AddRigaTabella(aRis)
    Next
    Call LanciaIntestazione(EstrR,Str_EspRic,cF_E1,cF_E2,cF_E3,risultatoespressione,casoTro,RuG,nColpi,nNegativi)

    Call CreaTabellaOrdinabile
End Sub
Function ImpostaParametri(PEU,UEU,iF_E1,iP_E1,iR_E1,sE1,sF_E1,iF_E2,iP_E2,iR_E2,sE2,sF_E2,iF_E3,iP_E3,iR_E3,sE3,sF_E3,Ind_EspRic,Str_EspRic,nColpi,nNegativi,RuG)
    Dim bRet
    MsgBox "Sel Estrazione di ricerca,e, 3 EstrattiBase ",,"Metodo x calcolo Estratto semplice "
    PEU = primaEstrazioneUtile(3914)
    If PEU > 0 Then
        UEU = UltimaEstrazioneUtile(3914)
        If UEU > 0 Then
            iF_E1 = IndFunPar
            If iF_E1 > 0 Then
                iP_E1 = ScegliPosizione
                If iP_E1 > 0 Then
                    iR_E1 = ScegliRuota
                    If iR_E1 > 0 Then
                        sE1 = SiglaRuota(iR_E1) & iP_E1
                        sF_E1 = ScriviParametroCab(iF_E1,sE1)
                        iF_E2 = IndFunPar
                        If iF_E2 > 0 Then
                            iP_E2 = ScegliPosizione
                            If iP_E2 > 0 Then
                                iR_E2 = ScegliRuota
                                If iR_E2 > 0 Then
                                    sE2 = SiglaRuota(iR_E2) & iP_E2
                                    sF_E2 = ScriviParametroCab(iF_E2,sE2)
                                    iF_E3 = IndFunPar
                                    If iF_E3 > 0 Then
                                        iP_E3 = ScegliPosizione
                                        If iP_E3 > 0 Then
                                            iR_E3 = ScegliRuota
                                            If iR_E3 > 0 Then
                                                sE3 = SiglaRuota(iR_E3) & iP_E3
                                                sF_E3 = ScriviParametroCab(iF_E3,sE3)
                                                Ind_EspRic = EspressioneDiRicerca(sF_E1,sF_E2,sF_E3)
                                                Str_EspRic = scriviEspressioneDiRicerca(sF_E1,sF_E2,sF_E3,Ind_EspRic)
                                                If Ind_EspRic > 0 Then
                                                    nColpi = QuantiColpi
                                                    If nColpi > 0 Then
                                                        nNegativi = QuantiNegativi
                                                        If nNegativi > 0 Then
                                                            MsgBox "Seleziona Ruota Di Ricerca                          ",,"Ruota Di Ricerca :" & SiglaRuota(iR_E1) & "-" & SiglaRuota(iR_E2) & "-" & SiglaRuota(iR_E3)
                                                            RuG = ScegliRuota
                                                            If RuG = 11 Then RuG = 12
                                                        End If
                                                    End If
                                                    bRet = True
                                                End If
                                            End If
                                        End If
                                    End If
                                End If
                            End If
                        End If
                    End If
                End If
            End If
        End If
    End If
    ImpostaParametri = bRet
End Function
Sub alimentaArray(aRis,k,Fre)
    aRis(1) = k
    aRis(2) = Fre
End Sub
Sub LanciaIntestazione(EstrR,Str_EspRic,cF_E1,cF_E2,cF_E3,risultatoEspressione,CasoTro,RuG,nColpi,nNegativi)
Scrivi
    Scrivi "Condizioni di Ricerca         :                                           ",1,,RGB(254,230,131)
    Scrivi
    Scrivi "DataCondizione                :  " & DataEstrazione(EstrR)
    Scrivi "Esoressione di Ricerca        :  " & Str_EspRic
    Scrivi "Valore estratti               :  " & "   (" & Format2(cF_E1) & ") .     (" & Format2(cF_E2) & ") .    (" & Format2(cF_E3) & ")"
    Scrivi "RangeRisultato                :  " & format2(risultatoEspressione)
    Scrivi "Casi totali Esaminati         :  " & format2(CasoTro)
    Scrivi "Ruota di verifica             :  " & NomeRuota(RuG)
    Scrivi "Colpi di Verifica           :  " & Format2(nColpi)
    Scrivi "Max Casi Negativi             :  " & Format2(nNegativi)
    Scrivi
End Sub
Function ScegliPosizione
    Dim aPos,Ris
    aPos = Array("","1","2","3","4","5")
    Ris = ScegliOpzioneMenu(aPos,1,"ScegliPosizione")
    ScegliPosizione = Ris
End Function
Function IndFunPar
    Dim Ris
    Dim aParametro
    aParametro = Array("","F90","Ddec","D45","Dif90","Sim91","Vert","Dec","Cad","Fig","C.Fig")
    Ris = ScegliOpzioneMenu(aParametro,1,"SelezionaParametroEstratto")
    IndFunPar = Ris
End Function
Function CalcFunPar(Ind_FunEstr,e_E1) 'indiceFunzioneParametroEstratto
    Dim Ris
    Dim aParametro(10)
    aParametro(0) = 0
    aParametro(1) = Fuori90(e_E1)
    aParametro(2) = DiametraleD(e_E1)
    aParametro(3) = Diametrale(e_E1)
    aParametro(4) = ComplAdX(e_E1)
    aParametro(5) = ComplAdX(e_E1,91)
    aParametro(6) = Vert(e_E1)
    aParametro(7) = Decina(e_E1)
    aParametro(8) = Cadenza(e_E1)
    aParametro(9) = Figura(e_E1)
    aParametro(10) = ControFigura(e_E1)
    Ris = aParametro(Ind_FunEstr)
    CalcFunPar = Ris
End Function
Function ScriviParametroCab(Ind_Parametro,sE_1)
    Dim Ris
    Dim aParametro
    aParametro = Array("","F90","Ddec","D45","Dif90","Sim91","Vert","Dec","Cad","Fig","C.Fig")
    Ris = aParametro(Ind_Parametro) & "(" & sE_1 & ")"
    ScriviParametroCab = Ris
End Function
Function EseguiCalcolo(Ind_StringaDiRic,ValFin_1,ValFin_2,ValFin_3)
    Dim ris
    Dim aOperazioni(18)
    aOperazioni(0) = 0
    aOperazioni(1) = Fuori90(ValFin_1 + ValFin_2 + ValFin_3)
    aOperazioni(2) = Distanza(Fuori90(ValFin_1 + ValFin_2),ValFin_3)
    aOperazioni(3) = Fuori90(ValFin_1 + Distanza(ValFin_2,ValFin_3))
    aOperazioni(4) = Fuori90((ValFin_1 + ValFin_2)*ValFin_3)
    aOperazioni(5) = Fuori90(ValFin_1 +(ValFin_2*ValFin_3))
    aOperazioni(6) = Fuori90(Distanza(ValFin_1,ValFin_2) + ValFin_3)
    aOperazioni(7) = Distanza(ValFin_1,Fuori90(ValFin_2 + ValFin_3))
    aOperazioni(8) = Distanza(Distanza(ValFin_1,ValFin_2),ValFin_3)
    aOperazioni(9) = Distanza(ValFin_1,Distanza(ValFin_2,ValFin_3))
    aOperazioni(10) = Fuori90(Distanza(ValFin_1,ValFin_2)*ValFin_3)
    aOperazioni(11) = Distanza(ValFin_1,Fuori90(ValFin_2*ValFin_3))
    aOperazioni(12) = Fuori90((ValFin_1 * ValFin_2) + ValFin_3)
    aOperazioni(13) = Fuori90(ValFin_1 *(ValFin_2 + ValFin_3))
    aOperazioni(14) = Distanza(Fuori90(ValFin_1 * ValFin_2),ValFin_3)
    aOperazioni(15) = Fuori90(ValFin_1 *Distanza(ValFin_2,ValFin_3))
    aOperazioni(16) = Fuori90(ValFin_1 * ValFin_2 * ValFin_3)
    aOperazioni(17) = Fuori90(Piramide(ValFin_1 & ValFin_2 & ValFin_3,,2))
    aOperazioni(18) = Fuori90(ValFin_1 & ValFin_2 & ValFin_3)
    ris = aOperazioni(Ind_StringaDiRic)
    EseguiCalcolo = ris
End Function
Function EspressioneDiRicerca(sBase1,sBase2,sBase3)
    Dim aOperatore,Ris
    aOperatore = Array("",_
    "(" & sBase1 & " + " & sBase2 & " + " & sBase3 & ")",_
    "(" & sBase1 & " + " & sBase2 & ")- " & sBase3 & "",_
    "" & sBase1 & " +(" & sBase2 & " - " & sBase3 & ")",_
    "(" & sBase1 & " + " & sBase2 & ")* " & sBase3 & "",_
    "" & sBase1 & " +(" & sBase2 & "* " & sBase3 & ")",_
    "(" & sBase1 & " - " & sBase2 & ")+ " & sBase3 & "",_
    "" & sBase1 & " -(" & sBase2 & " + " & sBase3 & ")",_
    "(" & sBase1 & " - " & sBase2 & ")- " & sBase3 & "",_
    "" & sBase1 & " -(" & sBase2 & " - " & sBase3 & ")",_
    "(" & sBase1 & " - " & sBase2 & ")* " & sBase3 & "",_
    "" & sBase1 & " -(" & sBase2 & " * " & sBase3 & ")",_
    "(" & sBase1 & " * " & sBase2 & ")+ " & sBase3 & "",_
    "" & sBase1 & " *(" & sBase2 & " + " & sBase3 & ")",_
    "(" & sBase1 & " * " & sBase2 & ")- " & sBase3 & "",_
    "" & sBase1 & " *(" & sBase2 & " - " & sBase3 & ")",_
    "" & sBase1 & " * " & sBase2 & " * " & sBase3 & "",_
    "Piramida(" & sBase1 & " ; " & sBase2 & " ; " & sBase3 & ")",_
    "Unione(" & sBase1 & " ; " & sBase2 & " ; " & sBase3 & ")")
    Ris = ScegliOpzioneMenu(aOperatore,1,"GetEspressioneDiRicerca")
    EspressioneDiRicerca = Ris
End Function
Function scriviEspressioneDiRicerca(sBase1,sBase2,sBase3,Ind)
    Dim aOperatore,Ris
    aOperatore = Array("",_
    "(" & sBase1 & " + " & sBase2 & " + " & sBase3 & ")",_
    "(" & sBase1 & " + " & sBase2 & ")- " & sBase3 & "",_
    "" & sBase1 & " +(" & sBase2 & " - " & sBase3 & ")",_
    "(" & sBase1 & " + " & sBase2 & ")* " & sBase3 & "",_
    "" & sBase1 & " +(" & sBase2 & "* " & sBase3 & ")",_
    "(" & sBase1 & " - " & sBase2 & ")+ " & sBase3 & "",_
    "" & sBase1 & " -(" & sBase2 & " + " & sBase3 & ")",_
    "(" & sBase1 & " - " & sBase2 & ")- " & sBase3 & "",_
    "" & sBase1 & " -(" & sBase2 & " - " & sBase3 & ")",_
    "(" & sBase1 & " - " & sBase2 & ")* " & sBase3 & "",_
    "" & sBase1 & " -(" & sBase2 & " * " & sBase3 & ")",_
    "(" & sBase1 & " * " & sBase2 & ")+ " & sBase3 & "",_
    "" & sBase1 & " *(" & sBase2 & " + " & sBase3 & ")",_
    "(" & sBase1 & " * " & sBase2 & ")- " & sBase3 & "",_
    "" & sBase1 & " *(" & sBase2 & " - " & sBase3 & ")",_
    "" & sBase1 & " * " & sBase2 & " * " & sBase3 & "",_
    "Piramida(" & sBase1 & " ; " & sBase2 & " ; " & sBase3 & ")",_
    "Unione(" & sBase1 & " ; " & sBase2 & " ; " & sBase3 & ")")
    Ris = aOperatore(Ind)
    scriviEspressioneDiRicerca = Ris
End Function
Function UltimaEstrazioneUtile(nInizio)
    Dim es,Inizio
    ReDim aVoci(EstrazioneFin)
    For es = nInizio To EstrazioneFin
        aVoci(es) = DataEstrazione(es)
    Next
    Inizio = ScegliOpzioneMenu(aVoci,EstrazioneFin - 2,"Inserisci Data Ultima Analisi")
    UltimaEstrazioneUtile = Inizio
End Function
Function primaEstrazioneUtile(nInizio)
    Dim es,Inizio,Id
    ReDim aVoci(EstrazioneFin)
    For es = nInizio To EstrazioneFin
        aVoci(es) = DataEstrazione(es)
    Next
    Id = EstrazioneFin - 1000
    Inizio = ScegliOpzioneMenu(aVoci,Id,"Inserisci Data Inizio Analisi")
    primaEstrazioneUtile = Inizio
End Function
Function QuantiColpi
    Dim aVoci(15)
    Dim i,bRet
    For i = 1 To 15
        aVoci(i) = i
    Next
    bRet = ScegliOpzioneMenu(aVoci,10,"SelezionaQuantiColpiEsaminare")
    QuantiColpi = bRet
End Function
Function QuantiNegativi
    Dim aVoci(15)
    Dim i,bRet
    For i = 1 To 15
        aVoci(i) = i
    Next
    bRet = ScegliOpzioneMenu(aVoci,4,"SelezionaIlNumeroMassimoDiNegativi")
    QuantiNegativi = bRet
End Function

Corretta la riga if fin <estrazionefin
con fin<=Estrazionefin
Ricopiate lo script oppure corregete la riga

Migliorato output dati

nelson1331 · 24 Marzo 2015

Ciao I Legend, l' ho provato. Mi segnala pero' questo errore in output : Grid Leggi file 30009 valore di riga non valido.

i legend · 24 Marzo 2015

Ciao nelson Riprova a copiarlo forse hai un versione vecchia... ho riscritto una riga come mi aveva suggerito joe, avevo fatto una prova ...
Ciao a dopo

P.S Nelson la tabella stampa a video solo le righe con una percentuale di positivi, aumenta i colpi e il numero dei casi negativi

nelson1331 · 24 Marzo 2015

Ciao I Legend, l' errore che avevo segnalato, deriva dalla condizione : errori max. = 1

nelson1331 · 24 Marzo 2015

Mi spiego meglio : se lascio numero massimo dei negativi = 1, mi segnala l' errore sopraccitato.

i legend · 24 Marzo 2015

Ciao nelson devi aumentare il numero dei negativi o ridurre i casi

i legend · 24 Marzo 2015

Ciao nelson devi aumentare il numero dei negativi o ridurre i casi
Vedi l'allegato 14959

nelson1331 · 25 Marzo 2015

Ciao I Legend,
facendo alcune prove, riscontro alcune difficolta' nella lettura dell' output e di conseguenza le verifiche degli esiti.
Questi sono i parametri, che chiedo tu possa inserire nell' output :
Riporta la data inizio calcolo.
In ciascun caso, scrivere la data dell' evento, cioe' su ciascuna riga.
Riporta su ciascuna riga, i 3 algoritmi convertiti in triplice somma estratti (come fai gia' in testata).
Sara' cosi' assai piu' facile fare le verifiche degli esiti (e' quello che voglio fare).
Potresti anche provare a prendere i primi o migliori 10 risultati di questa classifica e vedere gli esiti, in corrispondenza di ciascun evento.
Ci sentiamo per controlli e migliorie.
Nelson

nelson1331 · 25 Marzo 2015

Un esempio di ricerca :
Data inizio : 30.10.2008
Data fine ricerca : 03.03.2015
Ruota di ricerca : Bari (1° estratto, 2° estratto, 3° estratto)
Ruota di gioco : Bari
Numero colpi di gioco : 4
Numero max. casi negativi : 4
Numeri risultanti dalla ricerca : 2.6.34.73
Esiti :
1° colpo 6
4° colpo 73
5° colpo 73
8° colpo 34.73

nelson1331 · 25 Marzo 2015

Altro esempio di ricerca :
Data inizio : 30.10.2008
Data fine ricerca : 03.03.2015
Ruota di ricerca : Venezia (1° estratto, 2° estratto, 3° estratto)
Ruota di gioco : Venezia
Numero colpi di gioco : 5
Numero max. casi negativi : 5
Numeri risultanti dalla ricerca : 4.31.41.47.52.53.65.67.77.82.84.85.90 (totale : 13 numeri)
Esiti :
2° colpo 53
3° colpo 67
4° colpo quaterna 84.52.85.65

i legend · 25 Marzo 2015

Ciao Nelson Ci dovrò Lavorare su, vedo cosa posso fare,
Joe Surmang che ne pensate?
Non tanto del tipo di ricerca che puo anche non interessare , ma del codice di come è scritto

Ciao a dopo
Intanto migliorato output:

nelson1331 · 25 Marzo 2015

Ciao I Legend,
un altro aspetto importante da curare, e' la forma del layout, ossia, avere la possibilita' di scrivere le righe di output, non solo nella forma attuale, dal numero piu' piccolo al piu' grande ma, anche nella sequenza naturale della lettura degli stessi. Ossia come sono letti nella sequenza indicizzata dell' archivio lotto.
Cambiera' completamente il prospetto delle righe, con aspetti interessanti, per individuare le migliori formazioni.
Alla prossima.

nelson1331 · 25 Marzo 2015

Altro esempio di ricerca :
Data inizio : 30.10.2008
Data fine ricerca : 03.03.2015
Ruota di ricerca : Genova (1° estratto, 2° estratto, 3° estratto)
Ruota di gioco : Genova
Numero colpi di gioco : 6
Numero max. casi negativi : 6
Numeri risultanti dalla ricerca : 34.75.89.47.86.48.68.44 (totale : 8 numeri)
Esiti :
2° colpo 48.44
6° colpo terno 34.86.68
Forza I Legend, lo studio e' valido ed estremamente interessante. Ho fatto tante prove ed i risultati sono di tutto rispetto. Aspetto tue nuove. Se hai bisogno di aiuto, soprattutto nelle verifiche e/o nella stesura dello script, chiedi e cerchero' di collaborare. La strada che hai imboccato e' valida : persisti e ti forniro' piano piano altri utili criteri di ricerca. Nelson

nelson1331 · 25 Marzo 2015

Altro esempio di ricerca :
Data inizio : 30.10.2008
Data fine ricerca : 03.03.2015
Ruota di ricerca : Roma (1° estratto, 2° estratto, 3° estratto)
Ruota di gioco : Roma
Numero colpi di gioco : 6
Numero max. casi negativi : 6
Numeri risultanti dalla ricerca : 88.9.46.86.6.49.80.8.43.13 (Ho scelto i primi 10, poiche' nel gruppo vi sono in totale, 14 numeri)
Esiti :
2° colpo 86.43
3° colpo 6.8
4° colpo 46.8
7° colpo terno 9.80.8
I Legend : cosa vuoi di piu' dalla vita ? Ih Ih Ih ....Nelson

i legend · 25 Marzo 2015

Ciao nelson,ho provato a fare delle modifiche ma ho perso tutto per un loop,e visto lo scarso interesse mi sono stufato, cmq vedo che a parte l'output i calcoli sembrano essere corretti, puoi modificarlo, come credi meglio

Se non ci riesci , poste le modifiche appena mi passa la delusione del lavoro perso.
Tra un po provero a fare un sommattivo
Ciao e buona serata

Grazie per avere partecipato al post...

fillotto · 26 Marzo 2015

Scarso interesse?? non credo proprio!!
Sono sconcertato nel constatare che i frequentatori sono attratti da pronostici belli e fatti e andare dietro a titoli quanto più fantasiosi possibile.
Vai avanti così ,molti ti seguono!!

nelson1331 · 26 Marzo 2015

Correzioni output

Correzioni output

Codice:

Option Explicit
Sub Main
' controllare dati di input e di output
' se si dovessero rilevare bugs segnalarli
' lo script è lungo l'errore puo essere dietro l'angolo
' l'algoritmo principe  di rilevazione degli estratti  è scritto  da Joe
'  script by I legend
' Lo script è a carattere statistico , ci rivela dei dati del passato ma nessuna certezza per il futuro.
'
Dim PEU,UEU,iF_E1,iP_E1,iR_E1,sE1,sF_E1
Dim iF_E2,iP_E2,iR_E2,sE2,sF_E2
Dim iF_E3,iP_E3,iR_E3,sE3,sF_E3
Dim Ind_EspRic,Str_EspRic,risultatoespressione
Dim casoTro
Dim eE1,eE2,eE3 ' estrattosemplice
Dim cF_E1,cF_E2,cF_E3 ' CalcoloFunzioneEstratto
Dim risultatoEspressioneSto
Dim EstrR,idEstr,Ini,Fin
Dim aTitolo,K
Dim Id,Metodo,nColpi,nNegativi,RuG
Dim filtroPari,filtroPariSto
Dim IniGioco,FinGioco,Es,Estrazioni,KK,C,PG,E,X
ReDim PrCi(90),TmP(90)
If ImpostaParametri(PEU,UEU,iF_E1,iP_E1,iR_E1,sE1,sF_E1,iF_E2,iP_E2,iR_E2,sE2,sF_E2,iF_E3,iP_E3,iR_E3,sE3,sF_E3,Ind_EspRic,Str_EspRic,nColpi,nNegativi,RuG) = False Then
MsgBox "I Parametri inseriti non sono corretti",vbCritical
Exit Sub
End If
EstrR = UEU
eE1 = Estratto(EstrR,iR_E1,iP_E1)
eE2 = Estratto(EstrR,iR_E2,iP_E2)
eE3 = Estratto(EstrR,iR_E3,iP_E3)
cF_E1 = CalcFunPar(iF_E1,eE1) ' questa funzione restituisce il valore finale dell'estratto
cF_E2 = CalcFunPar(iF_E2,eE2) ' questa funzione restituisce il valore finale dell'estratto
cF_E3 = CalcFunPar(iF_E3,eE3) ' questa funzione restituisce il valore finale dell'estratto
risultatoespressione = EseguiCalcolo(Ind_EspRic,cF_E1,cF_E2,cF_E3)
If risultatoespressione = 0 Then
MsgBox "la formula scelta Restituisce zero"
Exit Sub
End If
MsgBox DataEstrazione(EstrR) & "  ;   " & Str_EspRic & "   ;   " & cF_E1 & " , " & cF_E2 & " , " & cF_E3 & _
"          RangeRisultato= " & risultatoespressione
Ini = PEU
Fin = UEU
aTitolo = Array("","Estratto","CasiPos.")
InitTabella aTitolo,RGB(240,240,240),,3,vbBlack
Scrivi "Condizioni di Ricerca       :  ",1,,RGB(254,230,131)
Scrivi
'Scrivi DataEstrazione(EstrR) & "  ;   " & Str_EspRic & "   ;   " & cF_E1 & " , " & cF_E2 & " , " & cF_E3 & _
'"          RangeRisultato=    " & risultatoespressione
Scrivi "Data inizio ricerca         :  " & DataEstrazione(idEstr)
Scrivi "Data fine ricerca           :  " & DataEstrazione(EstrR)
Scrivi "Ultima condizione rilevata  :  " & DataEstrazione(EstrR)
Scrivi "Stringa espr. di ricerca    :  " & Str_EspRic
Scrivi "Valore estratti             :  " & cF_E1 & " , " & cF_E2 & " , " & cF_E3
Scrivi "Totale espr. di ricerca     :  " & risultatoespressione
Scrivi
Scrivi "Ruota di Gioco    :         :  " & Format2(RuG)
Scrivi "Colpi di Gioco    :         :  " & Format2(nColpi)
Scrivi "Max Casi Negativi :         :  " & Format2(nNegativi)
Scrivi
Scrivi "Estratti presenti nei casi  :  "
Scrivi
For idEstr = Ini To Fin
Messaggio "Sto Contando un Attimo Grazie :)" & casoTro
AvanzamentoElab Ini,Fin,idEstr
eE1 = Estratto(idEstr,iR_E1,iP_E1)
eE2 = Estratto(idEstr,iR_E2,iP_E2)
eE3 = Estratto(idEstr,iR_E3,iP_E3)
cF_E1 = CalcFunPar(iF_E1,eE1) ' questa funzione restituisce il valore finale dell'estratto
cF_E2 = CalcFunPar(iF_E2,eE2) ' questa funzione restituisce il valore finale dell'estratto
cF_E3 = CalcFunPar(iF_E3,eE3) ' questa funzione restituisce il valore finale dell'estratto
risultatoEspressioneSto = EseguiCalcolo(Ind_EspRic,cF_E1,cF_E2,cF_E3)
If risultatoEspressioneSto = risultatoespressione Then
casoTro = casoTro + 1
IniGioco = idEstr + 1
FinGioco = idEstr + nColpi
If EstrazioneAttivata(IniGioco) Then 'Controllo validità iniziale del cicl'
If EstrazioneAttivata(FinGioco) = False Then FinGioco = EstrazioneFin 'Controllo/limitazione lunghezza del ciclo.
KK = 0
ReDim TmP(90)
For C = IniGioco To FinGioco
KK = KK + 1
For PG = 1 To 5
E = Estratto(C,RuG,PG)
TmP(E) = True
Next
Next
Else
Exit For
End If
Scrivi Format2(casoTro) & ") ",1,False
For X = 1 To 90
If TmP(X) = True Then PrCi(X) = PrCi(X) + 1 : Scrivi Format2(X) & " ",True,False
Next
Scrivi
End If
Next
For X = 1 To 90
ReDim aRis(2)
Call alimentaArray(aRis,X,CInt(PrCi(X)))
If CInt(PrCi(X)) >= casoTro - nNegativi Then Call AddRigaTabella(aRis)
Next
Scrivi
Scrivi "Casi totali : " & casoTro
Scrivi
Scrivi
Call CreaTabellaOrdinabile
End Sub
Function ImpostaParametri(PEU,UEU,iF_E1,iP_E1,iR_E1,sE1,sF_E1,iF_E2,iP_E2,iR_E2,sE2,sF_E2,iF_E3,iP_E3,iR_E3,sE3,sF_E3,Ind_EspRic,Str_EspRic,nColpi,nNegativi,RuG)
Dim bRet
MsgBox "Sel Estrazione di ricerca,e, 3 EstrattiBase ",,"Metodo x calcolo Estratto semplice "
PEU = primaEstrazioneUtile(3914)
If PEU > 0 Then
UEU = UltimaEstrazioneUtile(3914)
If UEU > 0 Then
iF_E1 = IndFunPar
If iF_E1 > 0 Then
iP_E1 = ScegliPosizione
If iP_E1 > 0 Then
iR_E1 = ScegliRuota
If iR_E1 > 0 Then
sE1 = SiglaRuota(iR_E1) & iP_E1
sF_E1 = ScriviParametroCab(iF_E1,sE1)
iF_E2 = IndFunPar
If iF_E2 > 0 Then
iP_E2 = ScegliPosizione
If iP_E2 > 0 Then
iR_E2 = ScegliRuota
If iR_E2 > 0 Then
sE2 = SiglaRuota(iR_E2) & iP_E2
sF_E2 = ScriviParametroCab(iF_E2,sE2)
iF_E3 = IndFunPar
If iF_E3 > 0 Then
iP_E3 = ScegliPosizione
If iP_E3 > 0 Then
iR_E3 = ScegliRuota
If iR_E3 > 0 Then
sE3 = SiglaRuota(iR_E3) & iP_E3
sF_E3 = ScriviParametroCab(iF_E3,sE3)
Ind_EspRic = EspressioneDiRicerca(sF_E1,sF_E2,sF_E3)
Str_EspRic = scriviEspressioneDiRicerca(sF_E1,sF_E2,sF_E3,Ind_EspRic)
If Ind_EspRic > 0 Then
nColpi = QuantiColpi
If nColpi > 0 Then
nNegativi = QuantiNegativi
If nNegativi > 0 Then
MsgBox "Seleziona Ruota Di Ricerca                          ",,"Ruota Di Ricerca :" & SiglaRuota(iR_E1) & "-" & SiglaRuota(iR_E2) & "-" & SiglaRuota(iR_E3)
RuG = ScegliRuota
End If
End If
bRet = True
End If
End If
End If
End If
End If
End If
End If
End If
End If
End If
End If
End If
ImpostaParametri = bRet
End Function
Sub alimentaArray(aRis,k,Fre)
aRis(1) = k
aRis(2) = Fre
End Sub
Function ScegliPosizione
Dim aPos,Ris
aPos = Array("","1","2","3","4","5")
Ris = ScegliOpzioneMenu(aPos,1,"ScegliPosizione")
ScegliPosizione = Ris
End Function
Function IndFunPar
Dim Ris
Dim aParametro
aParametro = Array("","F90","Ddec","D45","Dif90","Sim91","Vert","Dec","Cad","Fig","C.Fig")
Ris = ScegliOpzioneMenu(aParametro,1,"SelezionaParametroEstratto")
IndFunPar = Ris
End Function
Function CalcFunPar(Ind_FunEstr,e_E1) 'indiceFunzioneParametroEstratto
Dim Ris
Dim aParametro(10)
aParametro(0) = 0
aParametro(1) = Fuori90(e_E1)
aParametro(2) = DiametraleD(e_E1)
aParametro(3) = Diametrale(e_E1)
aParametro(4) = ComplAdX(e_E1)
aParametro(5) = ComplAdX(e_E1,91)
aParametro(6) = Vert(e_E1)
aParametro(7) = Decina(e_E1)
aParametro(8) = Cadenza(e_E1)
aParametro(9) = Figura(e_E1)
aParametro(10) = ControFigura(e_E1)
Ris = aParametro(Ind_FunEstr)
CalcFunPar = Ris
End Function
Function ScriviParametroCab(Ind_Parametro,sE_1)
Dim Ris
Dim aParametro
aParametro = Array("","F90","Ddec","D45","Dif90","Sim91","Vert","Dec","Cad","Fig","C.Fig")
Ris = aParametro(Ind_Parametro) & "(" & sE_1 & ")"
ScriviParametroCab = Ris
End Function
Function EseguiCalcolo(Ind_StringaDiRic,ValFin_1,ValFin_2,ValFin_3)
Dim ris
Dim aOperazioni(18)
aOperazioni(0) = 0
aOperazioni(1) = Fuori90(ValFin_1 + ValFin_2 + ValFin_3)
aOperazioni(2) = Distanza(Fuori90(ValFin_1 + ValFin_2),ValFin_3)
aOperazioni(3) = Fuori90(ValFin_1 + Distanza(ValFin_2,ValFin_3))
aOperazioni(4) = Fuori90((ValFin_1 + ValFin_2)*ValFin_3)
aOperazioni(5) = Fuori90(ValFin_1 +(ValFin_2*ValFin_3))
aOperazioni(6) = Fuori90(Distanza(ValFin_1,ValFin_2) + ValFin_3)
aOperazioni(7) = Distanza(ValFin_1,Fuori90(ValFin_2 + ValFin_3))
aOperazioni(8) = Distanza(Distanza(ValFin_1,ValFin_2),ValFin_3)
aOperazioni(9) = Distanza(ValFin_1,Distanza(ValFin_2,ValFin_3))
aOperazioni(10) = Fuori90(Distanza(ValFin_1,ValFin_2)*ValFin_3)
aOperazioni(11) = Distanza(ValFin_1,Fuori90(ValFin_2*ValFin_3))
aOperazioni(12) = Fuori90((ValFin_1 * ValFin_2) + ValFin_3)
aOperazioni(13) = Fuori90(ValFin_1 *(ValFin_2 + ValFin_3))
aOperazioni(14) = Distanza(Fuori90(ValFin_1 * ValFin_2),ValFin_3)
aOperazioni(15) = Fuori90(ValFin_1 *Distanza(ValFin_2,ValFin_3))
aOperazioni(16) = Fuori90(ValFin_1 * ValFin_2 * ValFin_3)
aOperazioni(17) = Fuori90(Piramide(ValFin_1 & ValFin_2 & ValFin_3,,2))
aOperazioni(18) = Fuori90(ValFin_1 & ValFin_2 & ValFin_3)
ris = aOperazioni(Ind_StringaDiRic)
EseguiCalcolo = ris
End Function
Function EspressioneDiRicerca(sBase1,sBase2,sBase3)
Dim aOperatore,Ris
aOperatore = Array("",_
"(" & sBase1 & " + " & sBase2 & " + " & sBase3 & ")",_
"(" & sBase1 & " + " & sBase2 & ")- " & sBase3 & "",_
"" & sBase1 & " +(" & sBase2 & " - " & sBase3 & ")",_
"(" & sBase1 & " + " & sBase2 & ")* " & sBase3 & "",_
"" & sBase1 & " +(" & sBase2 & "* " & sBase3 & ")",_
"(" & sBase1 & " - " & sBase2 & ")+ " & sBase3 & "",_
"" & sBase1 & " -(" & sBase2 & " + " & sBase3 & ")",_
"(" & sBase1 & " - " & sBase2 & ")- " & sBase3 & "",_
"" & sBase1 & " -(" & sBase2 & " - " & sBase3 & ")",_
"(" & sBase1 & " - " & sBase2 & ")* " & sBase3 & "",_
"" & sBase1 & " -(" & sBase2 & " * " & sBase3 & ")",_
"(" & sBase1 & " * " & sBase2 & ")+ " & sBase3 & "",_
"" & sBase1 & " *(" & sBase2 & " + " & sBase3 & ")",_
"(" & sBase1 & " * " & sBase2 & ")- " & sBase3 & "",_
"" & sBase1 & " *(" & sBase2 & " - " & sBase3 & ")",_
"" & sBase1 & " * " & sBase2 & " * " & sBase3 & "",_
"Piramida(" & sBase1 & " ; " & sBase2 & " ; " & sBase3 & ")",_
"Unione(" & sBase1 & " ; " & sBase2 & " ; " & sBase3 & ")")
Ris = ScegliOpzioneMenu(aOperatore,1,"GetEspressioneDiRicerca")
EspressioneDiRicerca = Ris
End Function
Function scriviEspressioneDiRicerca(sBase1,sBase2,sBase3,Ind)
Dim aOperatore,Ris
aOperatore = Array("",_
"(" & sBase1 & " + " & sBase2 & " + " & sBase3 & ")",_
"(" & sBase1 & " + " & sBase2 & ")- " & sBase3 & "",_
"" & sBase1 & " +(" & sBase2 & " - " & sBase3 & ")",_
"(" & sBase1 & " + " & sBase2 & ")* " & sBase3 & "",_
"" & sBase1 & " +(" & sBase2 & "* " & sBase3 & ")",_
"(" & sBase1 & " - " & sBase2 & ")+ " & sBase3 & "",_
"" & sBase1 & " -(" & sBase2 & " + " & sBase3 & ")",_
"(" & sBase1 & " - " & sBase2 & ")- " & sBase3 & "",_
"" & sBase1 & " -(" & sBase2 & " - " & sBase3 & ")",_
"(" & sBase1 & " - " & sBase2 & ")* " & sBase3 & "",_
"" & sBase1 & " -(" & sBase2 & " * " & sBase3 & ")",_
"(" & sBase1 & " * " & sBase2 & ")+ " & sBase3 & "",_
"" & sBase1 & " *(" & sBase2 & " + " & sBase3 & ")",_
"(" & sBase1 & " * " & sBase2 & ")- " & sBase3 & "",_
"" & sBase1 & " *(" & sBase2 & " - " & sBase3 & ")",_
"" & sBase1 & " * " & sBase2 & " * " & sBase3 & "",_
"Piramida(" & sBase1 & " ; " & sBase2 & " ; " & sBase3 & ")",_
"Unione(" & sBase1 & " ; " & sBase2 & " ; " & sBase3 & ")")
Ris = aOperatore(Ind)
scriviEspressioneDiRicerca = Ris
End Function
Function UltimaEstrazioneUtile(nInizio)
Dim es,Inizio
ReDim aVoci(EstrazioneFin)
For es = nInizio To EstrazioneFin
aVoci(es) = DataEstrazione(es)
Next
Inizio = ScegliOpzioneMenu(aVoci,EstrazioneFin - 2,"Inserisci Data Ultima Analisi")
UltimaEstrazioneUtile = Inizio
End Function
Function primaEstrazioneUtile(nInizio)
Dim es,Inizio,Id
ReDim aVoci(EstrazioneFin)
For es = nInizio To EstrazioneFin
aVoci(es) = DataEstrazione(es)
Next
Id = EstrazioneFin - 1000
Inizio = ScegliOpzioneMenu(aVoci,Id,"Inserisci Data Inizio Analisi")
primaEstrazioneUtile = Inizio
End Function
Function QuantiColpi
Dim aVoci(15)
Dim i,bRet
For i = 1 To 15
aVoci(i) = i
Next
bRet = ScegliOpzioneMenu(aVoci,1,"SelezionaQuantiColpiEsaminare")
QuantiColpi = bRet
End Function
Function QuantiNegativi
Dim aVoci(15)
Dim i,bRet
For i = 1 To 15
aVoci(i) = i
Next
bRet = ScegliOpzioneMenu(aVoci,1,"SelezionaIlNumeroMassimoDiNegativi")
QuantiNegativi = bRet
End Function

nelson1331 · 26 Marzo 2015

Ciao I Legend, ho apportato alcune correzioni all' output. Alcune voci non sono riuscito ad identificarle, percio' ti chiedo di controllarle. Il software si presta bene ad ulteriori verifiche : percio' non demoralizzarti e non demordere. Se avrai la possibilita' di un contatto magari su skype, potremo individuare alcune eccellenti strategie di ricerca e collaborare in modo piu' costruttivo. Nelson

Alien. · 26 Marzo 2015

fillotto ha scritto:
Scarso interesse?? non credo proprio!!
Sono sconcertato nel constatare che i frequentatori sono attratti da pronostici belli e fatti e andare dietro a titoli quanto più fantasiosi possibile.
Vai avanti così ,molti ti seguono!!

Ciao,il prodotto è molto valido................a volte uno può essere geloso della sua creatura e può sabotare.....la ricerca.......pensare male si fa peccato ma molte volte ci si ----azzecca -------ahahahahah

i legend · 26 Marzo 2015

Ciao e grazie Fillotto

ciao Nelson ci sto lavorando, al momento non leggo il tuo script, perchè sto seguendo delle idee che mi sono venute e non vorrei fare confusione,
Ti assicuro che appena finisco lo leggo, magari sono le stesse idee

Ciao Alien

Sono per l'open soucre, stimo Luigi che ci ha regalato un bellissimo software, stimo Luigi perchè a molti di noi con molti ci è riuscito ha insegnato a fare piccoli programmi
(e ha tentato di farlo anche con con me

)
Stimo MiKe perchè è una persona generosissima,come Disaronno,Surmang,e tutti quelli che realizzano richieste e cercano di aiutare di insegnare al prossimo ricevendo in cambio un grazie

Stimo non ultimo Joe , che ritengo se posso permettermi mio maestro ,un maestro eccezionale ed una grande persona....
é Vero a pensare male ci si azzecca, ma se non ci si azzecca fa male.
Ho postato altri script molto più importanti e rilevanti di questo dal punto di vista statistico, realizzati sempre con l'ausilio dei miei amici del forum
Dico questo senza polemica,personalmente ti stimo.
Ciao

Con affetto I Legend

Script Presenza nei casi

Premium Member

Super Member >GOLD<

Premium Member

Super Member >GOLD<

Super Member >GOLD<

Premium Member

Premium Member

Super Member >GOLD<

Super Member >GOLD<

Super Member >GOLD<

Premium Member

Super Member >GOLD<

Super Member >GOLD<

Super Member >GOLD<

Premium Member

Advanced Member >PLATINUM<

Super Member >GOLD<

Super Member >GOLD<

Advanced Premium Member

Premium Member