Per salvo50 metodo ciclometrico da testare con scipt

Matematico · 27 Novembre 2018

Un saluto a salvo50 e a tutti,

Sarebbe utile a me e credo a molti studiosi di ciclometria uno script che vada a ricercare a ritroso fino al 1939 la stessa condizione ciclometrica con gli stessi numeri rilevati con una semplice quadratura di due ambi a distanza 45 anche non isotopi su due ruote qualsiasi ...TRAMITE UN IMPUT BOX DOVE INSERIRE I DUE AMBI DESIDERATI .
Porto un esempio recente chiaro:
BA-VE -15/11/2018

46+01= 21 somme diagonali
20+65= 21
---------------
66 66 42 42 somme orizzontali

Previsione :21-42-66 ambata,ambo (completo in terzine simmetriche i 3 numeri= con 51-81-12-72-06-36 x t/q

AL 4 COLPO 12-66-21 TERNO VE!!!!!!

salvo50 · 27 Novembre 2018

Ciao a Tutti
Ciao Matematico, come hai ottenuto il 42, le somme orizzontali sono 47 e 85

Matematico · 27 Novembre 2018

Ciao salvo50, non tengo conto delle due somme orizzontali che danno 47 e 85, ma solo quelle in diagonale che danno risultato uguale : 46+65=21 ///20+01= 21
e poi 21+21 = 42

salvo50 · 28 Novembre 2018

Matematico;n2141435 ha scritto:
Ciao salvo50, non tengo conto delle due somme orizzontali che danno 47 e 85, ma solo quelle in diagonale che danno risultato uguale : 46+65=21 ///20+01= 21
e poi 21+21 = 42

Ciao a Tutti.

Ok, ho fatto questa domanda perchè avevo letto somme orizzontali, mi serve un'altro chiarimento, si deve andare a ritroso fino al 1939 per vedere se si trovano gli stessi numeri, ma se non si trovano, la previsione è valida o no?

Matematico · 28 Novembre 2018

Ciao salvo50, la previsione è validissima , come vedi ha dato un terno...si deve andare a ritroso dal 1939 per vedere se si trovano gli stessi numeri ma è solo x una statistica ...ecco perchè chiedevo anche un imput box x inserire i due qualsiasi ambi di distanza 45 anche non isotopi.

salvo50 · 28 Novembre 2018

Ciao Matematico, per adesso ho fatto solo le previsioni e giocate, dato che la ricerca a ritroso non influisce sul fatto di giocare o no, farò un altro script con inserimento numeri tramite inputbox, però sul momento non ho idea di come fare, me lo devo studiare, anche perchè non basta dire si ci sono stati casi uguali, bisogna anche segnalarli e dire quali sono.

Codice:

'PROGETTO - METODO CICLOMETRICO - Chiesto da Matematico
'SCRIPT BY SALVO50
Option Explicit
Sub Main
   Dim FIn,Es,Clp1,Salvo50,Ini,E1,E2
   Dim R1,R2,P1,P2,P3,P4,P,PP,A,B,C,D
   Dim Dist1,Dist2,Caso,Casi
   Dim Sac,Sbd,Sad,Sbc,SSd,Clp2
   Dim DsdA,DsdB,DsdC,DadA,DadB
   Dim DadC,DacA,DacB,DacC,Poste(4)
   Dim Num1(3),Num2(9),Ruote(2),Posta(2)
   FIn = EstrazioneFin
   Ini = InputBox("Inserisci l'estrazione che vuoi iniziare",,9442)
   Clp1 = InputBox("Per quanti colpi vuoi giocare la terzina?",Salvo50,5)
   Clp2 = CInt(InputBox(" Per quanti colpi vuoi giocare la novina?",,5))
   Call ScegliRange(Ini,FIn,Ini,EstrazioneFin)
   Posta(1) = 1
   Posta(2) = 1
   Poste(3) = 1
   Poste(4) = 1
   For Es = Ini To FIn
      Messaggio Es
      AvanzamentoElab Ini,FIn,Es
      Caso = 0
      For R1 = 1 To 9
         For P1 = 1 To 4
            For P2 = P1 + 1 To 5
               A = Estratto(Es,R1,P1)
               B = Estratto(Es,R1,P2)
               Dist1 = Distanza(A,B)
               If Dist1 = 45 Then
                  For R2 = R1 + 1 To 10
                     For P3 = 1 To 4
                        For P4 = P3 + 1 To 5
                           C = Estratto(Es,R2,P3)
                           D = Estratto(Es,R2,P4)
                           Dist2 = Distanza(C,D)
                           If Dist2 = 45 Then
                              Sac = Fuori90(A + C) : Sbd = Fuori90(B + D) : Sad = Fuori90(A + D) : Sbc = Fuori90(B + C)
                              If Sac = Sbd And Sad = Sbc Then
                                 SSd = Fuori90(Sad + Sbc)
                                 If SSd <> Sad And SSd <> Sac And Sad <> Sac Then
                                    If SSd < 31 Then DsdA = SSd : DsdB = SSd + 30 : DsdC = SSd + 60
                                    If SSd > 30 And SSd < 61 Then DsdA = SSd - 30 : DsdB = SSd : DsdC = SSd + 30
                                    If SSd > 60 Then DsdA = SSd - 60 : DsdB = SSd - 30 : DsdC = SSd
                                    '
                                    If Sad < 31 Then DadA = Sad : DadB = Sad + 30 : DadC = Sad + 60
                                    If Sad > 30 And Sad < 61 Then DadA = Sad - 30 : DadB = Sad : DadC = Sad + 30
                                    If Sad > 60 Then DadA = Sad - 60 : DadB = Sad - 30 : DadC = Sad
                                    '
                                    If Sac < 31 Then DacA = Sac : DacB = Sac + 30 : DacC = Sac + 60
                                    If Sac > 30 And Sac < 61 Then DacA = Sac - 30 : DacB = Sac : DacC = Sac + 30
                                    If Sac > 60 Then DacA = Sac - 60 : DacB = Sac - 30 : DacC = Sac
                                    Caso = Caso + 1
                                    Casi = Casi + 1
                                    ColoreTesto 2
                                    Scrivi String(89,"*") & " Casi Totali " & FormattaStringa(Casi,"0000")
                                    ColoreTesto 1
                                    Scrivi String(80,"*") & " Estrazione " &(Es) & " caso " & FormattaStringa(Caso,"0000")
                                    ColoreTesto 0
                                    Scrivi(" Estrazione n." & Format2(Es) & " del " & DataEstrazione(Es)),1,0
                                    Scrivi "  " & SiglaRuota(R1) & " ",1,0
                                    For P = 1 To 5
                                       E1 = Estratto(Es,R1,P)
                                       If E1 = A Or E1 = B Then
                                          ColoreTesto 2
                                       Else
                                          ColoreTesto 0
                                       End If
                                       Scrivi Format2(E1) & " ",1,0
                                       ColoreTesto 0
                                    Next
                                    Scrivi " <-- Rossi con Distanza Ciclometrica " & Format2(Dist1),1
                                    'Scrivi
                                    Scrivi(" Estrazione n." & Format2(Es) & " del " & DataEstrazione(Es)),1,0
                                    Scrivi "  " & SiglaRuota(R2) & " ",1,0
                                    For PP = 1 To 5
                                       E2 = Estratto(Es,R2,PP)
                                       If E2 = C Or E2 = D Then
                                          ColoreTesto 2
                                       Else
                                          ColoreTesto 0
                                       End If
                                       Scrivi Format2(E2) & " ",1,0
                                       ColoreTesto 0
                                    Next
                                    Scrivi " <-- Rossi con Distanza Ciclometrica " & Format2(Dist2),1
                                    Scrivi "   Ambi  " & Space(9) & " Somme Vert." & Space(10) & " Somme Diag.",1
                                    Scrivi "  " & Format2(A) & Space(1) & Format2(B) & Space(16) & Format2(Sac) & Space(19) & Format2(Sad),1
                                    Scrivi "  " & Format2(C) & Space(1) & Format2(D) & Space(16) & Format2(Sbd) & Space(19) & Format2(Sbc),1
                                    Scrivi
                                    Scrivi " Le 3 Ambate ricavate dalle somme vert. e diag. " & Format2(SSd) & " " & Format2(Sad),1,0
                                    Scrivi " " & Format2(Sac),1
                                    Scrivi
                                    Scrivi " Le 3 Ambate più i rispettivi numeri delle terzine simmetriche    ",1,0
                                    ColoreTesto 2
                                    Scrivi Format2(DsdA) & " " & Format2(DsdB) & " " & Format2(DsdC) & "    ",1,0
                                    Scrivi Format2(DadA) & " " & Format2(DadB) & " " & Format2(DadC) & "    ",1,0
                                    Scrivi Format2(DacA) & " " & Format2(DacB) & " " & Format2(DacC),1 : ColoreTesto 0
                                    Scrivi
                                    Ruote(1) = R1
                                    Ruote(2) = R2
                                    Num1(1) = SSd : Num1(2) = Sad : Num1(3) = Sac
                                    ImpostaGiocata 1,Num1,Ruote,Posta,Clp1
                                    Num2(1) = DsdA : Num2(2) = DsdB : Num2(3) = DsdC
                                    Num2(4) = DadA : Num2(5) = DadB : Num2(6) = DadC
                                    Num2(7) = DacA : Num2(8) = DacB : Num2(9) = DacC
                                    ImpostaGiocata 2,Num2,Ruote,Poste,Clp2
                                    Gioca Es
                                 End If
                              End If
                           End If
                        Next
                     Next
                  Next
               End If
            Next
         Next
      Next
      If ScriptInterrotto Then Exit Sub
   Next
   ScriviResoconto
   Scrivi Space(52) & " PROGETTO - METODO CICLOMETRICO - Chiesto da Matematico"
   Scrivi Space(52) & "                 SCRIPT BY Salvo50"
End Sub

Matematico · 28 Novembre 2018

Ciao a tutti, un grazie1000 a salvo50 x lo script ....fare un altro script con inserimento numeri tramite inputbox, servirebbe proprio a vedere come si è comportata in passato la stessa condizione di gioco con gl istessi numeri ammesso che ci sia dal 1939 a oggi .....spero tu riesca a realizzarlo .

salvo50 · 29 Novembre 2018

Matematico;n2141549 ha scritto:
fare un altro script con inserimento numeri tramite inputbox, servirebbe proprio a vedere come si è comportata in passato la stessa condizione di gioco con gl istessi numeri ammesso che ci sia dal 1939 a oggi .....spero tu riesca a realizzarlo .

Ciao a Tutti.

Penso che questo tipo di script si debba impostare con le tabelle, allora qui ci vuole il mago delle tabelle Mike58, spero te lo faccia lui, perchè io non ci riesco

Mike58 · 29 Novembre 2018

Penso anch'io che la stessa condizione sia difficile da trovare altre volte anche se su l'intero range di tutte le estrazioni.
Questo lo deduco dalle prove fatte con il mio script e dai numeri rintracciati dallo script di Salvo.

Matematico (ciao) se trovi una condizione ripetuta altre volte, poi vediamo di completare lo script con i numeri in gioco altrimenti vale lo script di salvo con le estrazioni correnti.

Ciao

Codice:

Sub Main
   Dim ambo1(2),ambo2(2)
   Dim r1(1),r2(1)
   Ini = EstrazioneIni
   fin = EstrazioneFin
   For es = Ini To fin
      ambo1(1) = 9
      ambo1(2) = 54
      ambo2(1) = 90
      ambo2(2) = 45
      r1(1) = 1
      r2(1) = 5
      If VerificaEsito(ambo1,r1,es,2,1,,esito1,clp1,es1,id1) = True Then
         If VerificaEsito(ambo2,r2,es,2,1,,esito2,clp2,es2,id2) = True Then
            Scrivi GetInfoEstrazione(es) & vbTab,0,0
            Scrivi StringaNumeri(ambo1,,1) & vbTab & StringaNumeri(ambo2,,1) & vbTab,0,0
            Scrivi StringaRuote(r1) & "." & StringaRuote(r2) & vbTab,0,0
            Scrivi es1 & vbTab & es2
         End If
      End If
   Next
End Sub

salvo50 · 29 Novembre 2018

Ciao Mike.

Grazie, una buona base di partenza.

Matematico · 29 Novembre 2018

Ciao Mike58 e salvo50,sempre grazie x la vostra disponibilità

Riportando l'esempio ad inizio post:
BA-VE -15/11/2018

46+01= 21 somme diagonali
20+65= 21
---------------
66 66 42 42 somme orizzontali

Previsione :21-42-66 ambata,ambo (completo in terzine simmetriche i 3 numeri= con 51-81-12-72-06-36 x t/q
----------------------------------------------------------------------------------------------------------------------------------------------------------------------

Facendo girare il listato trovo la stessa condizione anche se non isotopa e su ruote diverse il :
[07475] [ 71] 09.08.2005 46.01 20.65 BA.GE BA .. 46 .. .. 01 GE .. 20 65 .. .. Non mi ero spiegato bene, intendevo la ricerca anche su ruote diverse ( a tutte).

salvo50 · 30 Novembre 2018

Ciao a Tutti.

Per ruote anche diverse qualche doppione c'è, ho messo nello script di Mike di cercare solo per tutte le ruote, avevo anche messo l'inserzione degli ambi tramite inputbox, ma inspiegabilmente mi luppa negli inputbox, cioè finito di inserire i 4 numeri mi richiede di nuovo di inserirli all'infinito, quindi l'ho tolto, come ha detto Mike si può migliorare, diciamo che questo è un abbozzo

Sub Main
Dim ambo1(2),ambo2(2)
Dim r1(1),r2(1)
Ini = EstrazioneIni
fin = EstrazioneFin
For es = Ini To fin
ambo1(1) = 9
ambo1(2) = 54
ambo2(1) = 90
ambo2(2) = 45
r1(1) = TU_

If VerificaEsito(ambo1,r1,es,2,1,,esito1,clp1,es1,id1) = True Then
If VerificaEsito(ambo2,r1,es,2,1,,esito2,clp2,es2,id2) = True Then
Scrivi GetInfoEstrazione(es) & vbTab,0,0
Scrivi StringaNumeri(ambo1,,1) & vbTab & StringaNumeri(ambo2,,1) & vbTab,0,0
Scrivi StringaRuote(r1) & "." & StringaRuote(r1) & vbTab,0,0
Scrivi es1 & vbTab & es2
End If
End If
Next
End Sub

Mike58 · 30 Novembre 2018

Ciao Salvo , forse gli input box li devi mettere fuori dal ciclo for altrimenti è chiaro che ti luppa per tutto il ciclo for.

Chiaro per Matematico che la ricerca era per quella condizione e sulle stesse ruote ma se poi vuole vederle su altre ruote il discorso è poi anche diverso.
Comunque anche cosi può fare la verifica almeno della condizione.

Codice:

Sub Main
Dim ambo1(2),ambo2(2)
Dim r1(1),r2(1)
Ini = EstrazioneIni
fin = EstrazioneFin
a = InputBox("1 Numero ambo1",,9)
b = InputBox("2 Numero ambo1",,54)
c = InputBox("1 Numero ambo2",,90)
d = InputBox("2 Numero ambo2",,45)
For es = Ini To fin
ambo1(1) = a
ambo1(2) = b
ambo2(1) = c
ambo2(2) = d
r1(1) = TU_

If VerificaEsito(ambo1,r1,es,2,1,,esito1,clp1,es1,id1 ) = True Then
If VerificaEsito(ambo2,r1,es,2,1,,esito2,clp2,es2,id2 ) = True Then
Scrivi GetInfoEstrazione(es) & vbTab,0,0
Scrivi StringaNumeri(ambo1,,1) & vbTab & StringaNumeri(ambo2,,1) & vbTab,0,0
Scrivi StringaRuote(r1) & "." & StringaRuote(r1) & vbTab,0,0
Scrivi es1 & vbTab & es2
End If
End If
Next
End Sub

Matematico · 30 Novembre 2018

Un grazie immnenso ad entrambi , meglio di cosi non si poteva fare...è perfetto!Penso che lo script possa servire a tutti gli amanti delle quadrature ciclometriche e varie formule x verificare i loro pronostici.
Un saluto a tutti!

salvo50 · 30 Novembre 2018

Mike58;n2141827 ha scritto:
Ciao Salvo , forse gli input box li devi mettere fuori dal ciclo for altrimenti è chiaro che ti luppa per tutto il ciclo for.

Ciao Matematico,
Ciao Mike, hai ragione è la prima volta che faccio un errore del genere, ma quello che è più grave è che non ci sono arrivato da solo.

Ho fatto anche l'inserimento degli ambi in automatico, ma va in errore (13 - type mismatch ) ti posto lo script, anche qui non riesco a capire il perchè mi dà quest'errore. Puoi dare un'occhiata per favore.

Ho corretto L'errore con l'aiuto di Mike

Codice:

Option Explicit
Sub Main
   Dim FIn,Es,Clp1,Salvo50,Ini,E1,E2
   Dim R1,R2,P1,P2,P3,P4,P,PP,A,B,C,D
   Dim Dist1,Dist2,Casi,Clp2
   Dim Es1,Es2,Id1,Id2,Esito1,Esito2
   Dim Ambo1(2),Ambo2(2),Ru1(1),Ru2(1)
   FIn = EstrazioneFin
   Ini = InputBox("Inserisci l'estrazione che vuoi iniziare",,9000)
   Call ScegliRange(Ini,FIn,Ini,EstrazioneFin)
   For Es = Ini To FIn
      Messaggio Es
      AvanzamentoElab Ini,FIn,Es
      For R1 = 1 To 9
         For P1 = 1 To 4
            For P2 = P1 + 1 To 5
               A = Estratto(Es,R1,P1)
               B = Estratto(Es,R1,P2)
               Dist1 = Distanza(A,B)
               If Dist1 = 45 Then
                  For R2 = R1 + 1 To 10
                     For P3 = 1 To 4
                        For P4 = P3 + 1 To 5
                           C = Estratto(Es,R2,P3)
                           D = Estratto(Es,R2,P4)
                           Dist2 = Distanza(C,D)
                           If Dist2 = 45 Then
                              Ambo1(1) = A : Ambo1(2) = B : Ambo2(1) = C : Ambo2(2) = D
                              Ru1(1) = TT_ : Ru2(1) = TT_
                              If VerificaEsito(Ambo1,Ru1,Es,2,1,,Esito1,Clp1,Es1,Id1) = True Then
                                 If VerificaEsito(Ambo2,Ru2,Es,2,1,,Esito2,Clp2,Es2,Id2) = True Then

                                    Scrivi GetInfoEstrazione(Es) & vbTab,0,0
                                    Scrivi StringaNumeri(Ambo1,,1) & vbTab & StringaNumeri(Ambo2,,1) & vbTab,0,0
                                    Scrivi SiglaRuota(R1) & "." & SiglaRuota(R2) & vbTab,0,0
                                    Scrivi Es1 & vbTab & Es2
                                 End If
                              End If
                           End If
                        Next
                     Next
                  Next
               End If
            Next
         Next
      Next
      If ScriptInterrotto Then Exit Sub
   Next
End Sub

Mike58 · 30 Novembre 2018

Ciao Salvo L'errore è banale StringaRuote vuole il vettore Ruote (infatti può contenere + ruote) e non la variabile.

sostituisci la riga con siglaruote.

Ecco perché io non uso Option Explicit e dichiarare tutto , per non confondermi con le Variabili Vettori.

Codice:

Option Explicit
Sub Main
   Dim FIn,Es,Clp1,Salvo50,Ini,E1,E2
   Dim R1,R2,P1,P2,P3,P4,P,PP,A,B,C,D
   Dim Dist1,Dist2,Casi,Clp2
   Dim Es1,Es2,Id1,Id2,Esito1,Esito2
   Dim Ambo1(2),Ambo2(2),Ru1(1),Ru2(1)
   FIn = EstrazioneFin
   Ini = InputBox("Inserisci l'estrazione che vuoi iniziare",,9552)
   Call ScegliRange(Ini,FIn,Ini,EstrazioneFin)
   For Es = Ini To FIn
      Messaggio Es
      AvanzamentoElab Ini,FIn,Es
      For R1 = 1 To 9
         For P1 = 1 To 4
            For P2 = P1 + 1 To 5
               A = Estratto(Es,R1,P1)
               B = Estratto(Es,R1,P2)
               Dist1 = Distanza(A,B)
               If Dist1 = 45 Then
                  For R2 = R1 + 1 To 10
                     For P3 = 1 To 4
                        For P4 = P3 + 1 To 5
                           C = Estratto(Es,R2,P3)
                           D = Estratto(Es,R2,P4)
                           Dist2 = Distanza(C,D)
                           If Dist2 = 45 Then
                              Ambo1(1) = A : Ambo1(2) = B : Ambo2(1) = C : Ambo2(2) = D
                              Ru1(1) = TT_ : Ru2(1) = TT_
                              If VerificaEsito(Ambo1,Ru1,Es,2,1,,Esito1,Clp1,Es1,Id1) = True Then
                                 If VerificaEsito(Ambo2,Ru2,Es,2,1,,Esito2,Clp2,Es2,Id2) = True Then
                                    Casi = Casi + 1
                                    ColoreTesto 2
                                    Scrivi String(119,"*") & " Caso " & FormattaStringa(Casi,"0000")
                                    ColoreTesto 0
                                    Scrivi GetInfoEstrazione(Es) & vbTab,0,0
                                    Scrivi StringaNumeri(Ambo1,,1) & vbTab & StringaNumeri(Ambo2,,1) & vbTab,0,0
                                    'Scrivi StringaRuote(R1) & "." & StringaRuote(R2) & vbTab,0,0
                                    Scrivi SiglaRuota(R1) & "." & SiglaRuota(R2) & vbTab,0,0
                                    Scrivi Es1 & vbTab & Es2 
                                 End If
                              End If
                           End If
                        Next
                     Next
                  Next
               End If
            Next
         Next
      Next
      If ScriptInterrotto Then Exit Sub
   Next

End Sub

salvo50 · 30 Novembre 2018

Grazie mille

franca46 · 1 Dicembre 2018

buongiorno Matematico , non so più dove stazioni , per cui ti lascio qui gli auguri

Matematico · 2 Dicembre 2018

Grazie di cuore franca46 , che carina che sei stata a ricordartelo

....ci si sente via mail cara. Buona serata a te e a tutti.

Per salvo50 metodo ciclometrico da testare con scipt

Advanced Member >PLATINUM<

Advanced Member >PLATINUM PLUS<

Advanced Member >PLATINUM<

Advanced Member >PLATINUM PLUS<

Advanced Member >PLATINUM<

Advanced Member >PLATINUM PLUS<

Advanced Member >PLATINUM<

Advanced Member >PLATINUM PLUS<

Advanced Member >PLATINUM PLUS<

Advanced Member >PLATINUM PLUS<

Advanced Member >PLATINUM<

Advanced Member >PLATINUM PLUS<

Advanced Member >PLATINUM PLUS<

Advanced Member >PLATINUM<

Advanced Member >PLATINUM PLUS<

Advanced Member >PLATINUM PLUS<

Advanced Member >PLATINUM PLUS<

Advanced Member >PLATINUM PLUS<

Advanced Member >PLATINUM<