Richiesta script x spaziometria

[Dragon zf]

Questo e' il metodo.Grazie.

 

[Dragon zf]

Ovviamente prendendo in considerazione tutte le figure.

 

[AlessandroPe74]

' =================================================================================
' Script: Ricerca Automatica Trapezio Ciclometrico (Tutte le Ruote)
' Note: Il listato scansiona automaticamente tutte le ruote per individuare
' la condizione del trapezio e calcolare lo sviluppo ciclometrico.
' =================================================================================

Option Explicit

Sub Main()
Dim idEstr As Long
Dim r1, r2 As Integer
Dim aNum(4) As Integer
Dim d1, d2, d3, d4 As Integer
Dim nEstrInizio As Long
Dim aTuttiNumeri(10) As Integer

' Imposta l'archivio da analizzare (es. ultime 50 estrazioni per velocità)
nEstrInizio = EstrazioniArchivio - 50

Call Scrivi("Ricerca Automatica Trapezio Ciclometrico - Tutte le Ruote")
Call Scrivi("----------------------------------------------------------------------")

For idEstr = nEstrInizio To EstrazioniArchivio

' Ciclo automatico su tutte le ruote (1=Bari ... 12=Nazionale)
For r1 = 1 To 12
For r2 = r1 + 1 To 12

Call GetNumeriUniti(idEstr, r1, r2, aTuttiNumeri)

' Analisi delle combinazioni di 4 numeri sui 10 totali delle due ruote
Dim i, j, l, m As Integer
For i = 0 To 7
For j = i + 1 To 8
For l = j + 1 To 9
For m = l + 1 To 10
' Selezione dei 4 numeri
aNum(1) = aTuttiNumeri(i)
aNum(2) = aTuttiNumeri(j)
aNum(3) = aTuttiNumeri(l)
aNum(4) = aTuttiNumeri(m)

Call OrdinaMatrice(aNum, 1)

' Calcolo distanze ciclometriche
d1 = DistanzaCiclometrica(aNum(1), aNum(2))
d2 = DistanzaCiclometrica(aNum(2), aNum(3))
d3 = DistanzaCiclometrica(aNum(3), aNum(4))
d4 = DistanzaCiclometrica(aNum(4), aNum(1))

' Verifica condizione Trapezio
If VerificaStrutturaTrapezio(d1, d2, d3, d4) Then
Call Scrivi("--------------------------------------------------")
Call Scrivi("Trovata condizione in data: " & GetInfoEstrazione(idEstr))
Call Scrivi("Ruote: " & NomeRuota(r1) & " - " & NomeRuota(r2))
Call Scrivi("Numeri (Trapezio): " & StringaNumeri(aNum))
Call Scrivi("Distanze: " & d1 & "-" & d2 & "-" & d3 & "-" & d4)
Call CalcolaSviluppoCiclometrico(aNum)
End If
Next
Next
Next
Next

Next
Next
Call AvanzamentoElab(nEstrInizio, EstrazioniArchivio, idEstr)
If ScriptInterrotto Then Exit For
Next

Call Scrivi("Ricerca completata.")
End Sub

Function VerificaStrutturaTrapezio(d1, d2, d3, d4) As Boolean
Dim aD(4)
aD(1) = d1 : aD(2) = d2 : aD(3) = d3 : aD(4) = d4
Call OrdinaMatrice(aD, 1)

' Condizione di geometria: i tre lati minori sono uguali
If (aD(1) = aD(2) And aD(2) = aD(3)) Or (aD(2) = aD(3) And aD(3) = aD(4)) Then
VerificaStrutturaTrapezio = True
Else
VerificaStrutturaTrapezio = False
End If
End Function

Sub CalcolaSviluppoCiclometrico(aNumeri)
Dim nEstratto1, nEstratto2, nAmbo1, nAmbo2, nAmbo3

