lotto_tom75
Advanced Premium Member
Incuriosendomi molto la tua interessante idea della % doc di distanze dai massimi storici, anche perchè convergente con alcune mie ultime ricerche di "distanze mai oltrepassate", ho cercato di implementarla in questo ultra power script multi funzione. Spero di esserci riuscito e che ti torni utile per i tuoi sviluppi.
Codice:
Option Explicit
'by lotto_tom75 implementazione filtro abasul x A in 3ina
'lo script implementa anche il motore a sviluppo integrale senza limiti di classe dei mitici edo95 e luigib
Class clsSviluppo
Private aBNumDaSvil
Private nQNumeri
Private nCombInt
Private nClasse
Private aRighe
Private nQNumPerRiga
Private aPuntatore
Private nSviluppate
Function InitSviluppo(aNumeri,Classe)
nQNumeri = AlimentArrayNumDaSvil(aNumeri)
nCombInt = Combinazioni(nQNumeri,Classe)
nClasse = Classe
nSviluppate = 0
If nCombInt > 0 Then
Call AlimentaArrayRighe
Call InitArrayPuntatore
End If
InitSviluppo = nCombInt
End Function
Function GetQuantitaNumeriDaSvil
GetQuantitaNumeriDaSvil = nQNumeri
End Function
Function GetStringaNumDaSvil
Dim s,k
s = ""
For k = 1 To UBound(aBNumDaSvil)
If aBNumDaSvil(k) Then
s = s & Format2(k) & "."
End If
Next
GetStringaNumDaSvil = RimuoviLastChr(s,".")
End Function
Private Sub InitArrayPuntatore
Dim k
ReDim aPuntatore(nClasse)
For k = 1 To nClasse - 1
aPuntatore(k) = 1
Next
aPuntatore(k) = 0
End Sub
Function GetComb(aComb)
Dim nTmp,K,nPuntatore
nPuntatore = nClasse
nTmp = aPuntatore(nPuntatore) + 1
Do While nTmp > nQNumPerRiga
nPuntatore = nPuntatore - 1
If nPuntatore <= 0 Then Exit Do
nTmp = aPuntatore(nPuntatore) + 1
Loop
If nPuntatore > 0 Then
For K = nPuntatore To nClasse
aPuntatore(K) = nTmp
Next
ReDim aComb(nClasse)
For K = 1 To nClasse
aComb(K) = aRighe(K,aPuntatore(K))
Next
nSviluppate = nSviluppate + 1
GetComb = True
Else
GetComb = False
End If
End Function
Function GetQuantitaSviluppate
GetQuantitaSviluppate = nSviluppate
End Function
Private Function AlimentArrayNumDaSvil(aNumeri)
Dim k,q
aBNumDaSvil = ArrayNumeriToBool(aNumeri)
For k = 1 To 90
If aBNumDaSvil(k) Then
q = q + 1
End If
Next
AlimentArrayNumDaSvil = q
End Function
Private Sub AlimentaArrayRighe
Dim nRiga,k,aNumeri
Call ArrayBNumToArrayNum(aBNumDaSvil,aNumeri)
nQNumPerRiga =(nQNumeri - nClasse) + 1
ReDim aRighe(nClasse,nQNumPerRiga)
For nRiga = 1 To nClasse
'i = 0
For k = nRiga To(nRiga + nQNumPerRiga) - 1 '(nQNumeri - nClasse) + nRiga
' i = i + 1
' i = (k - nRiga )+1
aRighe(nRiga,(k - nRiga) + 1) = aNumeri(k)
Next
Next
End Sub
Sub OutputARighe
Dim k,j,s
For k = 1 To nClasse
s = ""
For j = 1 To nQNumPerRiga
s = s & Format2(aRighe(k,j)) & "."
Next
Call Scrivi(Format2(k) & ") " & RimuoviLastChr(s,"."))
Next
End Sub
End Class
Sub Main
Dim clSvi
Dim nClasse
Dim nSorte
Dim k,j
Dim sNumeri
Dim idComb
Dim nInizio,nFine
Dim idValoreDaAna
Dim sValoreUsato
Dim CombTot
Dim aRuote
Set clSvi = New clsSviluppo
Dim quantirisultati
Dim Col_Ord
Dim Tipo_Ord
Dim QNS
ReDim aNum(0)
QNS = ScegliNumeri(aNum)
Dim classedisviluppodidefault
classedisviluppodidefault = 3
nClasse = ScegliEsito(classedisviluppodidefault,1,90)
Call ScegliRuote(aRuote)
nSorte = ScegliSorte
idValoreDaAna = ScegliValoreDaAnalizzare(sValoreUsato)
Col_Ord = CInt(InputBox("Colonna da ordinare (freq= 2; Rit= 3; RitMax= 4; Diff= 5; Incmax= 6).","colonna da ordinare ",3))
Tipo_Ord = CInt(InputBox("Ordinamento (Crescente > 0 1; Decresc = 0).","Ordinamento ",1))
nInizio = EstrazioneIni
nFine = EstrazioneFin
If nClasse > 0 And nSorte > 0 And nSorte <= nClasse And idValoreDaAna > 0 Then
Call Messaggio("Sviluppo combinazioni di classe " & nClasse)
CombTot = clSvi.InitSviluppo(aNum,nClasse)
Call Messaggio("Lunghette totali da analizzare " & CombTot)
ReDim aCombMigliori(CombTot,6)
Call Messaggio("Statistica combinazioni in corso ")
ReDim aCol(nClasse)
Do While clSvi.GetComb(aCol) = True
Call AnalisiComb(aCol,aRuote,nSorte,aCombMigliori,nInizio,nFine,idValoreDaAna)
k = k + 1
If k Mod 1 = 0 Then
Call Messaggio("Statistica combinazioni in corso " & k & " di " & CombTot)
Call AvanzamentoElab(1,CombTot,k)
If ScriptInterrotto Then Exit Do
End If
Loop
Call Messaggio("")
' ReDim aTitoli(6)
' aTitoli(1) = "Combinazione"
' aTitoli(2) = "Frequenza"
' aTitoli(3) = "Ritardo"
' aTitoli(4) = "RitardoMax"
' aTitoli(5) = "Differenza Aurea"
' aTitoli(6) = "IncMax"
'
Call Scrivi("Combinazioni di classe " & nClasse & " analizzate per punti " & nSorte & " sulle ruote " & GetRuoteUsate(aRuote))
Call Scrivi("La seguente lista mostra le prime " & quantirisultati & " Combinazioni In Base al valore di " & sValoreUsato)
Call Scrivi("Range analizzato " & GetInfoEstrazione(nInizio) & " fino a " & GetInfoEstrazione(nFine))
Call Scrivi("Estrazioni analizzate totali : " &(nFine + 1) - nInizio)
Call Scrivi
For k = 1 To UBound(aCombMigliori)
ReDim ADati(6)
ADati(1) = aCombMigliori(k,4) 'combinazione
ADati(2) = aCombMigliori(k,1) 'frequenza
ADati(3) = aCombMigliori(k,2) 'ritardo
ADati(4) = aCombMigliori(k,3) 'ritardo max
ADati(5) = aCombMigliori(k,5) 'differenza aurea
ADati(6) = aCombMigliori(k,6) ' incmax
Dim ccolonna
Dim contatore
contatore = contatore + 1
Dim diff
'prova inserimento filtro by idea di abasul sotto riportata...
'
'Potremmo chiamare questa mia idea "Ritardi di lunghette prossimi allo storico" dove con la tua bravura dovresti
'permettere a tutti noi di poter controllare solo quei ritardi distanti dallo storico tra il 45% e il 75%. Mi spiego:
'Se ad esempio su una qualsiasi ruota una lunghetta di una terzina per ambo avesse un ritardo di 263 estrazioni
'e lo storico fosse di 362, basterebbe dividere 263/362x100 per vedere se questa previsione rientrerebbe
'nel range da Me definito: siccome 263:362x100= 72,65, allora questa previsione sarebbe da inserire;
'se invece, tra i tanti ritardi ne avessimo uno sempre di una lunghetta In terzina per ambo di 389 estrazioni e
'il ritardo storico fosse di 411, allora avremmo 389/411x100=94,64% e questa previsione sarebbe da non inserire.
'
'fine esposizione idea abasul
Dim datoabasul
If ADati(3) <> 0 And ADati(4) <> 0 Then
datoabasul =(ADati(3)/ADati(4)) * 100
If ADati(5) <= 10 Then
Call Scrivi("formazione: " & ADati(1) & " -" & " FQ " & ADati(2) & " -" & " RA " & ADati(3) & " -" & " RS " & ADati(4) & " -" & diff & " <font color=red bgcolor=yellow>" & ADati(5) & " -" & " INCMAX " & ADati(6) & "</font>" & " -" & " contatore " & contatore)
Else
Call Scrivi("formazione: " & ADati(1) & " -" & " FQ " & ADati(2) & " -" & " RA " & ADati(3) & " -" & " RS " & ADati(4) & " - DIFF " & ADati(5) & " -" & " INCMAX " & ADati(6) & " -" & " contatore " & contatore)
End If
Scrivi
Call Scrivi("PROVA OUTPUT SECONDO FILTRO ABASUL con sole formazioni con ra distante dal rispettivo rs x A in terzina tra il 45% e 75%")
'If datoabasul <> Null Then
If(datoabasul >= 45) And(datoabasul <= 75) Then
Call Scrivi("<font color=green>OK la formazione ha passato il filtro abasul per A in 3ina con valore di filtro: </font>" & datoabasul)
Else
Call Scrivi("<font color=red>NO la formazione NON ha passato il filtro abasul per A in 3ina con valore di filtro: </font>" & datoabasul)
End If
End If ' x controllo valori non nulli di ra e rs
Scrivi
'End If
Next
'Next
Call Scrivi
Call Scrivi("Tempo trascorso: " & TempoTrascorso)
Call Scrivi
Else
MsgBox "Selezionare la classe di sviluppo e la Sorte , " & _
"si ricorda che la Sorte non puo essere maggiore della classe di sviluppo " & _
"e che bisogna scegliere quale valore statistico considerare per " & _
"alimentare la lista delle prime N Combinazioni desiderate da mostrare in output "
End If
End Sub
Sub AnalisiComb(aNum,aRuote,Sorte,aCombMig,nInizio,nFine,idValoreDaAna)
Dim k,j
Dim Rit
Dim RitMax
Dim Freq
Dim Valore
Dim diff
Dim RetIncrRitMax
Call StatisticaFormazioneTurbo(aNum,aRuote,Sorte,Rit,RitMax,RetIncrRitMax,Freq,nInizio,nFine)
diff = RitMax - Rit
Select Case idValoreDaAna
Case 1
Valore = Freq
Case 2
Valore = Rit
Case 3
Valore = RitMax
End Select
For k = 1 To UBound(aCombMig)
If Valore >= aCombMig(k,0) Then
For j = UBound(aCombMig) To(k + 1) Step - 1
aCombMig(j,0) = aCombMig(j - 1,0)
aCombMig(j,1) = aCombMig(j - 1,1)
aCombMig(j,2) = aCombMig(j - 1,2)
aCombMig(j,3) = aCombMig(j - 1,3)
aCombMig(j,4) = aCombMig(j - 1,4)
aCombMig(j,5) = aCombMig(j - 1,5)
aCombMig(j,6) = aCombMig(j - 1,6)
Next
aCombMig(k,0) = Valore
aCombMig(k,1) = Freq
aCombMig(k,2) = Rit
aCombMig(k,3) = RitMax
aCombMig(k,4) = StringaNumeri(aNum)
aCombMig(k,5) = diff
aCombMig(k,6) = RetIncrRitMax
Exit For
End If
Next
End Sub
Function ScegliSorte()
ReDim aVoci(4)
aVoci(0) = "Estratto"
aVoci(1) = "Ambo"
aVoci(2) = "Terno"
aVoci(3) = "Quaterna"
aVoci(4) = "Cinquina"
ScegliSorte = ScegliOpzioneMenu(aVoci,1,"Scegli Sorte") + 1
End Function
Function ScegliValoreDaAnalizzare(sValore)
ReDim aVoci(4)
Dim i
aVoci(0) = "Frequenza"
aVoci(1) = "Ritardo"
aVoci(2) = "Ritardo massimo"
aVoci(3) = "Differenza Aurea"
aVoci(4) = "IncMax"
i = ScegliOpzioneMenu(aVoci,1,"Quale valore considerare per l'ordinamento ? ")
sValore = aVoci(i)
ScegliValoreDaAnalizzare = i + 1
End Function
Function GetRuoteUsate(aRuote)
Dim k
Dim s
For k = 1 To UBound(aRuote)
s = s & SiglaRuota(aRuote(k)) & " "
Next
GetRuoteUsate = Trim(s)
End Function
