Option Explicit
'Script n. 38B tom's bakery x lotto by tom ; rileva formazioni soddisfacenti il filtro voluto (es. fq max unica o meno) visualizzandone anche la situazione relativa all'incmax di 3° tipo per il relativo filtro di selezione impostato. Aggiunta opzione analisi da file txt
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
For k = nRiga To(nRiga + nQNumPerRiga) - 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
Next
End Sub
End Class
Sub Main
Dim casivalidi
casivalidi = 0
Dim fileformazionidocestrapolate
fileformazionidocestrapolate = "fileformazionidocestrapolate.txt"
If FileEsistente(fileformazionidocestrapolate) Then
Call EliminaFile(fileformazionidocestrapolate)
End If
Dim cSvil
Dim aNumDaSvil,nClasse,nCombInt,nQNumeri
Dim aColonna
Dim Inizio
Dim fine
Dim aRetcol,nSorte,RetRit1,RetRitMax,RetIncrRitMax,RetFreq,Iniziorange,idestrazione
fine = EstrazioneFin
Inizio = EstrazioneIni
Dim freqmassima
freqmassima = 0
Dim numfqmaxuguali
numfqmaxuguali = 0
Dim Formazioneconfqmassima
Dim Formazionesceltasolonumeri
Dim Stringaoutput
Dim contacomb
contacomb = 0
ReDim vettoreritardi(0)
Dim diff
ReDim vettoreincrementi(0)
ReDim vettoreidestrazioni(0)
Dim stringaelencoincrementi
ReDim aruote(0)
ScegliRuote(aruote)
nSorte = CInt(InputBox("sorte",,2))
Set cSvil = New clsSviluppo
Dim databellaodafile
databellaodafile = InputBox("numeri da tabella (t) o da file (f)",,"f")
If databellaodafile = "t" Then
Call ScegliNumeri(aNumDaSvil)
nClasse = ScegliEsito(UBound(aNumDaSvil) - 1,1,90)
nCombInt = cSvil.InitSviluppo(aNumDaSvil,nClasse)
If nCombInt Then
nQNumeri = cSvil.GetQuantitaNumeriDaSvil
Scrivi "gruppo base " & cSvil.GetStringaNumDaSvil & " classe " & UBound(aNumDaSvil)
Scrivi
Scrivi "Elaborazione effettuata con l'archivio lotto aggiornato al " & GetInfoEstrazione(EstrazioneFin)
Scrivi "Range temporale di analisi " & GetInfoEstrazione(EstrazioneIni) & " - " & GetInfoEstrazione(EstrazioneFin)
Scrivi "Numero ultime estrazioni consecutive analizzate " & EstrazioneFin - EstrazioneIni
Scrivi "Ruote analizzate " & StringaRuote(aruote)
Scrivi "Quantita numeri " & nQNumeri
Scrivi "Classe " & nClasse
Scrivi "Sorte " & nSorte
Scrivi "Combinazioni integrali " & nCombInt
Scrivi
cSvil.OutputARighe
Scrivi
Do While cSvil.GetComb(aColonna)
Dim r
ReDim aruotetmp(1)
For r = 1 To UBound(aruote)
aruotetmp(1) = aruote(r)
Call StatisticaFormazioneTurbo(aColonna,aruotetmp,nSorte,RetRit1,RetRitMax,RetIncrRitMax,RetFreq,Inizio,fine)
diff = RetRitMax - RetRit1
Call ElencoRitardi(aColonna,aruotetmp,nSorte,Inizio,fine,vettoreritardi,vettoreidestrazioni)
contacomb = contacomb + 1
Stringaoutput = StringaNumeri(aColonna) & " - " & StringaRuote(aruotetmp) & " -s " & nSorte & " -ra " & RetRit1 & " -rs " & RetRitMax & " -incmax " & RetIncrRitMax & " -freq " & RetFreq & " -inizio " & Inizio & " -fine " & fine & " classe " & nClasse
Dim cvr
For cvr = 1 To UBound(vettoreritardi) - 1
stringaelencoincrementi = stringaelencoincrementi & "." & vettoreritardi(cvr + 1) - vettoreritardi(cvr)
Next
Call SplitByChar(stringaelencoincrementi,".",vettoreincrementi)
Dim c
Dim cvixim
ReDim vettoreincrementiinteri(UBound(vettoreincrementi) + 1)
For cvixim = 1 To UBound(vettoreincrementi) - 1
vettoreincrementiinteri(cvixim) = Int(vettoreincrementi(cvixim))
Next
If UBound(vettoreincrementi) > 0 Then
Dim Diffincmax
Diffincmax = Int(vettoreincrementi(UBound(vettoreincrementi))) - Int(MassimoV(vettoreincrementiinteri,0,UBound(vettoreincrementiinteri) - 1))
If diff = 0 And Diffincmax = 0 Then
Scrivi
Scrivi "----------------------------------------------------------------------------------------"
Scrivi "RILEVATO CASO TEORICAMENTE OTTIMALE!",True,,,vbRed,5,"Comic"
Scrivi Stringaoutput
Scrivi("VERIFICA VETTORE INCREMENTI INTERI - l'ultimo " & StringaNumeri(vettoreincrementiinteri))
Scrivi "INCMAX ATTUALE by incrementi " & vettoreincrementi(UBound(vettoreincrementi))
Scrivi "INCMAX MASSIMO STORICO by incrementi interi " & MassimoV(vettoreincrementiinteri,0,UBound(vettoreincrementiinteri) - 1)
Messaggio " RILEVATO CASO DIFF INCMAX DI TERZO TIPO = 0 "
Scrivi "DIFF INCMAX ATT-STO " & Diffincmax
Dim Formazionedoc
Formazionedoc = StringaNumeri(aColonna)
Call DisegnaGraficoIncrRitMax(Formazionedoc,stringaelencoincrementi)
Scrivi "----------------------------------------------------------------------------------------"
Scrivi
End If
End If
'----------------------------------------------------------------------------------------------------------------------------------------------------------
stringaelencoincrementi = ""
Erase vettoreritardi
Erase vettoreincrementi
If RetFreq > freqmassima Then
freqmassima = RetFreq
Formazioneconfqmassima = "<font color=red>" & Stringaoutput
Formazionesceltasolonumeri = StringaNumeri(aColonna)
numfqmaxuguali = 0
End If
If RetFreq = freqmassima Then
numfqmaxuguali = numfqmaxuguali + 1
End If
Messaggio cSvil.GetQuantitaSviluppate & " r " & NomeRuota(aruotetmp(1))
If ScriptInterrotto Then Exit Do
Call AvanzamentoElab(1,nCombInt,contacomb)
If ScriptInterrotto Then Exit For
Next
Loop
Scrivi
Scrivi "Sviluppate : " & cSvil.GetQuantitaSviluppate
Else
MsgBox "Impossibile sviluppare",vbCritical
End If
Scrivi
Scrivi "report finale"
Scrivi
Scrivi "formazione con fq massima " & Formazioneconfqmassima
Scrivi
Scrivi "num. fq max uguali " & numfqmaxuguali - 1
Scrivi
Scrivi
Scrivi "formazione scelta (solo numeri) " & Formazionesceltasolonumeri
Scrivi
Scrivi "tempo trascorso " & TempoTrascorso
Scrivi
Else
'sviluppo da file txt
Dim filenumeribase
filenumeribase = ScegliFile(".\",".txt")
MsgBox("scegli la classe di sviluppo")
nClasse = ScegliEsito(21,1,90)
'nClasse = ScegliEsito(UBound(anuminteri)+1,1,90)
Dim anum
Dim y
'Dim c
Dim sfiletxtgrupponumerico,sfile
sfiletxtgrupponumerico = filenumeribase '".\sfiletxtgrupponumerico.txt"
sfile = sfiletxtgrupponumerico
Call Messaggio("Lettura file di testo")
ReDim aRighe(0)
Call LeggiRigheFileDiTesto(sfile,aRighe)
For y = 0 To UBound(aRighe)
If aRighe(y) <> "" Then
Call SplitByChar(aRighe(y),".",anum)
'Scrivi StringaNumeri(anum)
If ScriptInterrotto Then Exit For
End If
' Scrivi
' Scrivi "contenuto array "
' Scrivi
'nCombInt = cSvil.InitSviluppo(anuminteri,nClasse)
ReDim anuminteri(UBound(anum))
For c = 0 To UBound(anum)
'Scrivi "|"&anum(c)&"|"
anuminteri(c) = Int(anum(c))
If ScriptInterrotto Then Exit For
Next
' Call AvanzamentoElab(0,UBound(aRighe),y)
'
' If ScriptInterrotto Then Exit For
' Next
nCombInt = cSvil.InitSviluppo(anuminteri,nClasse)
If nCombInt Then
nQNumeri = cSvil.GetQuantitaNumeriDaSvil
' Scrivi
' Scrivi "gruppo base " & cSvil.GetStringaNumDaSvil & " classe " & UBound(anuminteri) + 1
' Scrivi
' Scrivi "Elaborazione effettuata con l'archivio lotto aggiornato al " & GetInfoEstrazione(EstrazioneFin)
' Scrivi "Range temporale di analisi " & GetInfoEstrazione(EstrazioneIni) & " - " & GetInfoEstrazione(EstrazioneFin)
' Scrivi "Numero ultime estrazioni consecutive analizzate " & EstrazioneFin - EstrazioneIni
' Scrivi "Ruote analizzate " & StringaRuote(aruote)
' Scrivi "Quantita numeri " & nQNumeri
' Scrivi "Classe " & nClasse
' Scrivi "Sorte " & nSorte
' Scrivi "Combinazioni (sottogruppi) integrali " & nCombInt
' Scrivi
cSvil.OutputARighe
' Scrivi
Do While cSvil.GetComb(aColonna)
'Dim r
ReDim aruotetmp(1)
For r = 1 To UBound(aruote)
aruotetmp(1) = aruote(r)
Call StatisticaFormazioneTurbo(aColonna,aruotetmp,nSorte,RetRit1,RetRitMax,RetIncrRitMax,RetFreq,Inizio,fine)
diff = RetRitMax - RetRit1
Call ElencoRitardi(aColonna,aruotetmp,nSorte,Inizio,fine,vettoreritardi,vettoreidestrazioni)
contacomb = contacomb + 1
Stringaoutput = StringaNumeri(aColonna) & " - " & StringaRuote(aruotetmp) & " -s " & nSorte & " -ra " & RetRit1 & " -rs " & RetRitMax & " -incmax " & RetIncrRitMax & " -freq " & RetFreq & " -inizio " & Inizio & " -fine " & fine & " classe " & nClasse
' Dim cvr
For cvr = 1 To UBound(vettoreritardi) - 1
stringaelencoincrementi = stringaelencoincrementi & "." & vettoreritardi(cvr + 1) - vettoreritardi(cvr)
Next
Call SplitByChar(stringaelencoincrementi,".",vettoreincrementi)
' Dim c
' Dim cvixim
ReDim vettoreincrementiinteri(UBound(vettoreincrementi) + 1)
For cvixim = 1 To UBound(vettoreincrementi) - 1
vettoreincrementiinteri(cvixim) = Int(vettoreincrementi(cvixim))
Next
If UBound(vettoreincrementi) > 0 Then
' Dim Diffincmax
Diffincmax = Int(vettoreincrementi(UBound(vettoreincrementi))) - Int(MassimoV(vettoreincrementiinteri,0,UBound(vettoreincrementiinteri) - 1))
If diff = 0 And Diffincmax = 0 Then
Scrivi
Scrivi "----------------------------------------------------------------------------------------"
Scrivi "RILEVATO CASO TEORICAMENTE OTTIMALE!",True,,,vbRed,5,"Comic"
casivalidi = casivalidi + 1
Scrivi Stringaoutput
Scrivi("VERIFICA VETTORE INCREMENTI INTERI - l'ultimo " & StringaNumeri(vettoreincrementiinteri))
Scrivi "INCMAX ATTUALE by incrementi " & vettoreincrementi(UBound(vettoreincrementi))
Scrivi "INCMAX MASSIMO STORICO by incrementi interi " & MassimoV(vettoreincrementiinteri,0,UBound(vettoreincrementiinteri) - 1)
Messaggio " RILEVATO CASO DIFF INCMAX DI TERZO TIPO = 0 "
Scrivi "DIFF INCMAX ATT-STO " & Diffincmax
Scrivi
Scrivi "Dettagli formazione doc estrapolata"
Scrivi
Scrivi "gruppo base " & cSvil.GetStringaNumDaSvil & " classe " & UBound(anuminteri) + 1
Scrivi
Scrivi "Elaborazione effettuata con l'archivio lotto aggiornato al " & GetInfoEstrazione(EstrazioneFin)
Scrivi "Range temporale di analisi " & GetInfoEstrazione(EstrazioneIni) & " - " & GetInfoEstrazione(EstrazioneFin)
Scrivi "Numero ultime estrazioni consecutive analizzate " & EstrazioneFin - EstrazioneIni
Scrivi "Ruote analizzate " & StringaRuote(aruote)
Scrivi "Quantita numeri " & nQNumeri
Scrivi "Classe " & nClasse
Scrivi "Sorte " & nSorte
Scrivi "Combinazioni (sottogruppi) integrali " & nCombInt
Scrivi
Scrivi
' Dim Formazionedoc
Formazionedoc = StringaNumeri(aColonna)
fileformazionidocestrapolate = "fileformazionidocestrapolate.txt"
Call ScriviFile(fileformazionidocestrapolate,Formazionedoc)
CloseFileHandle(fileformazionidocestrapolate)
Scrivi
Scrivi "file " & fileformazionidocestrapolate & " scritto con successo"
Scrivi
Call DisegnaGraficoIncrRitMax(Formazionedoc,stringaelencoincrementi)
Scrivi "----------------------------------------------------------------------------------------"
Scrivi
End If
End If
'----------------------------------------------------------------------------------------------------------------------------------------------------------
stringaelencoincrementi = ""
Erase vettoreritardi
Erase vettoreincrementi
If RetFreq > freqmassima Then
freqmassima = RetFreq
Formazioneconfqmassima = "<font color=red>" & Stringaoutput
Formazionesceltasolonumeri = StringaNumeri(aColonna)
numfqmaxuguali = 0
End If
If RetFreq = freqmassima Then
numfqmaxuguali = numfqmaxuguali + 1
End If
Messaggio cSvil.GetQuantitaSviluppate & " r " & NomeRuota(aruotetmp(1)) & " casi validi trovati " & casivalidi & " Tt " & TempoTrascorso
If ScriptInterrotto Then Exit Do
Call AvanzamentoElab(1,nCombInt,contacomb)
If ScriptInterrotto Then Exit For
Next
Loop
' Scrivi
' Scrivi "Sviluppate : " & cSvil.GetQuantitaSviluppate
Else
MsgBox "Impossibile sviluppare",vbCritical
MsgBox "dato colonne " & nCombInt
End If
Erase anum
Erase anuminteri
Call AvanzamentoElab(0,UBound(aRighe),y)
If ScriptInterrotto Then Exit For
Next ' x arighe
Scrivi
Scrivi "report finale"
Scrivi
Scrivi "formazione con fq massima " & Formazioneconfqmassima
Scrivi
Scrivi "num. fq max uguali " & numfqmaxuguali - 1
Scrivi
Scrivi
Scrivi "formazione scelta (solo numeri) " & Formazionesceltasolonumeri
Scrivi
Scrivi "tempo trascorso " & TempoTrascorso
Scrivi
End If
End Sub
Sub DisegnaGraficoIncrRitMax(Formazionedoc,stringaelencoincrementi)
Dim vettoreincrementidecrementi
Dim Classevettoreincrementidecrementi
Call SplitByChar(stringaelencoincrementi,".",aElencoIncrRitMax)
Classevettoreincrementidecrementi = UBound(aElencoIncrRitMax)
Dim x,y,k
Dim nValoreMaxX,nValoreMaxY,nValoreMinX,nValoreMinY
Dim nStepX,nStepY
Dim nUpperVetIncrRit
Dim aIdEstrIncrRitMax
Dim aElencoRit
Dim mInizio
Dim aElencoIncrRitMax
Dim aRitardiAllIncremento
mInizio = EstrazioneIni
Dim aElencoIncrRitMaxInt
Dim c
ReDim aIdEstrIncrRitMax(UBound(aElencoIncrRitMax))
ReDim aElencoIncrRitMaxInt(UBound(aElencoIncrRitMax))
For c = 1 To UBound(aElencoIncrRitMax)
aIdEstrIncrRitMax(c) = c
aElencoIncrRitMaxInt(c) = Int(aElencoIncrRitMax(c))
Next
nValoreMinY = MinimoV(aElencoIncrRitMaxInt)
nValoreMinX = 0
nValoreMaxX = UBound(aElencoIncrRitMax)
nValoreMaxY = MassimoV(aElencoIncrRitMaxInt)
nStepX = 1
nStepY = 20
Call PreparaGrafico(Formazionedoc,nValoreMinX,nValoreMaxX,nValoreMinY,nValoreMaxY,nStepX,nStepY)
nUpperVetIncrRit = UBound(aElencoIncrRitMax)
ReDim aV(nUpperVetIncrRit - 1,2)
For k = 1 To nUpperVetIncrRit
x = aIdEstrIncrRitMax(k)
y = aElencoIncrRitMax(k)
aV(k - 1,1) = x
aV(k - 1,2) = y
Next
Call DisegnaLineaGrafico(aV,vbRed,"IncrRitMax")
Scrivi "incrementi e decrementi passati... " & stringaelencoincrementi & " classe " & Classevettoreincrementidecrementi
Scrivi "nValoreMinY " & nValoreMinY
Scrivi "nValoreMaxY " & nValoreMaxY
Call InserisciGrafico
End Sub