' Sviluppo ciclometrico puro (Somme e chiusure geometriche)
nEstratto1 = Fuori90(aNumeri(1) + aNumeri(4))
nEstratto2 = Fuori90(aNumeri(2) + aNumeri(3))

nAmbo1 = aNumeri(1)
nAmbo2 = aNumeri(3)
nAmbo3 = Fuori90(nEstratto1 + nEstratto2 + aNumeri(2))

Call Scrivi("Previsione Sviluppo Ciclometrico:")
Call Scrivi("Estratti: " & nEstratto1 & " - " & nEstratto2)
Call Scrivi("Ambo e Terno: " & nAmbo1 & "." & nAmbo2 & "." & nAmbo3)
End Sub

Sub GetNumeriUniti(idEstr, r1, r2, aTuttiNumeri)
Dim k, x
x = 0
For k = 1 To 5
aTuttiNumeri(x) = Estratto(idEstr, r1, k)
x = x + 1
Next
For k = 1 To 5
aTuttiNumeri(x) = Estratto(idEstr, r2, k)
x = x + 1
Next
End Sub

 

[Dragon zf]

' =================================================================================
' Script: Ricerca Automatica Trapezio Ciclometrico (Tutte le Ruote)
' Note: Il listato scansiona automaticamente tutte le ruote per individuare
' la condizione del trapezio e calcolare lo sviluppo ciclometrico.
' =================================================================================

Option Explicit

Sub Main()
Dim idEstr As Long
Dim r1, r2 As Integer
Dim aNum(4) As Integer
Dim d1, d2, d3, d4 As Integer
Dim nEstrInizio As Long
Dim aTuttiNumeri(10) As Integer

' Imposta l'archivio da analizzare (es. ultime 50 estrazioni per velocità)
nEstrInizio = EstrazioniArchivio - 50

Call Scrivi("Ricerca Automatica Trapezio Ciclometrico - Tutte le Ruote")
Call Scrivi("----------------------------------------------------------------------")

For idEstr = nEstrInizio To EstrazioniArchivio

' Ciclo automatico su tutte le ruote (1=Bari ... 12=Nazionale)
For r1 = 1 To 12
For r2 = r1 + 1 To 12

Call GetNumeriUniti(idEstr, r1, r2, aTuttiNumeri)

' Analisi delle combinazioni di 4 numeri sui 10 totali delle due ruote
Dim i, j, l, m As Integer
For i = 0 To 7
For j = i + 1 To 8
For l = j + 1 To 9
For m = l + 1 To 10
' Selezione dei 4 numeri
aNum(1) = aTuttiNumeri(i)
aNum(2) = aTuttiNumeri(j)
aNum(3) = aTuttiNumeri(l)
aNum(4) = aTuttiNumeri(m)

Call OrdinaMatrice(aNum, 1)

' Calcolo distanze ciclometriche
d1 = DistanzaCiclometrica(aNum(1), aNum(2))
d2 = DistanzaCiclometrica(aNum(2), aNum(3))
d3 = DistanzaCiclometrica(aNum(3), aNum(4))
d4 = DistanzaCiclometrica(aNum(4), aNum(1))

' Verifica condizione Trapezio
If VerificaStrutturaTrapezio(d1, d2, d3, d4) Then
Call Scrivi("--------------------------------------------------")
Call Scrivi("Trovata condizione in data: " & GetInfoEstrazione(idEstr))
Call Scrivi("Ruote: " & NomeRuota(r1) & " - " & NomeRuota(r2))
Call Scrivi("Numeri (Trapezio): " & StringaNumeri(aNum))
Call Scrivi("Distanze: " & d1 & "-" & d2 & "-" & d3 & "-" & d4)
Call CalcolaSviluppoCiclometrico(aNum)
End If
Next
Next
Next
Next

Next
Next
Call AvanzamentoElab(nEstrInizio, EstrazioniArchivio, idEstr)
If ScriptInterrotto Then Exit For
Next

Call Scrivi("Ricerca completata.")
End Sub

