SIMMETRIE FREQUENTI:

[antoR]

SIMMETRIE FREQUENTI

Si parla delle terzine simmetriche a passo 30;
nel quadro estrazionale bisogna rilevare,su una qualsiasi ruota,un ambo facente parte di una terzina simmetrica e su un altra ruota, un numero ripetuto dell'ambo base.

per la spiegazione,prendo ad esempio un caso reale;

27/08/09
VE 88 -
NAZ 58-88

Ambata : numero ripetuto 88
ambi secchi:88-28(numero mancante della terzina simmetrica)
28-86(somma dei numeri ripetuti
terzina;88-58(ambo base)+56(somma ambo base)
quartina;88-56(somma ambo base)-13-43(diametrali distanza 45 dei numeri dell ambo base)

ricapitoliamo giocare su VE/NAZ
88 ambata
88-28/28-86;88-58-56;88-56-13-43;

esito strepitoso,
1 colpo VE 88 ambata
ambo secco 88-28;
ambo in terzina 88-56;
al 5 colpo si è ripetuto l'ambo secco 88-28 sulla NAZ. Giocare per 9 colpi.
Chiedo ai signori scripters se fosse possibile avere uno script che trovasse queste combinazioni e che automaticamente darebbe le previsioni e quali sono stati i risulati in precedenza.
Un grazie anticipato

 

[Mike58]

Ciao AntoR, mi sembra ovvio che i metodi datati perdono in media il 50% del andamento economico.
Vedi un po come gestirla le condizioni sono trovate ed i calcoli mi sembrano corretti

prova e verifica.

Sub Main
	Dim nu(2),ru(2),n1(1),n2(1),anum(6),posta(1),poste(3),ab(1)
	posta(1) = 1
	poste(2) = 1.5
	poste(3) = .5
	Ini = 8109
	fin = EstrazioneFin
	For es = Ini To fin
		For r1 = 1 To 12
			For r2 = 1 To 12
				If r2 = 11 Then r2 = 12
				If r1 = 11 Then r1 = 12
				If r1 <> r2 Then
					For p1 = 1 To 4
						For p2 = p1 + 1 To 5
							a = Estratto(es,r1,p1)
							b = Estratto(es,r1,p2)
							For p3 = 1 To 5
								c = Estratto(es,r2,p3)
								If Distanza(a,b) = 30 And Distanza(a,c) = 30 Or Distanza(a,c) = 60 Then
									Call Messaggio("A T T E N D E R E . . . . . " & "       script by Mike58 ")
									Call AvanzamentoElab(Ini,fin,es)
									k = k + 1
									If c = a Or c = b Then
										If c = a Then nc = a
										If c = b Then nc = b
										If c <> a Then solo = a
										If c <> b Then solo = b
										If p1 = p3 Or p2 = p3 Then
											If Differenza(a,b) = 30 Then dd =(Massimo(a,b) + 30)
											If Differenza(a,b) = 60 Then dd =(Massimo(a,b) - 30)
											nu(1) = a
											nu(2) = b
											n1(1) = c
											n2(1) = Fuori90(dd)
											'------- numeri in gioco -------------
											anum(1) = nc
											anum(2) = n2(1)
											anum(3) = Fuori90(nu(1) + nu(2))
											anum(4) = Fuori90(nc*2)
											anum(5) = Diametrale(nu(1))
											anum(6) = Diametrale(nu(2))
											ru(1) = r1
											ru(2) = r2
											ab(1) = nc
											Scrivi String(130,"="),1
											Scrivi GetInfoEstrazione(es) & vbTab,0,0
											Scrivi SiglaRuota(r1) & vbTab & StringaEstratti(es,r1) & vbTab & StringaNumeri(nu,,1),0,0
											Scrivi vbTab & " Posiz : " & p1 & "/" & p2
											Scrivi GetInfoEstrazione(es) & vbTab,0,0
											Scrivi SiglaRuota(r2) & vbTab & StringaEstratti(es,r2) & vbTab & StringaNumeri(n1,,1),0,0
											Scrivi vbTab & " Posiz.: " & p3
											Scrivi String(40," ") & "Numero Mancante...." & n2(1),1
											Scrivi "Numero comune : " & nc & " Isolato... " & solo
											Scrivi
											Scrivi "Sestina.... " & StringaNumeri(anum,,1)
											Scrivi String(125,"-") & " Caso n. " & k
											ImpostaGiocata 1,ab,ru,posta,10
											ImpostaGiocata 2,anum,ru,poste,10
											Gioca es,1,,1
										End If
									End If
								End If
							Next
						Next
					Next
				End If
			Next
		Next
	Next
	ScriviResoconto
End Sub

 

[LuigiB]

ciao , ogni tanto faccio qualche script pure io e aiuto ad esaudire le richieste

Option Explicit
Class clsAmbo
	Private aN
	Private mRuota
	Sub SetNumeriERuota(aNum,r)
		ReDim aN(2)
		aN(1) = aNum(1)
		aN(2) = aNum(2)
		mRuota = r
	End Sub
	Sub GetArrayNum(aNRet)
		ReDim aNRet(2)
		aNRet(1) = aN(1)
		aNRet(2) = aN(2)
	End Sub
	Public Property Get Ruota
		Ruota = mRuota
	End Property
End Class
Sub Main
	
	Dim idEstr,Ruota
	Dim Inizio,Fine
	Dim clsA
	Dim coll
	Dim aNumeri
	Dim aRuoteRip
	Dim aNumeriRip
	Dim nGiocata,nDurata
	ReDim aRuoteAmmesseRilev(0)
	ReDim aBRuoteAmmesseRilev(0)
	Dim nRuoteSel
	Inizio = EstrazioneIni
	Fine = EstrazioneFin
	nRuoteSel = ScegliRuote(aRuoteAmmesseRilev,aBRuoteAmmesseRilev)
	nDurata = 25
	If nRuoteSel > 0 Then
		For idEstr = Inizio To Fine
			Call GetAmbiTerzineSimmetriche(idEstr,coll,aBRuoteAmmesseRilev)
			For Each clsA In coll
				Call clsA.GetArrayNum(aNumeri)
				Call GetArrayRuoteNumRip(idEstr,aRuoteRip,aNumeriRip,aNumeri,clsA.Ruota)
				Call GiocaCondTrovata(idEstr,aNumeri,aRuoteRip,aNumeriRip,clsA.Ruota,nGiocata,nDurata)
			Next
			Call AvanzamentoElab(Inizio,Fine,idEstr)
			If ScriptInterrotto Then Exit For
		Next
		Call ScriviResoconto
	End If
End Sub
Function GetAmbiTerzineSimmetriche(idEstr,coll,aBRuoteAmmesseRilev)
	Dim r,e,y
	Dim aN
	Dim aBNum
	Dim nNumCercato
	Dim nNumTrovati
	Dim clsA
	Set coll = GetNewCollection
	For r = 1 To 12
		If r <> 11 Then
			If aBRuoteAmmesseRilev(r) Then
				Call GetArrayNumeriRuota(idEstr,r,aN)
				aBNum = ArrayNumeriToBool(aN)
				For e = 1 To 5
					nNumTrovati = 1
					ReDim aNumTrov(nNumTrovati)
					aNumTrov(nNumTrovati) = aN(e)
					nNumCercato = Fuori90(aN(e) + 30)
					If aBNum(nNumCercato) Then
						If aBNum(Fuori90(nNumCercato + 30)) = False Then
							nNumTrovati = nNumTrovati + 1
							ReDim Preserve aNumTrov(nNumTrovati)
							aNumTrov(nNumTrovati) = nNumCercato
							aBNum(aN(e)) = 0
						End If
					Else
						nNumCercato = Fuori90(aN(e) + 60)
						If aBNum(nNumCercato) Then
							nNumTrovati = nNumTrovati + 1
							ReDim Preserve aNumTrov(nNumTrovati)
							aNumTrov(nNumTrovati) = nNumCercato
							aBNum(aN(e)) = 0
						End If
					End If
					If nNumTrovati = 2 Then
						Set clsA = New clsAmbo
						Call clsA.SetNumeriERuota(aNumTrov,r)
						coll.Add clsA
					End If
				Next
			End If
		End If
	Next
End Function
Function GetNumMancanteTerzSimm(aN)
	Dim aBNum
	Dim nNumCercato
	Dim K
	aBNum = ArrayNumeriToBool(aN)
	For K = 1 To 2
		nNumCercato = Fuori90(aN(1) + 30*K)
		If Not aBNum(nNumCercato) Then
			GetNumMancanteTerzSimm = nNumCercato
			Exit For
		End If
	Next
End Function
Function GetArrayRuoteNumRip(idEstr,aRuoteRip,aNumRip,aNumeri,RuotaBase)
	Dim r,e
	Dim aBNum
	Dim nRuoteTrov
	Dim nNumTrov
	Dim Num
	nRuoteTrov = 0
	ReDim aRuoteRip(nRuoteTrov)
	ReDim aNumRip(nRuoteTrov)
	aBNum = ArrayNumeriToBool(aNumeri)
	For r = 1 To 12
		If r <> 11 And r <> RuotaBase Then
			nNumTrov = 0
			ReDim aNumTrov(nNumTrov)
			For e = 1 To 5
				Num = Estratto(idEstr,r,e)
				If aBNum(Num) Then
					nNumTrov = nNumTrov + 1
					ReDim Preserve aNumTrov(nNumTrov)
					aNumTrov(nNumTrov) = Num
				End If
			Next
			If nNumTrov = 1 Then
				nRuoteTrov = nRuoteTrov + 1
				ReDim Preserve aRuoteRip(nRuoteTrov)
				aRuoteRip(nRuoteTrov) = r
				ReDim Preserve aNumRip(nRuoteTrov)
				aNumRip(nRuoteTrov) = aNumTrov(nNumTrov)
			End If
		End If
	Next
	GetArrayRuoteNumRip = nRuoteTrov
End Function
Sub GiocaCondTrovata(idEstr,aNumeri,aRuoteRip,aNumeriRip,RuotaBase,nGiocata,nDurata)

	'SIMMETRIE FREQUENTI
	'
	'Si parla delle terzine simmetriche a passo 30;
	'nel quadro estrazionale bisogna rilevare,su una qualsiasi ruota,un ambo facente parte di una terzina simmetrica e su un altra ruota, un numero ripetuto dell'ambo base.
	'
	'per la spiegazione,prendo ad esempio un caso reale;
	'
	'27/08/09
	'VE 88 -
	'NAZ 58-88
	'
	'Ambata : numero ripetuto 88
	'ambi secchi:88-28(numero mancante della terzina simmetrica)
	'28-86(somma dei numeri ripetuti
	'terzina;88-58(ambo Base)+56(somma ambo Base)
	'quartina;88-56(somma ambo Base)-13-43(diametrali Distanza 45 dei numeri dell ambo Base)
	'
	'ricapitoliamo giocare su VE/NAZ
	'88 ambata
	'88-28/28-86;88-58-56;88-56-13-43;
	
	
	ReDim aRuote(2)
	Dim nNumMancTerzSimm
	Dim nSommaAmboBase
	Dim k
	ReDim aRetRighe(0)
	ReDim aPoste(0)
	Dim nColpo
	nNumMancTerzSimm = GetNumMancanteTerzSimm(aNumeri)
	aRuote(1) = RuotaBase
	nSommaAmboBase = Fuori90(aNumeri(1) + aNumeri(2))
	For k = 1 To UBound(aRuoteRip)
		aRuote(2) = aRuoteRip(k)
		Call Scrivi(String(100,"*"))
		Call Scrivi(GetInfoEstrazione(idEstr),True)
		Call Scrivi("Ruota di Rilevamento    : " & NomeRuota(RuotaBase))
		Call Scrivi("Ambo terzina simmetrica : " & StringaNumeri(aNumeri))
		Call Scrivi("Ruota con num. ripetuto : " & NomeRuota(aRuote(2)) & " " & aNumeriRip(k))
		Call Scrivi("Numero manc. terz simm. : " & nNumMancTerzSimm)
		Call Scrivi()
		Call Scrivi()


		' ambata  numero ripetuto 88
		ReDim aNum(1)
		aNum(1) = aNumeriRip(k)
		nGiocata = nGiocata + 1
		ReDim aPoste(5)
		aPoste(1) = 1
		Call ImpostaGiocata(nGiocata,aNum,aRuote,aPoste,nDurata,1)
		Call GetVettoreProgressione(1,1,2,nDurata,aPoste,aRetRighe)
		ReDim aPosteProg(10,nDurata)
		For nColpo = 1 To nDurata
			aPosteProg(1,nColpo) = aPoste(nColpo)
		Next
		Call ImpostaProgressione(nGiocata,aPosteProg)
		
		
		'ambi secchi:88-28(numero mancante della terzina simmetrica)
		ReDim aPoste(5)
		aPoste(2) = 1
		ReDim aNum(2)
		aNum(1) = aNumeriRip(k)
		aNum(2) = nNumMancTerzSimm
		
		nGiocata = nGiocata + 1
		Call ImpostaGiocata(nGiocata,aNum,aRuote,aPoste,nDurata,2)
		
		'ambi secchi:28-86(somma dei numeri ripetuti)
		ReDim aPoste(5)
		aPoste(2) = 1
		ReDim aNum(2)
		aNum(1) = nNumMancTerzSimm
		aNum(2) = Fuori90(aNumeriRip(k)*2)
		
		nGiocata = nGiocata + 1
		Call ImpostaGiocata(nGiocata,aNum,aRuote,aPoste,nDurata,2)
		

		
		
		'terzina;88-58(ambo base)+56(somma ambo base)
		ReDim aPoste(5)
		aPoste(2) = 1
		ReDim aNum(3)
		aNum(1) = aNumeri(1)
		aNum(2) = aNumeri(2)
		aNum(3) = nSommaAmboBase
		nGiocata = nGiocata + 1
		Call ImpostaGiocata(nGiocata,aNum,aRuote,aPoste,nDurata,2)
		'quartina;88-56(somma ambo base)-13-43(diametrali distanza 45 dei numeri dell ambo base)
		ReDim aPoste(5)
		aPoste(2) = 1
		ReDim aNum(4)
		aNum(1) = aNumeriRip(k)
		aNum(2) = nSommaAmboBase
		'aNum(3) = Diametrale(aNum(1))
		'aNum(4) = Diametrale(aNum(2))
		aNum(3) = Diametrale(aNumeri(1))
		aNum(4) = Diametrale(aNumeri(2))
		

		nGiocata = nGiocata + 1
		Call ImpostaGiocata(nGiocata,aNum,aRuote,aPoste,nDurata,2)
		Call Gioca(idEstr,True)
	Next
	Call Scrivi()
	Call Scrivi()
End Sub

 

[LuigiB]

acc scusa mike non avevo visto che gia avevi sistemato tu la faccenda ..

comunque ho fatto una correzione perche avevo interpretato male delle cose .. anche nella spiegazione c'è un errore
i diametrali di 88.56 sono 43 e 11 non 43 e 13

 

[Mike58]

nessun acc... c'è l'occasione per studiarmi il tuo script, vedo che hai messo una redim preserve ( che se anche semplice non mi entra in testa come concetto e facile utilizzo ).

AntoR, ne sarà contento.

Ciao

 

[LuigiB]

ricopia lo script che avevo nterpretato male delle cose .. ciao

 

[Mike58]

comunque ho fatto una correzione perche avevo interpretato male delle cose .. anche nella spiegazione c'è un errore
i diametrali di 88.56 sono 43 e 11 non 43 e 13

Non so se hai interpretato male prima, infatti si parlava di diametrale dell'ambo base e cioe 88-58.

vediamo cosa dice il richiedente.

 

[LuigiB]

mmm hia ragione Mike ho riricorretto lo script .. è molto probabile che mi sia confuso io.

 

[i legend]

grazie Mike grazie Luigi, per il materiale di studio che ci fornite
Siete Mitici

 

[antoR]

Un grazie infinito...lo script funziona perfettamente anche se la resa è al di sotto delle aspettative...

 

[antoR]

Grazie Luigi per la tua celerità....solo che lo script mi da errore
Call GetVettoreProgressione(1,1,2,nDurata,aPoste,aRetRighe)

 

[antoR]

Si Mike è esatto, il diametrale e quello dell'ambo base 88-58.... Vorrei chiedere se fosse possibile inserire nello script il comando per impostare un range di estrazione

 

[LuigiB]

ciao lo script ti da errore perche avrai una versione vecchia di spaziometria...sicuro come il sole...

io ti consiglio di aggiornare il programma , in alternativa

metti un apice davanti tutte queste righe

		Call GetVettoreProgressione(1,1,2,nDurata,aPoste,aRetRighe)
		ReDim aPosteProg(10,nDurata)
		For nColpo = 1 To nDurata
			aPosteProg(1,nColpo) = aPoste(nColpo)
		Next
		Call ImpostaProgressione(nGiocata,aPosteProg)

 

[Mike58]

Ciao, intanto consiglio anche io di aggiornare sempre alle ultime versioni del programma per non essere sempre ripetitivi nelle casistiche di errori.

Poi eccoti il mio script con l'imput box della scelta estrazioni da controllare + elenco giocate finali.

Sub Main
	Dim nu(2),ru(2),n1(1),n2(1),anum(6),posta(1),poste(3),ab(1)
	posta(1) = 1
	poste(2) = 1.5
	poste(3) = .5
	Scrivi " ******** Metodo dei Simmetrici ***** AntoR ***** Forum LottoCed ***** Script By Mike58 ****** ",1,1,3,1,3
	Scrivi
	
	qt = CInt(InputBox("QUANTE ESTRAZIONI CONTROLLO",,100))
	Ini = EstrazioneFin-qt
	fin = EstrazioneFin
	For es = Ini To fin
		For r1 = 1 To 12
			For r2 = 1 To 12
				If r2 = 11 Then r2 = 12
				If r1 = 11 Then r1 = 12
				If r1 <> r2 Then
					For p1 = 1 To 4
						For p2 = p1 + 1 To 5
							a = Estratto(es,r1,p1)
							b = Estratto(es,r1,p2)
							For p3 = 1 To 5
								c = Estratto(es,r2,p3)
								If Distanza(a,b) = 30 And Distanza(a,c) = 30 Or Distanza(a,c) = 60 Then
									Call Messaggio("A T T E N D E R E . . . . . " & "       script by Mike58 ")
									Call AvanzamentoElab(Ini,fin,es)
									k = k + 1
									If c = a Or c = b Then
										If c = a Then nc = a
										If c = b Then nc = b
										If c <> a Then solo = a
										If c <> b Then solo = b
										If p1 = p3 Or p2 = p3 Then
											If Differenza(a,b) = 30 Then dd =(Massimo(a,b) + 30)
											If Differenza(a,b) = 60 Then dd =(Massimo(a,b) - 30)
											nu(1) = a
											nu(2) = b
											n1(1) = c
											n2(1) = Fuori90(dd)
											'------- numeri in gioco -------------
											anum(1) = nc
											anum(2) = n2(1)
											anum(3) = Fuori90(nu(1) + nu(2))
											anum(4) = Fuori90(nc*2)
											anum(5) = Diametrale(nu(1))
											anum(6) = Diametrale(nu(2))
											ru(1) = r1
											ru(2) = r2
											ab(1) = nc
											Scrivi String(130,"="),1
											Scrivi GetInfoEstrazione(es) & vbTab,0,0
											Scrivi SiglaRuota(r1) & vbTab & StringaEstratti(es,r1) & vbTab & StringaNumeri(nu,,1),0,0
											Scrivi vbTab & " Posiz : " & p1 & "/" & p2
											Scrivi GetInfoEstrazione(es) & vbTab,0,0
											Scrivi SiglaRuota(r2) & vbTab & StringaEstratti(es,r2) & vbTab & StringaNumeri(n1,,1),0,0
											Scrivi vbTab & " Posiz.: " & p3
											Scrivi String(40," ") & "Numero Mancante...." & n2(1),1
											Scrivi "Numero comune : " & nc & " Isolato... " & solo
											Scrivi
											Scrivi "Sestina.... " & StringaNumeri(anum,,1)
											Scrivi String(125,"-") & " Caso n. " & k
											ImpostaGiocata 1,ab,ru,posta,10
											ImpostaGiocata 2,anum,ru,poste,10
											Gioca es,1,,1
										End If
									End If
								End If
							Next
						Next
					Next
				End If
			Next
		Next
	Next
	ScriviResoconto
	elencogiocate
End Sub
Function elencogiocate
	ReDim aT(8)
	aT(1) = "NumGiocata"
	aT(2) = "Colpo"
	aT(3) = "Spesa"
	aT(4) = "SpesaParz"
	aT(5) = "Vincita"
	aT(6) = "VincitaParz"
	aT(7) = " Utile totale "
	aT(8) = " Utile Parz "
	Call InitTabella(aT,1,,3,5)
	For k = 1 To GetQuantitaGiocateEffettuate
		If GetSituazioneGiocate(k,RetColpo,RetSpesa,RetSpesaParz,RetVincita,RetVincitaParz) Then
			aT(1) = k
			aT(2) = RetColpo
			aT(3) = RetSpesa
			aT(4) = RetSpesaParz
			aT(5) = RetVincita
			aT(6) = RetVincitaParz
			aT(7) = Round(aT(5) - aT(3),2)
			aT(8) = Round(aT(6) - aT(4),2)
			Call AddRigaTabella(aT,,,3)
			If retcolpo > 0 Then Call SetColoreCella(2,3,0)
			If aT(7) > 0 Then Call SetColoreCella(7,4,2)
			If aT(7) < 0 Then Call SetColoreCella(7,2,4)
			If aT(8) > 0 Then Call SetColoreCella(8,4,2)
			If aT(8) < 0 Then Call SetColoreCella(8,2,4)
		End If
	Next
	Call CreaTabella
End Function

la stessa cosa può essere ripetuta sullo script di luigi.