Script su metodi di Fabarri
- Creatore Discussione salvo50
- Data di inizio
salvo50
Advanced Member >PLATINUM PLUS<
Ciao a Tutti!
Faccio un elenco di tutti gli script finora postati in questo topic, in ordine di inserimento.
IL QUADRATO ARMONICO
LA MASSIMA ARMONIA QUADRATICA
IL COEFFICIENTE MEDIO INTEGRATORE
IL TRIANGOLO ISCRITTO
NUOVA FORMULA PROPORZIONALE
IL QUADRATO A DIAGONALE FISSA
IL PUNTO DIAMETRALE
LA STRUTTURA DEI NUMERI
PROCEDIMENTO EINS-FAB
Faccio un elenco di tutti gli script finora postati in questo topic, in ordine di inserimento.
IL QUADRATO ARMONICO
LA MASSIMA ARMONIA QUADRATICA
IL COEFFICIENTE MEDIO INTEGRATORE
IL TRIANGOLO ISCRITTO
NUOVA FORMULA PROPORZIONALE
IL QUADRATO A DIAGONALE FISSA
IL PUNTO DIAMETRALE
LA STRUTTURA DEI NUMERI
PROCEDIMENTO EINS-FAB
salvo50
Advanced Member >PLATINUM PLUS<
IL PROCEDIMENTO S.91
Codice:
'PROGETTO - IL PROCEDIMENTO S.91 - BY FABARRI
'SCRIPT BY SALVO50
Option Explicit
Sub Main
Dim fin,es,esq,clp,col,esqcol,idestr,clp2
Dim posta(2),ruote(3),ambo1(2),ambo2(2),ruota(2)
Dim p1,p2,p3,p4,r1,r2,caso,casi,quat(4),poste(4)
Dim estra,estrb,estrc,estrd,somma1,somma2
fin = EstrazioneFin
esq = InputBox("Inserisci l'estrazione che vuoi iniziare",idestr,9313)
clp = InputBox("Per quanti colpi vuoi giocare l'ambo?",,7)
clp2 = InputBox("Per quanti colpi vuoi giocare la quartina?",,8)
col = CInt(InputBox(" Quante estrazioni vuoi controllare ",,10))
'posta(1) = 1
posta(2) = 1
poste(2) = 1
poste(3) = 1
'poste(4) = 1
esqcol = esq + col
If esqcol > fin Then esqcol = fin
For es = esq To esqcol
Messaggio es
AvanzamentoElab esq,esqcol,es
caso = 0
For r1 = 1 To 9
For p1 = 1 To 4
p2 = p1 + 1
estra = Estratto(es,r1,p1)
estrb = Estratto(es,r1,p2)
somma1 = Fuori90(estra + estrb)
For r2 = r1 + 1 To 10
For p3 = 1 To 4
p4 = p3 + 1
estrc = Estratto(es,r2,p3)
estrd = Estratto(es,r2,p4)
somma2 = Fuori90(estrc + estrd)
If(somma1 + somma2) = 91 Then
caso = caso + 1
casi = casi + 1
ColoreTesto 1
Scrivi String(89,"o") & " Casi Totali " & FormattaStringa(casi,"0000")
ColoreTesto 2
Scrivi String(80,"o") & " Estrazione " &(es) & " caso " & FormattaStringa(caso,"0000")
ColoreTesto 0
Scrivi(" Estrazione n." & Format2(es) & " del " & DataEstrazione(es)),0,0
Scrivi " " & Left(NomeRuota(r1),2) & " " & StringaEstratti(es,r1),2
Scrivi Space(35) & Left(NomeRuota(r2),2) & " " & StringaEstratti(es,r2),2
Scrivi
ColoreTesto 1
Scrivi " Coppia consecutiva ruota " & Left(NomeRuota(r1),2) & " " & Format2(estra) & Space(1) & Format2(estrb)
ColoreTesto 2
Scrivi " Coppia consecutiva ruota " & Left(NomeRuota(r2),2) & " " & Format2(estrc) & Space(1) & Format2(estrd)
ColoreTesto 0
Scrivi
ruota(1) = r1
ruota(2) = r2
ruote(1) = r1
ruote(2) = r2
ruote(3) = TU_
ambo1(1) = estra
ambo1(2) = estrb
ImpostaGiocata 1,ambo1,ruote,posta,clp
ambo2(1) = estrc
ambo2(2) = estrd
ImpostaGiocata 2,ambo2,ruote,posta,clp
quat(1) = estra
quat(2) = estrb
quat(3) = estrc
quat(4) = estrd
EliminaRipetuti quat
ImpostaGiocata 3,quat,ruota,poste,clp2
Gioca es
End If
Next
Next
Next
Next
Next
ScriviResoconto
End Sub
Ultima modifica:
salvo50
Advanced Member >PLATINUM PLUS<
L'AMBO SECCO SULLA RUOTA: I VALORI 1-44 - quasi alias - PROCEDIMENTO DISTICON
Per questo metodo ho messo quasi alias, un altro metodo perche sono quasi uguali, cambia solo la regola n8, infatti i primi due esempi negli articoli sono uguali, con la regola n4 in tutti e due cambia il procedimento, quindi per ogni metodo devo fare 2 script, la regola n8 nel PROCEDIMENTO DISTICON recita la ricerca contemporanea di 7 numeri, quindi dato che nell'altro metodo la regola n8 cambia, non c'è la ricerca dei 7 numeri, poi la regola n8 dice di modificare ancora il tipo di ricerca, ecco il perchè dei 4 script.
Un ringraziamento va a Joe che mi ha dato le dritte per l'eliminazione degli ambi doppi.
Per questo metodo ho messo quasi alias, un altro metodo perche sono quasi uguali, cambia solo la regola n8, infatti i primi due esempi negli articoli sono uguali, con la regola n4 in tutti e due cambia il procedimento, quindi per ogni metodo devo fare 2 script, la regola n8 nel PROCEDIMENTO DISTICON recita la ricerca contemporanea di 7 numeri, quindi dato che nell'altro metodo la regola n8 cambia, non c'è la ricerca dei 7 numeri, poi la regola n8 dice di modificare ancora il tipo di ricerca, ecco il perchè dei 4 script.
Un ringraziamento va a Joe che mi ha dato le dritte per l'eliminazione degli ambi doppi.
Ultima modifica:
salvo50
Advanced Member >PLATINUM PLUS<
L'AMBO SECCO SULLA RUOTA: I VALORI 1-44 (senza regola n4)
L'AMBO SECCO SULLA RUOTA: I VALORI 1-44 (con regola n4)
Codice:
'PROGETTO - L'AMBO SECCO SULLA RUOTA: I VALORI 1-44 (senza regola 4)- BY FABARRI
'SCRIPT BY SALVO50
Option Explicit
Sub Main
Dim fin,es,esq,clp,col,esqcol,idestr
Dim posta(2),ruote(3),ruota(1),poste(5)
Dim p1,p2,p3,p4,r1,r2,caso,casi
Dim estra,estrb,estrc,estrd,X
Dim d1,d2,d3,d4,d5,s1,s2,s3,s4,di1,es2,num(2)
ReDim Xnum(10)
fin = EstrazioneFin
esq = InputBox("Inserisci l'estrazione che vuoi iniziare",idestr,9300)
clp = InputBox("Per quanti colpi vuoi giocare l'ambata?",,7)
col = CInt(InputBox(" Quante estrazioni vuoi controllare ",,0))
'posta(1) = 1
posta(2) = 1
poste(2) = 1
'poste(3) = 1
'poste(4) = 1
'poste(5) = 1
esqcol = esq + col
If esqcol > fin Then esqcol = fin
For es = esq To esqcol
Messaggio es
AvanzamentoElab esq,esqcol,es
caso = 0
For es2 = es To(es - 3) Step - 1
For r1 = 1 To 9
For p1 = 1 To 4
p2 = p1 + 1
estra = Estratto(es,r1,p1)
estrb = Estratto(es,r1,p2)
d1 = Distanza(estra,estrb)
s1 = d1 + estra
s2 = d1 + estrb
If s1 < 45 Or s2 < 45 Then
If s1 < 45 Then d2 = s1
If s2 < 45 Then d2 = s2
For r2 = 1 To 10
For p3 = 1 To 4
For p4 = p3 + 1 To 5
estrc = Estratto(es2,r2,p3)
estrd = Estratto(es2,r2,p4)
d3 = Distanza(estrc,estrd)
If d2 = d3 Then
di1 = Differenza(d1,d3)
If di1 =(estra) Or di1 =(estrb) Or di1 =(estrc) Or di1 =(estrd) Then
If di1 = estrc Or di1 = estrd Then ruota(1) = r2
If di1 = estra Or di1 = estrb Then ruota(1) = r1
s3 = Fuori90(estra + estrb)
s4 = Fuori90(estrc + estrd)
d4 = Distanza(estra,estrd)
d5 = Distanza(estrb,estrc)
caso = caso + 1
casi = casi + 1
ColoreTesto 1
Scrivi String(89,"o") & " Casi Totali " & FormattaStringa(casi,"0000")
ColoreTesto 2
Scrivi String(80,"o") & " Estrazione " &(es) & " caso " & FormattaStringa(caso,"0000")
ColoreTesto 0
Scrivi
ColoreTesto 1
Scrivi(" Estrazione n." & Format2(es) & " del " & DataEstrazione(es)),0,0
Scrivi " " & Left(NomeRuota(r1),2) & " " & StringaEstratti(es,r1),2
ColoreTesto 2
Scrivi(" Estrazione n." & Format2(es2) & " del " & DataEstrazione(es2)),0,0
Scrivi " " & Left(NomeRuota(r2),2) & " " & StringaEstratti(es2,r2),2
ColoreTesto 0
Scrivi
ColoreTesto 2
Scrivi Space(35) & Left(NomeRuota(r2),2) & " " & Format2(estrc) & " " & Format2(estrd),0,0
Scrivi "|" & Format2(d3) & "|" & Format2(s4) & Space(5),0,0
ColoreTesto 0
Scrivi Format2(d4),2
ColoreTesto 1
Scrivi Space(35) & Left(NomeRuota(r1),2) & " " & Format2(estra) & " " & Format2(estrb),0,0
Scrivi "|" & Format2(d1) & "|" & Format2(s3) & Space(5),0,0
ColoreTesto 0
Scrivi Format2(d5),2
ColoreTesto 0
Scrivi Space(43) & "|" & Format2(di1) & "|"
Scrivi
Scrivi " Ruota principale " & NomeRuota(ruota(1))
Scrivi
ruote(1) = r1
ruote(2) = r2
Xnum(1) = estra
Xnum(2) = estrb
Xnum(3) = estrc
Xnum(4) = estrd
Xnum(5) = d1
Xnum(6) = d3
Xnum(7) = s3
Xnum(8) = s4
Xnum(9) = d4
Xnum(10) = d5
EliminaRipetuti Xnum',True
For X = 1 To UBound(Xnum)
If Xnum(X) > 0 And Xnum(X) <> di1 Then
num(1) = di1 : num(2) = Xnum(X)
ImpostaGiocata X,num,ruota,posta,clp
Gioca es
End If
Next
End If
End If
Next
Next
Next
End If
Next
Next
Next
Next
ScriviResoconto
Scrivi Space(50) & "PROGETTO - L'AMBO SECCO SULLA RUOTA (senza regola 4)- BY FABARRI"
Scrivi Space(50) & "SCRIPT BY SALVO50"
End SubL'AMBO SECCO SULLA RUOTA: I VALORI 1-44 (con regola n4)
Codice:
'PROGETTO - L'AMBO SECCO SULLA RUOTA: I VALORI 1-44 (con regola 4) - BY FABARRI
'SCRIPT BY SALVO50
Option Explicit
Sub Main
Dim fin,es,esq,clp,col,esqcol,idestr
Dim posta(2),ruote(3),ruota(1),poste(5)
Dim p1,p2,p3,p4,r1,r2,caso,casi
Dim estra,estrb,estrc,estrd,X
Dim d1,d2,d3,d4,s1,s2,di1,es2,num(2)
ReDim Xnum(10)
fin = EstrazioneFin
esq = InputBox("Inserisci l'estrazione che vuoi iniziare",idestr,9300)
clp = InputBox("Per quanti colpi vuoi giocare?",,7)
col = CInt(InputBox(" Quante estrazioni vuoi controllare ",,5))
'posta(1) = 1
posta(2) = 1
poste(2) = 1
'poste(3) = 1
'poste(4) = 1
'poste(5) = 1
esqcol = esq + col
If esqcol > fin Then esqcol = fin
For es = esq To esqcol
Messaggio es
AvanzamentoElab esq,esqcol,es
caso = 0
For es2 = es To(es - 3) Step - 1
For r1 = 1 To 9
For p1 = 1 To 4
p2 = p1 + 1
estra = Estratto(es,r1,p1)
estrb = Estratto(es,r1,p2)
d1 = Distanza(estra,estrb)
For r2 = 1 To 10
For p3 = 1 To 4
For p4 = p3 + 1 To 5
estrc = Estratto(es2,r2,p3)
estrd = Estratto(es2,r2,p4)
If d1 = estrc Or d1 = estrd Then
d2 = Distanza(estrc,estrd)
di1 = Differenza(d1,d2)
If di1 =(estra) Or di1 =(estrb) Or di1 =(estrc) Or di1 =(estrd) Then
If d1 =(estra) Or d1 =(estrb) Or d1 =(estrc) Or d1 =(estrd) Then
If di1 = estrc Or di1 = estrd Then ruota(1) = r2
If di1 = estra Or di1 = estrb Then ruota(1) = r1
s1 = Fuori90(estra + estrb)
s2 = Fuori90(estrc + estrd)
d3 = Distanza(estra,estrd)
d4 = Distanza(estrb,estrc)
caso = caso + 1
casi = casi + 1
ColoreTesto 1
Scrivi String(89,"o") & " Casi Totali " & FormattaStringa(casi,"0000")
ColoreTesto 2
Scrivi String(80,"o") & " Estrazione " &(es) & " caso " & FormattaStringa(caso,"0000")
ColoreTesto 0
Scrivi
ColoreTesto 1
Scrivi(" Estrazione n." & Format2(es) & " del " & DataEstrazione(es)),0,0
Scrivi " " & Left(NomeRuota(r1),2) & " " & StringaEstratti(es,r1),2
ColoreTesto 2
Scrivi(" Estrazione n." & Format2(es2) & " del " & DataEstrazione(es2)),0,0
Scrivi " " & Left(NomeRuota(r2),2) & " " & StringaEstratti(es2,r2),2
ColoreTesto 0
Scrivi
ColoreTesto 2
Scrivi Space(35) & Left(NomeRuota(r2),2) & " " & Format2(estrc) & " " & Format2(estrd),0,0
Scrivi "|" & Format2(d2) & "|" & Format2(s2) & Space(5),0,0
ColoreTesto 0
Scrivi Format2(d3),2
ColoreTesto 1
Scrivi Space(35) & Left(NomeRuota(r1),2) & " " & Format2(estra) & " " & Format2(estrb),0,0
Scrivi "|" & Format2(d1) & "|" & Format2(s1) & Space(5),0,0
ColoreTesto 0
Scrivi Format2(d4),2
ColoreTesto 0
Scrivi Space(43) & "|" & Format2(di1) & "|"
Scrivi
Scrivi " Ruota principale " & NomeRuota(ruota(1))
Scrivi
ruote(1) = r1
ruote(2) = r2
Xnum(1) = estra
Xnum(2) = estrb
Xnum(3) = estrc
Xnum(4) = estrd
Xnum(5) = d1
Xnum(6) = d2
Xnum(7) = s1
Xnum(8) = s2
Xnum(9) = d3
Xnum(10) = d4
EliminaRipetuti Xnum',True
For X = 1 To UBound(Xnum)
If Xnum(X) > 0 And Xnum(X) <> di1 Then
num(1) = di1 : num(2) = Xnum(X)
ImpostaGiocata X,num,ruota,posta,clp
Gioca es
End If
Next
End If
End If
End If
Next
Next
Next
Next
Next
Next
Next
ScriviResoconto
Scrivi Space(50) & "PROGETTO - L'AMBO SECCO SULLA RUOTA: I VALORI 1-44 (con regola 4) - BY FABARRI"
Scrivi Space(50) & "SCRIPT BY SALVO50"
End Sub
Ultima modifica:
salvo50
Advanced Member >PLATINUM PLUS<
PROCEDIMENTO DISTICON (senza regola n4)
PROCEDIMENTO DISTICON (con regola n4)
Codice:
'PROGETTO - PROCEDIMENTO DISTICON (senza regola 4)- BY FABARRI
'SCRIPT BY SALVO50
Option Explicit
Sub Main
Dim fin,es,esq,clp,col,esqcol,idestr
Dim posta(2),ruote(3),ruota(1),poste(5)
Dim p1,p2,p3,p4,r1,r2,caso,casi
Dim estra,estrb,estrc,estrd,X
Dim d1,d2,d3,d4,d5,s1,s2,s3,s4,di1,es2,num(2),num7(7)
ReDim Xnum(10)
fin = EstrazioneFin
esq = InputBox("Inserisci l'estrazione che vuoi iniziare",idestr,9300)
clp = InputBox("Per quanti colpi vuoi giocare l'ambata?",,7)
col = CInt(InputBox(" Quante estrazioni vuoi controllare ",,0))
'posta(1) = 1
posta(2) = 1
poste(2) = 1
esqcol = esq + col
If esqcol > fin Then esqcol = fin
For es = esq To esqcol
Messaggio es
AvanzamentoElab esq,esqcol,es
caso = 0
For es2 = es To(es - 3) Step - 1
For r1 = 1 To 9
For p1 = 1 To 4
p2 = p1 + 1
estra = Estratto(es,r1,p1)
estrb = Estratto(es,r1,p2)
d1 = Distanza(estra,estrb)
s1 = d1 + estra
s2 = d1 + estrb
If s1 < 45 Or s2 < 45 Then
If s1 < 45 Then d2 = s1
If s2 < 45 Then d2 = s2
For r2 = 1 To 10
For p3 = 1 To 4
For p4 = p3 + 1 To 5
estrc = Estratto(es2,r2,p3)
estrd = Estratto(es2,r2,p4)
d3 = Distanza(estrc,estrd)
If d2 = d3 Then
di1 = Differenza(d1,d3)
If di1 =(estra) Or di1 =(estrb) Or di1 =(estrc) Or di1 =(estrd) Then
If di1 = estrc Or di1 = estrd Then ruota(1) = r2
If di1 = estra Or di1 = estrb Then ruota(1) = r1
s3 = Fuori90(estra + estrb)
s4 = Fuori90(estrc + estrd)
d4 = Distanza(estra,estrd)
d5 = Distanza(estrb,estrc)
caso = caso + 1
casi = casi + 1
ColoreTesto 1
Scrivi String(89,"o") & " Casi Totali " & FormattaStringa(casi,"0000")
ColoreTesto 2
Scrivi String(80,"o") & " Estrazione " &(es) & " caso " & FormattaStringa(caso,"0000")
ColoreTesto 0
Scrivi
ColoreTesto 1
Scrivi(" Estrazione n." & Format2(es) & " del " & DataEstrazione(es)),0,0
Scrivi " " & Left(NomeRuota(r1),2) & " " & StringaEstratti(es,r1),2
ColoreTesto 2
Scrivi(" Estrazione n." & Format2(es2) & " del " & DataEstrazione(es2)),0,0
Scrivi " " & Left(NomeRuota(r2),2) & " " & StringaEstratti(es2,r2),2
ColoreTesto 0
Scrivi
ColoreTesto 2
Scrivi Space(35) & Left(NomeRuota(r2),2) & " " & Format2(estrc) & " " & Format2(estrd),0,0
Scrivi "|" & Format2(d3) & "|" & Format2(s4) & Space(5),0,0
ColoreTesto 0
Scrivi Format2(d4),2
ColoreTesto 1
Scrivi Space(35) & Left(NomeRuota(r1),2) & " " & Format2(estra) & " " & Format2(estrb),0,0
Scrivi "|" & Format2(d1) & "|" & Format2(s3) & Space(5),0,0
ColoreTesto 0
Scrivi Format2(d5),2
ColoreTesto 0
Scrivi Space(43) & "|" & Format2(di1) & "|"
Scrivi
Scrivi " Ruota principale " & NomeRuota(ruota(1))
Scrivi
ruote(1) = r1
ruote(2) = r2
Xnum(1) = estra
Xnum(2) = estrb
Xnum(3) = estrc
Xnum(4) = estrd
Xnum(5) = d1
Xnum(6) = d3
Xnum(7) = s3
Xnum(8) = s4
Xnum(9) = d4
Xnum(10) = d5
EliminaRipetuti Xnum',True
For X = 1 To UBound(Xnum)
If Xnum(X) > 0 And Xnum(X) <> di1 Then
num(1) = di1 : num(2) = Xnum(X)
ImpostaGiocata X,num,ruota,posta,clp
End If
If X = UBound(Xnum) Then
num7(1) = estra
num7(2) = estrb
num7(3) = estrc
num7(4) = estrd
num7(5) = d1
num7(6) = d3
num7(7) = di1
EliminaRipetuti num7
ImpostaGiocata 11,num7,ruote,poste,clp
Gioca es
End If
Next
End If
End If
Next
Next
Next
End If
Next
Next
Next
Next
ScriviResoconto
Scrivi Space(50) & "PROGETTO - PROCEDIMENTO DISTICON (senza regola 4)- BY FABARRI"
Scrivi Space(50) & "SCRIPT BY SALVO50"
End SubPROCEDIMENTO DISTICON (con regola n4)
Codice:
'PROGETTO - PROCEDIMENTO DISTICON (con regola 4) - BY FABARRI
'SCRIPT BY SALVO50
Option Explicit
Sub Main
Dim fin,es,esq,clp,col,esqcol,idestr
Dim posta(2),ruote(3),ruota(1),poste(5)
Dim p1,p2,p3,p4,r1,r2,caso,casi
Dim estra,estrb,estrc,estrd,X
Dim d1,d2,d3,d4,s1,s2,di1,es2,num(2),num7(7)
ReDim Xnum(10)
fin = EstrazioneFin
esq = InputBox("Inserisci l'estrazione che vuoi iniziare",idestr,9300)
clp = InputBox("Per quanti colpi vuoi giocare?",,7)
col = CInt(InputBox(" Quante estrazioni vuoi controllare ",,5))
'posta(1) = 1
posta(2) = 1
poste(2) = 1
'poste(3) = 1
'poste(4) = 1
'poste(5) = 1
esqcol = esq + col
If esqcol > fin Then esqcol = fin
For es = esq To esqcol
Messaggio es
AvanzamentoElab esq,esqcol,es
caso = 0
For es2 = es To(es - 3) Step - 1
For r1 = 1 To 9
For p1 = 1 To 4
p2 = p1 + 1
estra = Estratto(es,r1,p1)
estrb = Estratto(es,r1,p2)
d1 = Distanza(estra,estrb)
For r2 = 1 To 10
For p3 = 1 To 4
For p4 = p3 + 1 To 5
estrc = Estratto(es2,r2,p3)
estrd = Estratto(es2,r2,p4)
If d1 = estrc Or d1 = estrd Then
d2 = Distanza(estrc,estrd)
di1 = Differenza(d1,d2)
If di1 =(estra) Or di1 =(estrb) Or di1 =(estrc) Or di1 =(estrd) Then
If di1 = estrc Or di1 = estrd Then ruota(1) = r2
If di1 = estra Or di1 = estrb Then ruota(1) = r1
s1 = Fuori90(estra + estrb)
s2 = Fuori90(estrc + estrd)
d3 = Distanza(estra,estrd)
d4 = Distanza(estrb,estrc)
caso = caso + 1
casi = casi + 1
ColoreTesto 1
Scrivi String(89,"o") & " Casi Totali " & FormattaStringa(casi,"0000")
ColoreTesto 2
Scrivi String(80,"o") & " Estrazione " &(es) & " caso " & FormattaStringa(caso,"0000")
ColoreTesto 0
Scrivi
ColoreTesto 1
Scrivi(" Estrazione n." & Format2(es) & " del " & DataEstrazione(es)),0,0
Scrivi " " & Left(NomeRuota(r1),2) & " " & StringaEstratti(es,r1),2
ColoreTesto 2
Scrivi(" Estrazione n." & Format2(es2) & " del " & DataEstrazione(es2)),0,0
Scrivi " " & Left(NomeRuota(r2),2) & " " & StringaEstratti(es2,r2),2
ColoreTesto 0
Scrivi
ColoreTesto 2
Scrivi Space(35) & Left(NomeRuota(r2),2) & " " & Format2(estrc) & " " & Format2(estrd),0,0
Scrivi "|" & Format2(d2) & "|" & Format2(s2) & Space(5),0,0
ColoreTesto 0
Scrivi Format2(d3),2
ColoreTesto 1
Scrivi Space(35) & Left(NomeRuota(r1),2) & " " & Format2(estra) & " " & Format2(estrb),0,0
Scrivi "|" & Format2(d1) & "|" & Format2(s1) & Space(5),0,0
ColoreTesto 0
Scrivi Format2(d4),2
ColoreTesto 0
Scrivi Space(43) & "|" & Format2(di1) & "|"
Scrivi
Scrivi " Ruota principale " & NomeRuota(ruota(1))
Scrivi
ruote(1) = r1
ruote(2) = r2
Xnum(1) = estra
Xnum(2) = estrb
Xnum(3) = estrc
Xnum(4) = estrd
Xnum(5) = d1
Xnum(6) = d2
Xnum(7) = s1
Xnum(8) = s2
Xnum(9) = d3
Xnum(10) = d4
EliminaRipetuti Xnum',True
For X = 1 To UBound(Xnum)
If Xnum(X) > 0 And Xnum(X) <> di1 Then
num(1) = di1 : num(2) = Xnum(X)
ImpostaGiocata X,num,ruota,posta,clp
End If
If X = UBound(Xnum) Then
num7(1) = estra
num7(2) = estrb
num7(3) = estrc
num7(4) = estrd
num7(5) = d1
num7(6) = d2
num7(7) = di1
EliminaRipetuti num7
ImpostaGiocata 11,num7,ruote,poste,clp
Gioca es
End If
Next
End If
End If
Next
Next
Next
Next
Next
Next
Next
ScriviResoconto
Scrivi Space(50) & "PROGETTO - PROCEDIMENTO DISTICON (con regola 4) - BY FABARRI"
Scrivi Space(50) & "SCRIPT BY SALVO50"
End Sub
Ultima modifica:
salvo50
Advanced Member >PLATINUM PLUS<
UNA AMBATA ED UN TRIAMBO
Codice:
'PROGETTO - UN'AMBATA ED UN TRIAMBO - BY FABARRI
'SCRIPT - BY SALVO50
Option Explicit
Sub Main
Dim fin,es,esq,clp,col,esqcol,idestr,clp2
Dim posta(1),poste(2),ruota(2),ruote(1),num(1),nut(3)
Dim p1,p2,p3,r1,r2,caso,casi
Dim estra,estrb,estrc
Dim d1,d2,d3,dm1,dm2,dm3
Dim dm1x2,dm2x2,dm3x2
fin = EstrazioneFin
esq = InputBox("Inserisci l'estrazione che vuoi iniziare",idestr,9350)
clp = InputBox("Per quanti colpi vuoi giocare l'ambata?",,7)
clp2 = InputBox("Per quanti colpi vuoi giocare l'ambo per tutte le ruote?",,8)
col = CInt(InputBox(" Quante estrazioni vuoi controllare ",,0))
posta(1) = 1
poste(2) = 1
esqcol = esq + col
If esqcol > fin Then esqcol = fin
For es = esq To esqcol
Messaggio es
AvanzamentoElab esq,esqcol,es
caso = 0
For r1 = 1 To 9
For p1 = 1 To 5
estra = Estratto(es,r1,p1)
r2 = r1 + 1
For p2 = 1 To 4
For p3 = p2 + 1 To 5
estrb = Estratto(es,r2,p2)
estrc = Estratto(es,r2,p3)
d1 = Distanza(estra,estrb)
d2 = Distanza(estra,estrc)
d3 = Distanza(estrb,estrc)
If d1 =(d2 + d3) Or d2 =(d1 + d3) Or d3 =(d1 + d2) Then
If d1 > d2 And d1 > d3 Then dm1 = d1
If d2 > d1 And d2 > d3 Then dm1 = d2
If d3 > d1 And d3 > d2 Then dm1 = d3
If dm1 = d1 Then dm2 = d2 : dm3 = d3
If dm1 = d2 Then dm2 = d1 : dm3 = d3
If dm1 = d3 Then dm2 = d1 : dm3 = d2
dm1x2 = dm1 * 2
dm2x2 = dm2 * 2
dm3x2 = dm3 * 2
caso = caso + 1
casi = casi + 1
ColoreTesto 1
Scrivi String(89,"o") & " Casi Totali " & FormattaStringa(casi,"0000")
ColoreTesto 2
Scrivi String(80,"o") & " Estrazione " &(es) & " caso " & FormattaStringa(caso,"0000")
ColoreTesto 0
Scrivi
ColoreTesto 1
Scrivi(" Estrazione n." & Format2(es) & " del " & DataEstrazione(es)),0,0
Scrivi " " & Left(NomeRuota(r1),2) & " " & StringaEstratti(es,r1),2
ColoreTesto 2
Scrivi(" Estrazione n." & Format2(es) & " del " & DataEstrazione(es)),0,0
Scrivi " " & Left(NomeRuota(r2),2) & " " & StringaEstratti(es,r2),2
ColoreTesto 0
Scrivi
Scrivi Space(15) & SiglaRuota(r1) & " " & Format2(estra)
Scrivi Space(15) & SiglaRuota(r2) & " " & Format2(estrb) & " " & Format2(estrc)
Scrivi
Scrivi " Distanza ciclometrica tra " & Format2(estra) & " e " & Format2(estrb) & " = " & Format2(d1)
Scrivi " Distanza ciclometrica tra " & Format2(estra) & " e " & Format2(estrc) & " = " & Format2(d2)
Scrivi " Distanza ciclometrica tra " & Format2(estrb) & " e " & Format2(estrc) & " = " & Format2(d3)
Scrivi " Distanza più alta, somma delle 2 distanze minori = " & Format2(dm1)
Scrivi
ruota(1) = r1
ruota(2) = r2
ruote(1) = TU_
num(1) = dm1x2
ImpostaGiocata 1,num,ruota,posta,clp
nut(1) = dm1x2
nut(2) = dm2x2
nut(3) = dm3x2
ImpostaGiocata 2,nut,ruote,poste,clp2
Gioca es
End If
Next
Next
Next
Next
Next
ScriviResoconto
Scrivi Space(50) & "PROGETTO - UN'AMBATA ED UN TRIAMBO - BY FABARRI"
Scrivi Space(50) & "SCRIPT - BY SALVO50"
End Sub
Ultima modifica:
salvo50
Advanced Member >PLATINUM PLUS<
IL VALORE MEDIO O MEDIOVALORE
Per questo metodo per ogni estrazione ho fatto una sola ricerca, praticamente lo script appena trovata una combinazione valida, passa ad un altra estrazione, senza andare a cercare nelle altre ruote altre possibili combinazioni, perchè se vado a cercare nelle altre ruote mi vengono fuori un mucchio di doppioni.
Quindi per ogni estrazione solo 2 ruote consecutive, la prima coppia che trova con le caratteristiche del sistema.
Ho fatto 2 script, il primo calcola il valore medio di un estratto per eccesso o per difetto, poi siccome ad un certo punto, nell'articolo l'autore dice che bisogna inoltre attenersi possibilmente a valori precisi, allora nell'altro script ho ottenuto il valore medio, solo da somme con finale zero in modo che non ci siano decimali.
Un grazie va a LuigiB che mi ha fatto l'esempio per calcolare i decimali in eccesso e difetto.
Script con valore medio arrotondato per eccesso e per difetto
Script con valore medio esatto
Script con mediovalore esatto ed anche per eccesso e difetto con la ricerca di più coppie per estrazione
Per questo metodo per ogni estrazione ho fatto una sola ricerca, praticamente lo script appena trovata una combinazione valida, passa ad un altra estrazione, senza andare a cercare nelle altre ruote altre possibili combinazioni, perchè se vado a cercare nelle altre ruote mi vengono fuori un mucchio di doppioni.
Quindi per ogni estrazione solo 2 ruote consecutive, la prima coppia che trova con le caratteristiche del sistema.
Ho fatto 2 script, il primo calcola il valore medio di un estratto per eccesso o per difetto, poi siccome ad un certo punto, nell'articolo l'autore dice che bisogna inoltre attenersi possibilmente a valori precisi, allora nell'altro script ho ottenuto il valore medio, solo da somme con finale zero in modo che non ci siano decimali.
Un grazie va a LuigiB che mi ha fatto l'esempio per calcolare i decimali in eccesso e difetto.
Script con valore medio arrotondato per eccesso e per difetto
Codice:
'PROGETTO - IL VALORE MEDIO O MEDIOVALORE - BY FABARRI
'SCRIPT BY SALVO50
'Valore medio per eccesso o per difetto
Option Explicit
Sub Main
Dim fin,es,esq,clp,col,esqcol,ess,ess7,es1
Dim posta(1),ruote(2),ambata(1)
Dim r1,r2,p1,casi,Xnum,num,ok,numb,x
Dim estra,estrb,estrc,estrd,somma1,somma2,somma3
fin = EstrazioneFin
esq = InputBox("Inserisci l'estrazione che vuoi iniziare",,9000)
clp = InputBox("Per quanti colpi vuoi giocare l'ambata?",,7)
col = CInt(InputBox(" Quante estrazioni vuoi controllare ",,380))
posta(1) = 1
esqcol = esq + col
If esqcol > fin Then esqcol =(fin - 1)
For es = esq To esqcol
Messaggio es
AvanzamentoElab esq,esqcol,es
ok = 0
es1 = es + 1
ess7 = es + 7
If ess7 > fin Then ess7 = fin
For ess = es1 To ess7
For r1 = 1 To 9
r2 = r1 + 1
somma1 = SommaEstratti(es,r1)
somma2 = SommaEstratti(es,r2)
somma3 = somma1 + somma2
Xnum =(somma3 \ 10)
x = ModX(somma3,10)
If x > 4 Then Xnum = Xnum + 1
For p1 = 1 To 5
estra = Estratto(es,r1,p1)
estrb = Estratto(es,r2,p1)
estrc = Estratto(ess,r1,p1)
estrd = Estratto(ess,r2,p1)
If estra = Xnum Or estrb = Xnum Or estrc = Xnum Or estrd = Xnum Then ok = 1
If ok = 1 Then Exit For
Next
If ok = 1 Then
num =(91 - Xnum)
If num <> estra And num <> estrb And num <> estrc And num <> estrd Then
casi = casi + 1
ColoreTesto 1
Scrivi String(96,"o") & " Casi " & FormattaStringa(casi,"0000")
ColoreTesto 0
Scrivi(" Estrazione n." & Format2(es) & " del " & DataEstrazione(es)),0,0
Scrivi " " & SiglaRuota(r1) & " " & StringaEstratti(es,r1) & " Somma Estratti = " & FormattaStringa(somma1,"000"),2
Scrivi Space(35) & SiglaRuota(r2) & " " & StringaEstratti(es,r2) & " Somma Estratti = " & FormattaStringa(somma2,"000"),2
Scrivi Space(53) & " Somma Totale = " & FormattaStringa(somma3,"000"),2
Scrivi Space(53) & " Valore Medio = " & Format2(Xnum),2
Scrivi Space(53) & " Integrativo = " & Format2(num),2
Scrivi
If estrc = Xnum Or estrd = Xnum Then
Scrivi(" Estrazione n." & Format2(ess) & " del " & DataEstrazione(ess)),0,0
Scrivi " " & SiglaRuota(r1) & " " & StringaEstratti(ess,r1),2
Scrivi Space(35) & SiglaRuota(r2) & " " & StringaEstratti(ess,r2),2
Scrivi
End If
ruote(1) = r1
ruote(2) = r2
ambata(1) = num
ImpostaGiocata 1,ambata,ruote,posta,clp,1
If estra = Xnum Or estrb = Xnum Then ess = ess - 1
Gioca ess
End If
End If
If ok = 1 Then Exit For
Next
If ok = 1 Then Exit For
Next
Next
ScriviResoconto
Scrivi Space(50) & "PROGETTO - IL VALORE MEDIO O MEDIOVALORE - BY FABARRI"
Scrivi Space(50) & "SCRIPT - BY SALVO50"
End Sub
Function ModX(n,m)
ModX = n -(Fix(n/m) * m)
End FunctionScript con valore medio esatto
Codice:
'PROGETTO - IL VALORE MEDIO O MEDIOVALORE - BY FABARRI
'SCRIPT BY SALVO50
'valore medio da somma zerata
Option Explicit
Sub Main
Dim fin,es,esq,clp,col,esqcol,ess,ess7,es1
Dim posta(1),ruote(2),ambata(1)
Dim r1,r2,p1,casi,Xnum,num,ok,numb,x
Dim estra,estrb,estrc,estrd,somma1,somma2,somma3
fin = EstrazioneFin
esq = InputBox("Inserisci l'estrazione che vuoi iniziare",,9000)
clp = InputBox("Per quanti colpi vuoi giocare l'ambata?",,7)
col = CInt(InputBox(" Quante estrazioni vuoi controllare ",,380))
posta(1) = 1
esqcol = esq + col
If esqcol > fin Then esqcol =(fin - 1)
For es = esq To esqcol
Messaggio es
AvanzamentoElab esq,esqcol,es
ok = 0
es1 = es + 1
ess7 = es + 7
If ess7 > fin Then ess7 = fin
For ess = es1 To ess7
For r1 = 1 To 9
r2 = r1 + 1
somma1 = SommaEstratti(es,r1)
somma2 = SommaEstratti(es,r2)
somma3 = somma1 + somma2
Xnum =(somma3 / 10)
For p1 = 1 To 5
estra = Estratto(es,r1,p1)
estrb = Estratto(es,r2,p1)
estrc = Estratto(ess,r1,p1)
estrd = Estratto(ess,r2,p1)
If estra = Xnum Or estrb = Xnum Or estrc = Xnum Or estrd = Xnum Then ok = 1
If ok = 1 Then Exit For
Next
If ok = 1 Then
num =(91 - Xnum)
If num <> estra And num <> estrb And num <> estrc And num <> estrd Then
casi = casi + 1
ColoreTesto 1
Scrivi String(96,"o") & " Casi " & FormattaStringa(casi,"0000")
ColoreTesto 0
Scrivi(" Estrazione n." & Format2(es) & " del " & DataEstrazione(es) & " " & SiglaRuota(r1)),0,0
Scrivi " " & StringaEstratti(es,r1) & " Somma Estratti = " & FormattaStringa(somma1,"000"),2
Scrivi Space(35) & SiglaRuota(r2) & " " & StringaEstratti(es,r2) & " Somma Estratti = ",0,0
Scrivi FormattaStringa(somma2,"000"),2
Scrivi Space(53) & " Somma Totale = " & FormattaStringa(somma3,"000"),2
Scrivi Space(53) & " Valore Medio = " & Format2(Xnum),2
Scrivi Space(53) & " Integrativo = " & Format2(num),2
Scrivi
If estrc = Xnum Or estrd = Xnum Then
Scrivi(" Estrazione n." & Format2(ess) & " del " & DataEstrazione(ess)),0,0
Scrivi " " & SiglaRuota(r1) & " " & StringaEstratti(ess,r1),2
Scrivi Space(35) & SiglaRuota(r2) & " " & StringaEstratti(ess,r2),2
Scrivi
End If
ruote(1) = r1
ruote(2) = r2
ambata(1) = num
ImpostaGiocata 1,ambata,ruote,posta,clp,1
If estra = Xnum Or estrb = Xnum Then ess = ess - 1
Gioca ess
End If
End If
If ok = 1 Then Exit For
Next
If ok = 1 Then Exit For
Next
Next
ScriviResoconto
Scrivi Space(50) & "PROGETTO - IL VALORE MEDIO O MEDIOVALORE - BY FABARRI"
Scrivi Space(50) & "SCRIPT - BY SALVO50"
End SubScript con mediovalore esatto ed anche per eccesso e difetto con la ricerca di più coppie per estrazione
Codice:
'PROGETTO - IL VALORE MEDIO O MEDIOVALORE - BY FABARRI
'SCRIPT BY SALVO50
Option Explicit
Sub Main
Dim fin,es,esq,clp,col,esqcol,ess,ess7,es1
Dim posta(1),ruote(2),ambata(1)
Dim r1,r2,p1,casi,Xnum,num,ok,numb,x,caso
Dim estra,estrb,estrc,estrd,somma1,somma2,somma3
fin = EstrazioneFin
esq = InputBox("Inserisci l'estrazione che vuoi iniziare",,9300)
clp = InputBox("Per quanti colpi vuoi giocare l'ambata?",,7)
col = CInt(InputBox(" Quante estrazioni vuoi controllare ",,100))
posta(1) = 1
esqcol = esq + col
If esqcol > fin Then esqcol =(fin - 1)
For es = esq To esqcol
Messaggio es
AvanzamentoElab esq,esqcol,es
caso = 0
es1 = es + 1
ess7 = es + 7
If ess7 > fin Then ess7 = fin
For ess = es1 To ess7
For r1 = 1 To 9
r2 = r1 + 1
somma1 = SommaEstratti(es,r1)
somma2 = SommaEstratti(es,r2)
somma3 = somma1 + somma2
Xnum =(somma3 \ 10)
x = ModX(somma3,10)
If x > 4 Then Xnum = Xnum + 1
For p1 = 1 To 5
ok = 0
estra = Estratto(es,r1,p1)
estrb = Estratto(es,r2,p1)
estrc = Estratto(ess,r1,p1)
estrd = Estratto(ess,r2,p1)
If estra = Xnum Or estrb = Xnum Or estrc = Xnum Or estrd = Xnum Then
num =(91 - Xnum)
If num <> estra And num <> estrb And num <> estrc And num <> estrd Then
casi = casi + 1
caso = caso + 1
ColoreTesto 1
Scrivi String(89,"o") & " Casi Totali " & FormattaStringa(casi,"0000")
ColoreTesto 2
Scrivi String(80,"o") & " Estrazione " &(es) & " caso " & FormattaStringa(caso,"0000")
ColoreTesto 0
Scrivi(" Estrazione n." & Format2(es) & " del " & DataEstrazione(es)),0,0
Scrivi " " & SiglaRuota(r1) & " " & StringaEstratti(es,r1) & " Somma Estratti = " & FormattaStringa(somma1,"000"),2
Scrivi Space(35) & SiglaRuota(r2) & " " & StringaEstratti(es,r2) & " Somma Estratti = " & FormattaStringa(somma2,"000"),2
Scrivi Space(53) & " Somma Totale = " & FormattaStringa(somma3,"000"),2
Scrivi Space(53) & " Valore Medio = " & Format2(Xnum),2
Scrivi Space(53) & " Integrativo = " & Format2(num),2
Scrivi
If estrc = Xnum Or estrd = Xnum Then
Scrivi(" Estrazione n." & Format2(ess) & " del " & DataEstrazione(ess)),0,0
Scrivi " " & SiglaRuota(r1) & " " & StringaEstratti(ess,r1),2
Scrivi Space(35) & SiglaRuota(r2) & " " & StringaEstratti(ess,r2),2
Scrivi
End If
ruote(1) = r1
ruote(2) = r2
ambata(1) = num
ImpostaGiocata 1,ambata,ruote,posta,clp,1
If estra = Xnum Or estrb = Xnum Then
Gioca es
Else
Gioca ess
End If
End If
End If
ok = 1
Next
Next
If ok = 1 Then Exit For
Next
Next
ScriviResoconto
Scrivi Space(50) & "PROGETTO - IL VALORE MEDIO O MEDIOVALORE - BY FABARRI"
Scrivi Space(50) & "SCRIPT - BY SALVO50"
End Sub
Function ModX(n,m)
ModX = n -(Fix(n/m) * m)
End Function
Ultima modifica:
salvo50
Advanced Member >PLATINUM PLUS<
salvo50;n2082171 ha scritto:
Ciao Rodolfo.
Ho trovato l'errore del perchè mi venivano dei doppioni, quindi a pagina 56 ho inserito un altro script, in quest'ultimo script faccio fare la ricerca di tutte le coppie possibili in una estrazione, prima di passare ad un'altra estrazione ed ho unificato la ricerca del mediovalore sia per difetto ed eccesso che per valore esatto.
salvo50
Advanced Member >PLATINUM PLUS<
PARALLELISMO FRA SOMME E NUMERI
Script postati in ordine di inserimento
IL QUADRATO ARMONICO
LA MASSIMA ARMONIA QUADRATICA <-- postato da Claudio8
IL COEFFICIENTE MEDIO INTEGRATORE
IL TRIANGOLO ISCRITTO
NUOVA FORMULA PROPORZIONALE
IL QUADRATO A DIAGONALE FISSA
IL PUNTO DIAMETRALE
LA STRUTTURA DEI NUMERI
PROCEDIMENTO EINS-FAB
IL PROCEDIMENTO S.91
L'AMBO SECCO SULLA RUOTA I VALORI 1-44
PROCEDIMENTO DISTICON
UNA AMBATA ED UN TRIAMBO
IL VALORE MEDIO O MEDIOVALORE
PARALLELISMO FRA SOMME E NUMERI
Codice:
'PROGETTO - PARALLELISMO TRA SOMME E NUMERI - BY FABARRI
'SCRIPT BY SALVO50
Option Explicit
Sub Main
Dim FIn,Es,Esq,Clp,Col,Esqcol
Dim Posta(1),Ruote(2),Ambata(1)
Dim R1,R2,P1,P2,Casi,Caso
Dim Estra,Estrb,Estrc,Estrd,Somma1,Somma2
FIn = EstrazioneFin
Esq = InputBox("Inserisci l'estrazione che vuoi iniziare",,9000)
Clp = InputBox("Per quanti colpi vuoi giocare l'ambata?",,7)
Col = CInt(InputBox(" Quante estrazioni vuoi controllare ",,500))
Posta(1) = 1
Esqcol = Esq + Col
If Esqcol > FIn Then Esqcol = FIn
For Es = Esq To Esqcol
Caso = 0
Messaggio Es
AvanzamentoElab Esq,Esqcol,Es
For R1 = 1 To 9
For R2 = R1 + 1 To 10
For P1 = 1 To 4
P2 = P1 + 1
Estra = Estratto(Es,R1,P1)
Estrb = Estratto(Es,R1,P2)
Estrc = Estratto(Es,R2,P1)
Estrd = Estratto(Es,R2,P2)
Somma1 = Fuori90(Estra + Estrb)
Somma2 = Fuori90(Estrc + Estrd)
If Somma1 = Somma2 Then
Casi = Casi + 1
Caso = Caso + 1
ColoreTesto 1
Scrivi String(89,"*") & " Casi Totali " & FormattaStringa(Casi,"0000")
ColoreTesto 2
Scrivi String(80,"*") & " Estrazione " &(Es) & " caso " & FormattaStringa(Caso,"0000")
ColoreTesto 0
Scrivi
Scrivi(" Estrazione n." & Format2(Es) & " del " & DataEstrazione(Es) & " " & SiglaRuota(R1)),2,0
Scrivi " " & StringaEstratti(Es,R1) & " Coppia Consecutiva " & Format2(Estra) & " " & Format2(Estrb),2,0
Scrivi " Somma " & Format2(Somma1),2
Scrivi Space(35) & SiglaRuota(R2) & " " & StringaEstratti(Es,R2) & " Coppia Isotopa ",2,0
Scrivi Format2(Estrc) & " " & Format2(Estrd) & " Somma " & Format2(Somma2),2
Scrivi
Ruote(1) = R1
Ruote(2) = R2
Ambata(1) = Somma1
ImpostaGiocata 1,Ambata,Ruote,Posta,Clp,1
Gioca Es
End If
Next
Next
Next
Next
ScriviResoconto
Scrivi Space(50) & "PROGETTO - PARALLELISMO TRA SOMME E NUMERI - BY FABARRI"
Scrivi Space(50) & "SCRIPT - BY SALVO50"
End SubScript postati in ordine di inserimento
IL QUADRATO ARMONICO
LA MASSIMA ARMONIA QUADRATICA <-- postato da Claudio8
IL COEFFICIENTE MEDIO INTEGRATORE
IL TRIANGOLO ISCRITTO
NUOVA FORMULA PROPORZIONALE
IL QUADRATO A DIAGONALE FISSA
IL PUNTO DIAMETRALE
LA STRUTTURA DEI NUMERI
PROCEDIMENTO EINS-FAB
IL PROCEDIMENTO S.91
L'AMBO SECCO SULLA RUOTA I VALORI 1-44
PROCEDIMENTO DISTICON
UNA AMBATA ED UN TRIAMBO
IL VALORE MEDIO O MEDIOVALORE
PARALLELISMO FRA SOMME E NUMERI
Ultima modifica:
salvo50
Advanced Member >PLATINUM PLUS<
PROCEDIMENTO SUMMIT
Con questo metodo ho avuto qualche difficoltà a capire qualche regola, la regola n1, dice che tra i due ambi deve sussistere un rapporto frontale, avevo pensato che il rapporto frontale volesse dire che almeno un numero dovesse essere isotopo, infatti nel primo esempio c'è un numero isotopo, ma nel secondo esempio nessuno dei due numeri è isotopo, quindi non ho capito cosa vuol dire, se qualcuno lo sà e me lo dice modificherò lo script, nella regola n7 dice che la somma degli ambi è di 24, ma io con il procedimento che dice di fare ne ho calcolati solo 18 e negli esempi che fà lui sono 18, forse il Fabarri si è sbagliato, oppure io non riesco a calcolarli, quindi anche con questa regola, se qualcuno riesce a calcolare gli ambi mancanti, modificherò lo script.
Lo script è molto lento, ma dipende dal fatto che ci sono molte giocate, infatti ho fatto un altro script dove ho raccolto tutti i numeri calcolati e giocati in blocco, in 2 giocate una per tutte e l'altra per le due ruote ed è risultato decisamente più veloce.
Con questo metodo ho avuto qualche difficoltà a capire qualche regola, la regola n1, dice che tra i due ambi deve sussistere un rapporto frontale, avevo pensato che il rapporto frontale volesse dire che almeno un numero dovesse essere isotopo, infatti nel primo esempio c'è un numero isotopo, ma nel secondo esempio nessuno dei due numeri è isotopo, quindi non ho capito cosa vuol dire, se qualcuno lo sà e me lo dice modificherò lo script, nella regola n7 dice che la somma degli ambi è di 24, ma io con il procedimento che dice di fare ne ho calcolati solo 18 e negli esempi che fà lui sono 18, forse il Fabarri si è sbagliato, oppure io non riesco a calcolarli, quindi anche con questa regola, se qualcuno riesce a calcolare gli ambi mancanti, modificherò lo script.
Lo script è molto lento, ma dipende dal fatto che ci sono molte giocate, infatti ho fatto un altro script dove ho raccolto tutti i numeri calcolati e giocati in blocco, in 2 giocate una per tutte e l'altra per le due ruote ed è risultato decisamente più veloce.
Ultima modifica:
salvo50
Advanced Member >PLATINUM PLUS<
Primo script, come da articolo
Codice:
'Progetto - PROCEDIMENTO SUMMIT - by FABARRI
'Script - by Salvo50
Option Explicit
Sub Main
Dim R1,R2,P1,P2,P3,P4,Es,CLP1,CLP2,Esq,Caso,Casi
Dim FIn,Ini,Ruote(2),Tutte(1),Poste(2)
Dim Idestr,Col,Esqcol,Amb1,Amb2,Amb3,E1,E2,E3,E4
Dim Num1(2),Num2(2),Num3(2),Num4(2),Num5(2),Num6(2),Num7(2),Num8(2),Num9(2)
Dim Num10(2),Num11(2),Num12(2),Num13(2),Num14(2),Num15(2),Num16(2),Num17(2),Num18(2)
Dim Sor12,Sve13,Sin14,Sin23,Sve24,Sor34,Dor12,Dve13,Din14,Din23,Dve24,Dor34
Dim Sor1234,Sve1324,Sin1423,Dor1234,Dve1324,Din1423
'poste(1) = 1
Poste(2) = 1
FIn = EstrazioneFin
Esq = InputBox("Inserisci l'estrazione che vuoi iniziare",Idestr,5395)'5395 caso 11, primo esempio nell'articolo
CLP1 = CInt(InputBox("Per quanti colpi vuoi fare la ricerca per tutte le ruote?",,7))
CLP2 = CInt(InputBox("Per quanti colpi vuoi fare la ricerca per due ruote?",,7))
Col = CInt(InputBox(" Quante estrazioni vuoi controllare ",,0))
Esqcol = Esq + Col
If Esqcol > FIn Then Esqcol = FIn
For Es = Esq To Esqcol
Caso = 0
AvanzamentoElab Esq,Esqcol,Es
Scrivi
For R1 = 1 To 10
For R2 = R1 + 1 To 12 : Messaggio Es & " " & R1 & " " & R2
If R2 = 11 Then R2 = 12
For P1 = 1 To 2
P2 = P1 + 1
For P3 = P1 + 1 To 4
P4 = P3 + 1
E1 = Estratto(Es,R1,P1)
E2 = Estratto(Es,R1,P2)
E3 = Estratto(Es,R2,P3)
E4 = Estratto(Es,R2,P4)
'E1---E2
'| |
'| |
'E3---E4
If E3 > 0 Then
Sor12 = Fuori90(E1 + E2) : Sor34 = Fuori90(E3 + E4)
Sve13 = Fuori90(E1 + E3) : Sve24 = Fuori90(E2 + E4)
Sin14 = Fuori90(E1 + E4) : Sin23 = Fuori90(E2 + E3)
Sor1234 = Fuori90(Sor12 + Sor34)
Sve1324 = Fuori90(Sve13 + Sve24)
Sin1423 = Fuori90(Sin14 + Sin23)
If Sor1234 = Sve1324 And Sor1234 = Sin1423 Then
'-------------------------------------------------
Dor12 = Distanza(E1,E2) : If Dor12 = 90 Then Dor12 = 45
Dor34 = Distanza(E3,E4) : If Dor34 = 90 Then Dor34 = 45
Dve13 = Distanza(E1,E3) : If Dve13 = 90 Then Dve13 = 45
Dve24 = Distanza(E2,E4) : If Dve24 = 90 Then Dve24 = 45
Din14 = Distanza(E1,E4) : If Din14 = 90 Then Din14 = 45
Din23 = Distanza(E2,E3) : If Din23 = 90 Then Din23 = 45
Dor1234 = Distanza(Dor12,Dor34) : If Dor1234 = 90 Then Dor1234 = 45
Dve1324 = Distanza(Dve13,Dve24) : If Dve1324 = 90 Then Dve1324 = 45
Din1423 = Distanza(Din14,Din23) : If Din1423 = 90 Then Din1423 = 45
If Dor1234 = Dve1324 And Dor1234 = Din1423 Then
Amb1 = Sor1234 + Dor1234 : Amb2 = Amb1 / 2 : Amb3 = Sor1234 - Amb2
Caso = Caso + 1
Casi = Casi + 1
ColoreTesto 1
Scrivi String(89,"*") & " Casi Totali " & FormattaStringa(Casi,"0000")
ColoreTesto 2
Scrivi String(80,"*") & " Estrazione " &(Es) & " caso " & FormattaStringa(Caso,"0000")
ColoreTesto 0
Scrivi(" Estrazione n." & Format2(Es) & " del " & DataEstrazione(Es)),1,0
Scrivi " " & SiglaRuota(R1) & " " & StringaEstratti(Es,R1),1
Scrivi Space(20) & " Seconda Ruota " & SiglaRuota(R2) & " " & StringaEstratti(Es,R2),1
Scrivi
Scrivi " Ambi Base " & Space(6) & " Somme Oriz." & Space(3) & " Somme Vert." & Space(3) & "Somme Incr. ",0,0
Scrivi Space(10) & "Dist. oriz." & Space(3) & " Dist. Vert." & Space(3) & " Dist. Incr."
Scrivi " " & Format2(E1) & Space(1) & Format2(E2) & Space(16) & Format2(Sor12),0,0
Scrivi Space(12) & Format2(Sve13) & Space(12) & Format2(Sin14) & Space(21),0,0
Scrivi Format2(Dor12) & Space(12) & Format2(Dve13) & Space(12) & Format2(Din14)
'---------------------------------------------------------------------------------------------------
Scrivi " " & Format2(E3) & Space(1) & Format2(E4) & Space(16) & Format2(Sor34),0,0
Scrivi Space(12) & Format2(Sve24) & Space(12) & Format2(Sin23) & Space(21),0,0
Scrivi Format2(Dor34) & Space(12) & Format2(Dve24) & Space(12) & Format2(Din23)
Scrivi String(105,"-")
Scrivi Space(23) & Format2(Sor1234) & Space(12) & Format2(Sve1324),0,0
Scrivi Space(12) & Format2(Sin1423) & Space(21) & Format2(Dor1234) & Space(12),0,0
Scrivi Format2(Dve1324) & Space(12) & Format2(Din1423)
Scrivi
ColoreTesto 1
Scrivi " Ambi Per Tutte Le Ruote (" & Format2(E4) & " " & Format2(Sor1234) & ")-(" & Format2(E4),0,0
Scrivi " " & Format2(Dor1234) & ")-(" & Format2(E4) & " " & Format2(Amb2) & ")-(" & Format2(E4),0,0
Scrivi " " & Format2(Amb3) & ") Sussidiario (" & Format2(Amb2) & " " & Format2(Amb3) & ")"
Scrivi
ColoreTesto 7
Scrivi " Ambi Per Due Ruote (" & Format2(E4) & " " & Format2(Sor1234) & ")-(" & Format2(Sor1234),0,0
Scrivi " " & Format2(E3) & ")-(" & Format2(Sor1234) & " " & Format2(E2) & ")-(" & Format2(Sor1234),0,0
Scrivi " " & Format2(E1) & ")-(" & Format2(Dor1234) & " " & Format2(E1) & ")-(" & Format2(Dor1234),0,0
Scrivi " " & Format2(E4) & ")-(" & Format2(Dor1234) & " " & Format2(E3) & ")-(" & Format2(Dor1234),0,0
Scrivi " " & Format2(E2) & ")"
Scrivi
Scrivi " Sussidiari (" & Format2(Amb2) & " " & Format2(Amb3) & ")-(" & Format2(Amb3),0,0
Scrivi " " & Format2(E3) & ")-(" & Format2(Amb3) & " " & Format2(E4) & ")-(" & Format2(Amb2),0,0
Scrivi " " & Format2(E3) & ")-(" & Format2(Amb2) & " " & Format2(E4) & ")"
Scrivi
ColoreTesto 0
Ruote(1) = R1
Ruote(2) = R2
Tutte(1) = TU_
'Ambi per tutte le ruote
Num1(1) = E4
Num1(2) = Sor1234
Num2(1) = E4
Num2(2) = Dor1234
Num3(1) = E4
Num3(2) = Amb2
Num4(1) = E4
Num4(2) = Amb3
ImpostaGiocata 1,Num1,Tutte,Poste,CLP1,2
ImpostaGiocata 2,Num2,Tutte,Poste,CLP1,2
ImpostaGiocata 3,Num3,Tutte,Poste,CLP1,2
ImpostaGiocata 4,Num4,Tutte,Poste,CLP1,2
'Ambo sussidiario per tutte le ruote
Num5(1) = Amb2
Num5(2) = Amb3
ImpostaGiocata 5,Num5,Tutte,Poste,CLP1,2
'Ambi per due ruote
Num6(1) = Sor1234
Num6(2) = E4
Num7(1) = Sor1234
Num7(2) = E3
Num8(1) = Sor1234
Num8(2) = E2
Num9(1) = Sor1234
Num9(2) = E1
Num10(1) = Dor1234
Num10(2) = E1
Num11(1) = Dor1234
Num11(2) = E4
Num12(1) = Dor1234
Num12(2) = E3
Num13(1) = Dor1234
Num13(2) = E2
ImpostaGiocata 6,Num6,Ruote,Poste,CLP2,2
ImpostaGiocata 7,Num7,Ruote,Poste,CLP2,2
ImpostaGiocata 8,Num8,Ruote,Poste,CLP2,2
ImpostaGiocata 9,Num9,Ruote,Poste,CLP2,2
ImpostaGiocata 10,Num10,Ruote,Poste,CLP2,2
ImpostaGiocata 11,Num11,Ruote,Poste,CLP2,2
ImpostaGiocata 12,Num12,Ruote,Poste,CLP2,2
ImpostaGiocata 13,Num13,Ruote,Poste,CLP2,2
'Ambi sussidiari per due ruote
Num14(1) = Amb3
Num14(2) = Amb2
Num15(1) = Amb3
Num15(2) = E3
Num16(1) = Amb3
Num16(2) = E4
Num17(1) = Amb2
Num17(2) = E3
Num18(1) = Amb2
Num18(2) = E4
ImpostaGiocata 14,Num14,Ruote,Poste,CLP2,2
ImpostaGiocata 15,Num15,Ruote,Poste,CLP2,2
ImpostaGiocata 16,Num16,Ruote,Poste,CLP2,2
ImpostaGiocata 17,Num17,Ruote,Poste,CLP2,2
ImpostaGiocata 18,Num18,Ruote,Poste,CLP2,2
Gioca Es
End If
End If
End If
Next
Next
Next
Next
If ScriptInterrotto Then Exit Sub
Next
ScriviResoconto
Scrivi Space(50) & "Progetto - PROCEDIMENTO SUMMIT - by FABARRI"
Scrivi Space(50) & "Script - by Salvo50"
End Sub
Ultima modifica:
salvo50
Advanced Member >PLATINUM PLUS<
Secondo script, con i numeri raggruppati, in blocco
Codice:
'Progetto - PROCEDIMENTO SUMMIT - by FABARRI
'Modifica sulle ricerche e Script - by Salvo50
Sub Main
Dim R1,R2,P1,P2,P3,P4,Es,Esq,Caso,Casi
Dim FIn,Ini,Ruote(2),Tutte(1),Poste(2)
Dim Idestr,Col,Esqcol,Amb1,Amb2,Amb3
Dim E1,E2,E3,E4,Clp,Clpt
Dim Num1(5),Num2(8),Num3(2),Num4(2),Num5(2)
Dim Sor12,Sve13,Sin14,Sin23,Sve24,Sor34
Dim Dor12,Dve13,Din14,Din23,Dve24,Dor34
Dim Sor1234,Sve1324,Sin1423,Dor1234,Dve1324,Din1423
'poste(1) = 1
Poste(2) = 1
FIn = EstrazioneFin
Esq = InputBox("Inserisci l'estrazione che vuoi iniziare",Idestr,5395)
Clpt = CInt(InputBox("Per quanti colpi vuoi fare la ricerca per tutte le ruote?",,7))
Clp = CInt(InputBox("Per quanti colpi vuoi fare la ricerca su 2 ruote?",,7))
Col = CInt(InputBox(" Quante estrazioni vuoi controllare ",,5))
Esqcol = Esq + Col
If Esqcol > FIn Then Esqcol = FIn
For Es = Esq To Esqcol : Messaggio Es
Caso = 0
AvanzamentoElab Esq,Esqcol,Es
Scrivi
For R1 = 1 To 10
For R2 = R1 + 1 To 12
If R2 = 11 Then R2 = 12
For P1 = 1 To 3
P2 = P1 + 1
For P3 = P1 + 1 To 4
P4 = P3 + 1
E1 = Estratto(Es,R1,P1)
E2 = Estratto(Es,R1,P2)
E3 = Estratto(Es,R2,P3)
E4 = Estratto(Es,R2,P4)
'E1---E2
'| |
'| |
'E3---E4
If E3 > 0 Then
Sor12 = Fuori90(E1 + E2) : Sor34 = Fuori90(E3 + E4)
Sve13 = Fuori90(E1 + E3) : Sve24 = Fuori90(E2 + E4)
Sin14 = Fuori90(E1 + E4) : Sin23 = Fuori90(E2 + E3)
Sor1234 = Fuori90(Sor12 + Sor34)
Sve1324 = Fuori90(Sve13 + Sve24)
Sin1423 = Fuori90(Sin14 + Sin23)
If Sor1234 = Sve1324 And Sor1234 = Sin1423 Then
'-------------------------------------------------
Dor12 = Distanza(E1,E2) : If Dor12 = 90 Then Dor12 = 45
Dor34 = Distanza(E3,E4) : If Dor34 = 90 Then Dor34 = 45
Dve13 = Distanza(E1,E3) : If Dve13 = 90 Then Dve13 = 45
Dve24 = Distanza(E2,E4) : If Dve24 = 90 Then Dve24 = 45
Din14 = Distanza(E1,E4) : If Din14 = 90 Then Din14 = 45
Din23 = Distanza(E2,E3) : If Din23 = 90 Then Din23 = 45
Dor1234 = Distanza(Dor12,Dor34) : If Dor1234 = 90 Then Dor1234 = 45
Dve1324 = Distanza(Dve13,Dve24) : If Dve1324 = 90 Then Dve1324 = 45
Din1423 = Distanza(Din14,Din23) : If Din1423 = 90 Then Din1423 = 45
If Dor1234 = Dve1324 And Dor1234 = Din1423 Then
Amb1 = Sor1234 + Dor1234 : Amb2 = Amb1 / 2 : Amb3 = Sor1234 - Amb2
Caso = Caso + 1
Casi = Casi + 1
ColoreTesto 1
Scrivi String(89,"*") & " Casi Totali " & FormattaStringa(Casi,"0000")
ColoreTesto 2
Scrivi String(80,"*") & " Estrazione " &(Es) & " caso " & FormattaStringa(Caso,"0000")
ColoreTesto 0
Scrivi(" Estrazione n." & Format2(Es) & " del " & DataEstrazione(Es)),1,0
Scrivi " " & Left(NomeRuota(R1),2) & " " & StringaEstratti(Es,R1),1
Scrivi Space(20) & " Seconda Ruota " & Left(NomeRuota(R2),2) & " " & StringaEstratti(Es,R2),1
Scrivi
Scrivi " Ambi Base " & Space(6) & " Somme Oriz." & Space(3) & " Somme Vert." & Space(3) & "Somme Incr. ",0,0
Scrivi Space(10) & "Dist. oriz." & Space(3) & " Dist. Vert." & Space(3) & " Dist. Incr."
Scrivi " " & Format2(E1) & Space(1) & Format2(E2) & Space(16) & Format2(Sor12),0,0
Scrivi Space(12) & Format2(Sve13) & Space(12) & Format2(Sin14) & Space(21),0,0
Scrivi Format2(Dor12) & Space(12) & Format2(Dve13) & Space(12) & Format2(Din14)
'---------------------------------------------------------------------------------------------------
Scrivi " " & Format2(E3) & Space(1) & Format2(E4) & Space(16) & Format2(Sor34),0,0
Scrivi Space(12) & Format2(Sve24) & Space(12) & Format2(Sin23) & Space(21),0,0
Scrivi Format2(Dor34) & Space(12) & Format2(Dve24) & Space(12) & Format2(Din23)
Scrivi String(105,"-")
Scrivi " Somma delle Somme " & Format2(Sor1234) & Space(12) & Format2(Sve1324),0,0
Scrivi Space(12) & Format2(Sin1423) & " Dist. delle Dist. " & Format2(Dor1234) & Space(12),0,0
Scrivi Format2(Dve1324) & Space(12) & Format2(Din1423)
Scrivi
ColoreTesto 1
Scrivi " Ambi Per Tutte Le Ruote (" & Format2(E4) & " " & Format2(Sor1234) & ")-(" & Format2(E4),0,0
Scrivi " " & Format2(Dor1234) & ")-(" & Format2(E4) & " " & Format2(Amb2) & ")-(" & Format2(E4),0,0
Scrivi " " & Format2(Amb3) & ") Sussidiario (" & Format2(Amb2) & " " & Format2(Amb3) & ")"
Scrivi
ColoreTesto 7
Scrivi " Ambi Per Due Ruote (" & Format2(E4) & " " & Format2(Sor1234) & ")-(" & Format2(Sor1234),0,0
Scrivi " " & Format2(E3) & ")-(" & Format2(Sor1234) & " " & Format2(E2) & ")-(" & Format2(Sor1234),0,0
Scrivi " " & Format2(E1) & ")-(" & Format2(Dor1234) & " " & Format2(E1) & ")-(" & Format2(Dor1234),0,0
Scrivi " " & Format2(E4) & ")-(" & Format2(Dor1234) & " " & Format2(E3) & ")-(" & Format2(Dor1234),0,0
Scrivi " " & Format2(E2) & ")"
Scrivi
Scrivi " Sussidiari (" & Format2(Amb2) & " " & Format2(Amb3) & ")-(" & Format2(Amb3),0,0
Scrivi " " & Format2(E3) & ")-(" & Format2(Amb3) & " " & Format2(E4) & ")-(" & Format2(Amb2),0,0
Scrivi " " & Format2(E3) & ")-(" & Format2(Amb2) & " " & Format2(E4) & ")"
Scrivi
ColoreTesto 0
Ruote(1) = R1
Ruote(2) = R2
Tutte(1) = TU_
Num1(1) = E4
Num1(2) = Sor1234
Num1(3) = Dor1234
Num1(4) = Amb2
Num1(5) = Amb3
EliminaRipetuti Num1
ImpostaGiocata 1,Num1,Tutte,Poste,Clpt,2
Num2(1) = Sor1234
Num2(2) = Dor1234
Num2(3) = E4
Num2(4) = E3
Num2(5) = E2
Num2(6) = E1
Num2(7) = Amb2
Num2(8) = Amb3
EliminaRipetuti Num2
ImpostaGiocata 2,Num2,Ruote,Poste,Clp,2
Gioca Es
End If
End If
End If
Next
Next
Next
Next
Next
ScriviResoconto
End Sub
Ultima modifica:
Matematico
Advanced Member >PLATINUM<
Ciao salvo50, complimenti sia per i tuoi ottimi script e metodi postati 
Ti chiedo una cortesia....puoi aiutarmi per una modifica al listato da me postato a questo link?
https://forum.lottoced.com/forum/lo...ravissimi-scriptologi-un-aiutino-per-modifica
A buon rendere, se ti interessa ho vari metodi di grandi autori che si potrebbero trasformare in listati da testare ai giorni nostri
Ti chiedo una cortesia....puoi aiutarmi per una modifica al listato da me postato a questo link?
https://forum.lottoced.com/forum/lo...ravissimi-scriptologi-un-aiutino-per-modifica
A buon rendere, se ti interessa ho vari metodi di grandi autori che si potrebbero trasformare in listati da testare ai giorni nostri
Ultima estrazione Lotto
-
Estrazione del lotto
venerdì 19 aprile 2024Bari3905818973Cagliari5621019003Firenze0556682709Genova4250902783Milano1671298504Napoli2919236350Palermo3554335761Roma1729435574Torino6960030126Venezia0557594334Nazionale3043646521Estrazione Simbolotto
Genova
0220251219
