Richiesta script

[arcor]

Buongiorno a tutti volevo domandare agli scripter se possono farmi uno script che rileva ad ogni estrazione se ci sono due terni uguali anche a posizioni invertite di uscita.l'importante che siano 3 numeri uguali su due ruote.grazie

 

[Mike58]

Arcor script già pronto e realizzato per altro scopo, provalo e se poi lo scopo può essere definito potrei anche metterci mano per lo scopo specifico.


Ciao

Sub Main
 Dim nu(3),ru(1),ru1(1),nn(6),ruo(2),posta(3)
 posta(2) = 1.5
 posta(3) = .5
 ad = CInt(InputBox("QUANTE ESTRAZIONI ANALIZZO ","Mike58",600))
 Ini = EstrazioneFin - ad
 fin = EstrazioneFin
 Scrivi Space(5) & "Info Estrazione" & Space(27) & "Terni Estratti" & Space(15) & "Rit,Att   RitCro  RitAmbo  freqAmbo " & Space(6) & "Numeri e verifica in colpi 20 x Ambo",1
 Scrivi String(160,"="),1
 For es = Ini To fin
  For r = 1 To 9
   For p1 = 1 To 3
    For p2 = p1 + 1 To 4
     For p3 = p2 + 1 To 5
      a = Estratto(es,r,p1)
      b = Estratto(es,r,p2)
      c = Estratto(es,r,p3)
      If a <> b And b <> c Then

       nu(1) = a
       nu(2) = b
       nu(3) = c
       ru1(1) = r
       For r2 = r + 1 To 10

         ru(1) = r2
         ruo(1) = r
         ruo(2) = r2

         If VerificaEsito(nu,ru1,es,3,1,,esitoT,,estrattiT,IdT) = True Then
          If VerificaEsito(nu,ru,es,3,1,,esitoA,,estrattiA,IdA) = True Then
          Call Messaggio("Elaboro Estrazioni . . . . .  A T T E N D E R E . . . . " & es)
          Call AvanzamentoElab(Ini,fin,es)
         k1 = k1 + 1
          rtt = SerieRitardo(es + 1,fin,nu,ruo,3)
          rta = SerieRitardo(es + 1,fin,nu,ruo,2)
          fra = SerieFreq(es + 1,fin,nu,ruo,2)


            Scrivi GetInfoEstrazione(es) & vbTab,0,0

            Scrivi estrattiT & vbTab & EstrattiA & vbTab,0,0
            Scrivi rtt & vbTab & fin - es & vbTab & rta & vbTab & fra & vbTab,0,0
           Scrivi StringaNumeri(nu,,1) & vbTab,1,0
            'ReDim rt(10)
            'For rr = 1 To 10
             'rt(rr) = rr
             Call VerificaEsitoConGuadagno(nu,ruo,es + 1,2,100,,esito,colpi,estratti,id,,guad)
             If esito <> "" Then k2 = k2 + 1
            'Next
            If esito <> "" Then
            Scrivi estratti & vbTab,0,0
            Scrivi colpi'
            Else
            Scrivi ".................       " & colpi
            End If
            ImpostaGiocata 1,nu,ruo,posta,40,2
            Gioca es,1,,1,,False

         End If
        End If
       Next
      End If
     Next
    Next
   Next
  Next
 Next
 Scrivi
 Scrivi "Estrazioni analizzate..... " & fin - Ini,1
 Scrivi "Casi Positivi....... " & k2
 Scrivi "Casi Esaminati...... " & k1
 Scrivi " Script By Mike58  ",1,1,,1,2,,1
 ScriviResoconto
End Sub

 

[joe]

Ciao Arcor.

E' un pò spartano, ma sembra funzionare.

Option Explicit
Sub Main
'Terni BiValenti By Joe V.2.0 del 04/05/2017
Dim Ini,Fin,Es,R
Dim A,B,C,D,E,Nu(3),Ru(11)
For R = 1 To 10 :Ru(R) = R : Next : Ru(11) = 12
Ini = 7440 : Fin = EstrazioneFin
For Es = Ini To Fin : D = False
For R = 1 To 12 : If R = 11 Then R = 12
AvanzamentoElab Ini,Fin,Es
For A = 1 To 3 : Nu(1) = Estratto(Es,R,A)
For B = A + 1 To 4 : Nu(2) = Estratto(Es,R,B)
For C = B + 1 To 5 : Nu(3) = Estratto(Es,R,C)
If SerieFreq(Es,Es,Nu,Ru,3) > 1 Then
D = True : E = E + 1
OrdinaMatrice Nu,False
Scrivi Es & "  " & DataEstrazione(Es) & "  " & StringaNumeri(Nu,,True) & "  " & SiglaRuota(R)
End If
Next
Next
Next
Next
If D = True Then Scrivi String(30,"-") & FormatSpace(E/2,4,True),True
Next
End Sub

ATTENZIONE:

Questo script è stato modificato per correggere

gli errori che erano presenti nella versione precedente,

in ottemperanza a quanto ipotizzato ed emerso nei messaggi a seguire.

 

[joe]

Ops ...

Mike, mi ha driblato.

 

[Mike58]

Ciao Joe,due e meglio di one.

 

[arcor]