Function VerificaStrutturaTrapezio(d1, d2, d3, d4) As Boolean
Dim aD(4)
aD(1) = d1 : aD(2) = d2 : aD(3) = d3 : aD(4) = d4
Call OrdinaMatrice(aD, 1)

' Condizione di geometria: i tre lati minori sono uguali
If (aD(1) = aD(2) And aD(2) = aD(3)) Or (aD(2) = aD(3) And aD(3) = aD(4)) Then
VerificaStrutturaTrapezio = True
Else
VerificaStrutturaTrapezio = False
End If
End Function

Sub CalcolaSviluppoCiclometrico(aNumeri)
Dim nEstratto1, nEstratto2, nAmbo1, nAmbo2, nAmbo3

' Sviluppo ciclometrico puro (Somme e chiusure geometriche)
nEstratto1 = Fuori90(aNumeri(1) + aNumeri(4))
nEstratto2 = Fuori90(aNumeri(2) + aNumeri(3))

nAmbo1 = aNumeri(1)
nAmbo2 = aNumeri(3)
nAmbo3 = Fuori90(nEstratto1 + nEstratto2 + aNumeri(2))

Call Scrivi("Previsione Sviluppo Ciclometrico:")
Call Scrivi("Estratti: " & nEstratto1 & " - " & nEstratto2)
Call Scrivi("Ambo e Terno: " & nAmbo1 & "." & nAmbo2 & "." & nAmbo3)
End Sub

Sub GetNumeriUniti(idEstr, r1, r2, aTuttiNumeri)
Dim k, x
x = 0
For k = 1 To 5
aTuttiNumeri(x) = Estratto(idEstr, r1, k)
x = x + 1
Next
For k = 1 To 5
aTuttiNumeri(x) = Estratto(idEstr, r2, k)
x = x + 1
Next
End Sub

 

[Dragon zf]

Perche' esce cosi'?

 

[AlessandroPe74]

C'e' una linea da correggere

 

[Dragon zf]

C'e' una linea da correggere

Come devo fare? Mi scusi ma non ne capisco di queste cose...

 

[Dragon zf]

e' possibile avere script x spaziometria anche di questi? Tenendo in considerazione tutte le figure e la condizione con un estrazione a ritroso.Grazie.

 

[InRicordo]

Come devo fare? Mi scusi ma non ne capisco di queste cose...

Io ne capisco ancora meno, ma non sia MAI detto che, grazie all'intelligenza artificiale non ci provo!
Ho preso lo Script non funzionante, ho mostrato alla AI l'errore che usciva (e tutti quelli che uscivano corretto il primo errore)
dopo molti tentativi (in cui lo Script mi dava anche la ricetta della Polenta Concia!), alla fine ha tirato fuori questo.
Se sia quello che desideravi, o altro, non lo so. Guarda se può esserti utile e, in caso contrario, speriamo che qualcuno intrvenga.
Ciao


' =================================================================================
' Script: Ricerca Automatica Trapezio Ciclometrico (Tutte le Ruote)
' Note: Il listato scansiona automaticamente tutte le ruote per individuare
' la condizione del trapezio e calcolare lo sviluppo ciclometrico.
' Aggiunta: verifica esiti (ambata/ambo/terno) entro 9 colpi su r1/r2,
' con riepilogo statistico finale (Vinte/Perse/Sospese).
' =================================================================================
Option Explicit

Sub Main()
Dim idEstr
Dim r1, r2
Dim aNum(4)
Dim d1, d2, d3, d4
Dim nEstrInizio
Dim aTuttiNumeri(10)
Dim i, j, l, m
Dim nEstr1, nEstr2, nAmboA, nAmboB, nAmboC
Dim nTotPrevisioni
Dim nAmbateVinte, nAmbatePerse, nAmbateSospese
Dim nAmboVinti, nAmboPersi, nAmboSospesi
Dim nTernoVinti, nTernoPersi, nTernoSospesi
Dim nConcluse, nPct

' Imposta l'archivio da analizzare (es. ultime 50 estrazioni per velocità)
nEstrInizio = EstrazioniArchivio - 50

nTotPrevisioni = 0
nAmbateVinte = 0 : nAmbatePerse = 0 : nAmbateSospese = 0
nAmboVinti = 0 : nAmboPersi = 0 : nAmboSospesi = 0
nTernoVinti = 0 : nTernoPersi = 0 : nTernoSospesi = 0

Call Scrivi("Ricerca Automatica Trapezio Ciclometrico - Tutte le Ruote")
Call Scrivi("----------------------------------------------------------------------")

For idEstr = nEstrInizio To EstrazioniArchivio

' Ciclo automatico su tutte le ruote reali, escludendo la pseudo-ruota
' virtuale "Tutte" (qualunque sia il suo indice numerico nel motore).
For r1 = 1 To 12
If LCase(NomeRuota(r1)) <> "tutte" Then
For r2 = r1 + 1 To 12
If LCase(NomeRuota(r2)) <> "tutte" Then
Call GetNumeriUniti(idEstr, r1, r2, aTuttiNumeri)

' Analisi delle combinazioni di 4 numeri sui 10 totali delle due ruote
' (indici validi 0-9, quindi l'ultimo indice "m" deve fermarsi a 9)
For i = 0 To 6
For j = i + 1 To 7
For l = j + 1 To 8
For m = l + 1 To 9
' Selezione dei 4 numeri
aNum(1) = aTuttiNumeri(i)
aNum(2) = aTuttiNumeri(j)
aNum(3) = aTuttiNumeri(l)
aNum(4) = aTuttiNumeri(m)
Call OrdinaMatrice(aNum, 1)

' Calcolo distanze ciclometriche
d1 = DistanzaCiclometrica(aNum(1), aNum(2))
d2 = DistanzaCiclometrica(aNum(2), aNum(3))
d3 = DistanzaCiclometrica(aNum(3), aNum(4))
d4 = DistanzaCiclometrica(aNum(4), aNum(1))

' Verifica condizione Trapezio
If VerificaStrutturaTrapezio(d1, d2, d3, d4) Then
Call Scrivi("--------------------------------------------------")
Call Scrivi("Trovata condizione in data: " & GetInfoEstrazione(idEstr))
Call Scrivi("Ruote: " & NomeRuota(r1) & " - " & NomeRuota(r2))
Call Scrivi("Numeri (Trapezio): " & StringaNumeri(aNum))
Call Scrivi("Distanze: " & d1 & "-" & d2 & "-" & d3 & "-" & d4)
Call CalcolaSviluppoCiclometrico(aNum, nEstr1, nEstr2, nAmboA, nAmboB, nAmboC)
Call VerificaEsitoPrevisione(idEstr, r1, r2, nEstr1, nEstr2, nAmboA, nAmboB, nAmboC, _
nTotPrevisioni, _
nAmbateVinte, nAmbatePerse, nAmbateSospese, _
nAmboVinti, nAmboPersi, nAmboSospesi, _
nTernoVinti, nTernoPersi, nTernoSospesi)
End If
Next
Next
Next
Next
End If
Next
End If
Next

Call AvanzamentoElab(nEstrInizio, EstrazioniArchivio, idEstr)
If ScriptInterrotto Then Exit For
Next

Call Scrivi("Ricerca completata.")

' ---------------------------------------------------------------------
' Riepilogo finale degli esiti (verifica entro 9 colpi su r1/r2)
' Le percentuali sono calcolate solo sulle previsioni concluse
' (Vinte + Perse), escludendo quelle ancora in corso (Sospese).
' ---------------------------------------------------------------------
Call Scrivi("----------------------------------------------------------------------")
Call Scrivi("Riepilogo Esiti (verifica entro 9 colpi sulle ruote di uscita):")
Call Scrivi("Previsioni totali generate: " & nTotPrevisioni)