grazie mike e joe vanno benissimo tutti e due.mike al momento non posso dirti nulla perché la previsione viene ricavata da un applicativo molto vecchio e appunto volevo verificare a ritroso che esiti ha dato.in pratica inserendo il primo terno estratto ricava la previsione con un altro terno da giocare x 12 colpi sulle 2 ruote x ambo/terno.farò i controlli penso dal 2000 ad oggi e poi ti dirò se è ancora valido o no.sono molto curioso per il semplice fatto che inserendo stamattina un doppio terno uscito tempo fa ha dato terno secco su ruota al 6 colpo.penso sia il solito caso fortunato che conferma la regola...vedremo.ciao

 

[salvo50]

Mi piacciono gli script spartani, non capisco la funzione di D, non interviene in nessun calcolo, eppure serve, infatti l'ho tolto e non ha funzionato più niente.

 

[joe]

Ciao Salvo.

"D" serve "solo a distanziare" le varie terne separandole di estrazione in estrazione.

Di per sè, potrebbe essere tolto completamente dallo script,

senza alterarne il funzionamento.

Tranne per il fatto che i vari casi, poi, sarebbero elencati tutti uno appresso all'altro.

Tuttavia, "D" è un trucco per evitare un mucchio di calcoli.

Cioè quelli per trovare e poi elencare, sia la seconda ruota, che i 3 numeri ripetuti.

Dunque, con questo artificio, lo script è veloce ed il suo otuput è di facile lettura.

Anche scrivendo poco codice.

 

[i legend]

ciao a Tutti
ho provato anche io a fare uno script ma i risultati sono diversi
ora ho l archivio dell ultima versione di spaziometrie
se qualcuno volesse fare un confronto per confermare o smentire i dati

Option Explicit
'Test Ripetizioni Formazione
'Da Verificare
Sub Main
    Dim IdEstr
    Dim Ini:Ini = 3950
    Dim Fin:Fin = EstrazioneFin
    Dim fR,Tro,k,i,nRip
    nRip = GetnRip
    Dim R1,R2
    For IdEstr = Ini To Fin
        k = k + 1
        If IdEstr > 7439 Then fR = 10 :Else fR = 9
        For R1 = 1 To fR
            For R2 = R1 + 1 To fR + 1
                If R2 = 11 Then R2 = 12
                ReDim aMat1(0)
                Call GetArrayNumeriRuota(IdEstr,R1,aMat1)
                ReDim aMat2(0)
                Call GetArrayNumeriRuota(IdEstr,R2,aMat2)
                If PuntiSuArray(aMat1,aMat2) = nRip Then
                    ReDim aNum(10)
                    i = 0
                    For i = 1 To 5
                        aNum(i) = aMat1(i)
                        aNum(i + 5) = aMat2(i)
                    Next
                    ReDim aRip(0)
                    Call NumeriRipetutiRilevatiV(aNum,aRip)
                    Tro = Tro + 1
                    Scrivi FormatSpace(Tro,4,1) & Space(3) & FormatSpace(IdEstr,5,1) & Space(3) & SiglaRuota(R1) & _
                    Space(3) & SiglaRuota(R2) & Space(3) & "(" & StringaNumeri(aRip,,True) & ")"
                End If
            Next
        Next
        Call AvanzamentoElab(1,Fin - Ini,k)
    Next
End Sub
Function GetnRip
    Dim aV:aV = Array(2,3,4,5)
    GetnRip = ScegliOpzioneMenu(aV,0,"SelSorteRipetuti") + 2
End Function

 

[joe]

Ciao Ilegend.

E' più giusto il tuo script che riesce a trovare qualche riscontro per la Nazionale.

Il mio è da rivedere pertanto ho cancellato il vecchio script e chiedo cortesemente

anche a Salvo di cancellare la citazione. (per evitare di lasciare in giro uno script malfunzionante.)

Domani posterò la versione aggiornata.

Purtroppo avevo dimenticato dell' "incompatibilità" di alcune istruzioni,

con alcune scorciatoie che avevo adottato,

e che avevano evidenziato "nemmeno un caso per la Nazionale".

Detto fatto, se ci può essere un errore ... c'è.

Non può essere che il costo delle giocate non raddoppi!

 

[salvo50]

Ciao!

Va bene, I Leggend, ho messo nel tuo l'inizio INI uguale a quello di Joe 7440 ed i terni corrispondono

Per Joe, fatto l'ho tolto, però a me piace e lo tengo per studiarlo.

 

[i legend]

ciao joe grazie
attendiamo il tuo cosi posso comparare l archivio
ciao

Sub GetRuote(Ru)
    Dim R,i
i=0
    For R = 1 To 11
        i = i + 1
        If R = 11 Then R = 12
        Ru(i) = R
    Next
End Sub

caricando le ruote con la sub le due routine sembrano avere lo stesso risultato
magari se puoi confermare
Ciao

 

[i legend]

Ciao Salvo
le due routine non collimano
forse caricando le ruote Con la sub sopra potrebbe dare il risultato medesimo , ma aspettiamo joe per avere conferma...
gli script di joe sono utilissimi per lo studio, da studente a studente
ciao

 

[i legend]

un altra cosa cosi lo script elabora solo una corrispondenza esatta es: se esce la quaterna ripetuta il terno non viene conteggiato
basta sostituire = con >=
ciao

 

[joe]

Buon giorno a tutte/i.

Ho inserito lo script, riveduto e corretto, al messaggio #3.