' --- Ambata ---
Call Scrivi("")
Call Scrivi("AMBATA:")
Call Scrivi(" Vinte: " & nAmbateVinte & " - Perse: " & nAmbatePerse & " - Sospese (in corso): " & nAmbateSospese)
nConcluse = nAmbateVinte + nAmbatePerse
If nConcluse > 0 Then
nPct = Int((nAmbateVinte * 100) / nConcluse)
Call Scrivi(" Percentuale di successo (su previsioni concluse): " & nPct & "%")
Else
Call Scrivi(" Nessuna previsione conclusa, percentuale non calcolabile.")
End If

' --- Ambo ---
Call Scrivi("")
Call Scrivi("AMBO:")
Call Scrivi(" Vinti: " & nAmboVinti & " - Persi: " & nAmboPersi & " - Sospesi (in corso): " & nAmboSospesi)
nConcluse = nAmboVinti + nAmboPersi
If nConcluse > 0 Then
nPct = Int((nAmboVinti * 100) / nConcluse)
Call Scrivi(" Percentuale di successo (su previsioni concluse): " & nPct & "%")
Else
Call Scrivi(" Nessuna previsione conclusa, percentuale non calcolabile.")
End If

' --- Terno ---
Call Scrivi("")
Call Scrivi("TERNO:")
Call Scrivi(" Vinti: " & nTernoVinti & " - Persi: " & nTernoPersi & " - Sospesi (in corso): " & nTernoSospesi)
nConcluse = nTernoVinti + nTernoPersi
If nConcluse > 0 Then
nPct = Int((nTernoVinti * 100) / nConcluse)
Call Scrivi(" Percentuale di successo (su previsioni concluse): " & nPct & "%")
Else
Call Scrivi(" Nessuna previsione conclusa, percentuale non calcolabile.")
End If
End Sub

Function VerificaStrutturaTrapezio(d1, d2, d3, d4)
Dim aD(4)
aD(1) = d1 : aD(2) = d2 : aD(3) = d3 : aD(4) = d4
Call OrdinaMatrice(aD, 1)

' Condizione di geometria: i tre lati minori sono uguali
If (aD(1) = aD(2) And aD(2) = aD(3)) Or (aD(2) = aD(3) And aD(3) = aD(4)) Then
VerificaStrutturaTrapezio = True
Else
VerificaStrutturaTrapezio = False
End If
End Function

Sub CalcolaSviluppoCiclometrico(aNumeri, nE1, nE2, nA1, nA2, nA3)
' Sviluppo ciclometrico puro (Somme e chiusure geometriche)
' I valori vengono restituiti al chiamante (passaggio ByRef di default in VBScript)
' per poter essere riutilizzati dalla verifica esiti.
nE1 = Fuori90(aNumeri(1) + aNumeri(4))
nE2 = Fuori90(aNumeri(2) + aNumeri(3))
nA1 = aNumeri(1)
nA2 = aNumeri(3)
nA3 = Fuori90(nE1 + nE2 + aNumeri(2))

Call Scrivi("Previsione Sviluppo Ciclometrico:")
Call Scrivi("Estratti: " & nE1 & " - " & nE2)
Call Scrivi("Ambo e Terno: " & nA1 & "." & nA2 & "." & nA3)
End Sub

Sub VerificaEsitoPrevisione(idEstrUscita, ruota1, ruota2, nE1, nE2, nA1, nA2, nA3, _
nTot, _
nAmbateVinte, nAmbatePerse, nAmbateSospese, _
nAmboVinti, nAmboPersi, nAmboSospesi, _
nTernoVinti, nTernoPersi, nTernoSospesi)

Dim colpo, idVerifica, nColpiVerificati
Dim trovAmbata1, trovAmbata2, trovAmbo, trovTerno

nTot = nTot + 1
trovAmbata1 = False
trovAmbata2 = False
trovAmbo = False
trovTerno = False
nColpiVerificati = 0

For colpo = 1 To 9
idVerifica = idEstrUscita + colpo
If idVerifica > EstrazioniArchivio Then Exit For

nColpiVerificati = colpo

Call VerificaPresenzaSuRuota(idVerifica, ruota1, nE1, nE2, nA1, nA2, nA3, trovAmbata1, trovAmbata2, trovAmbo, trovTerno)
Call VerificaPresenzaSuRuota(idVerifica, ruota2, nE1, nE2, nA1, nA2, nA3, trovAmbata1, trovAmbata2, trovAmbo, trovTerno)

If (trovAmbata1 Or trovAmbata2) And trovAmbo And trovTerno Then Exit For
Next

Call Scrivi("Esito (verifica su " & NomeRuota(ruota1) & "/" & NomeRuota(ruota2) & ", " & nColpiVerificati & "/9 colpi disponibili):")

' --- Ambata ---
If trovAmbata1 Or trovAmbata2 Then
Call Scrivi(" - Ambata: VINTA")
nAmbateVinte = nAmbateVinte + 1
ElseIf nColpiVerificati >= 9 Then
Call Scrivi(" - Ambata: persa")
nAmbatePerse = nAmbatePerse + 1
Else
Call Scrivi(" - Ambata: Valida per ancora " & (9 - nColpiVerificati) & " colpi")
nAmbateSospese = nAmbateSospese + 1
End If

' --- Ambo ---
If trovAmbo Then
Call Scrivi(" - Ambo: VINTO")
nAmboVinti = nAmboVinti + 1
ElseIf nColpiVerificati >= 9 Then
Call Scrivi(" - Ambo: perso")
nAmboPersi = nAmboPersi + 1
Else
Call Scrivi(" - Ambo: Valida per ancora " & (9 - nColpiVerificati) & " colpi")
nAmboSospesi = nAmboSospesi + 1
End If

' --- Terno ---
If trovTerno Then
Call Scrivi(" - Terno: VINTO")
nTernoVinti = nTernoVinti + 1
ElseIf nColpiVerificati >= 9 Then
Call Scrivi(" - Terno: perso")
nTernoPersi = nTernoPersi + 1
Else
Call Scrivi(" - Terno: Valida per ancora " & (9 - nColpiVerificati) & " colpi")
nTernoSospesi = nTernoSospesi + 1
End If
End Sub

Sub VerificaPresenzaSuRuota(idEstr, ruota, nE1, nE2, nA1, nA2, nA3, trovAmbata1, trovAmbata2, trovAmbo, trovTerno)
Dim aN(5), k
Dim presA1, presA2, presA3

For k = 1 To 5
aN(k) = Estratto(idEstr, ruota, k)
Next

For k = 1 To 5
If aN(k) = nE1 Then trovAmbata1 = True
If aN(k) = nE2 Then trovAmbata2 = True
Next

presA1 = False
presA2 = False
presA3 = False
For k = 1 To 5
If aN(k) = nA1 Then presA1 = True
If aN(k) = nA2 Then presA2 = True
If aN(k) = nA3 Then presA3 = True
Next

If presA1 And presA2 Then trovAmbo = True
If presA1 And presA2 And presA3 Then trovTerno = True
End Sub

Function DistanzaCiclometrica(n1, n2)
Dim d
d = Abs(n1 - n2)
If d > 45 Then d = 90 - d
DistanzaCiclometrica = d
End Function

Sub GetNumeriUniti(idEstr, r1, r2, aTuttiNumeri)
Dim k, x
x = 0
For k = 1 To 5
aTuttiNumeri(x) = Estratto(idEstr, r1, k)
x = x + 1
Next
For k = 1 To 5
aTuttiNumeri(x) = Estratto(idEstr, r2, k)
x = x + 1
Next
End Sub



Questo è l'output:



L'archivio che ho usato non è aggiornato.