vincenzo4221
Advanced Member >PLATINUM<
MAGNIFICO , Luigi , sono senza parole , con questo dati posso lavorare nella direzione che volevo. A presto , ciao vincenzo
Follow along with the video below to see how to install our site as a web app on your home screen.
Nota: This feature may not be available in some browsers.
LuigiB;n1937249 ha scritto:Ciao , in questa versione delllo script ho ggiunto la scelta di esaminare le colonne da un file txt oppure da uno sviluppo casuale.
In questo secondo caso uno lancia lo script dice quante colonne vuole trovare e aspetta che lo script abbia finito oppure lo blocca prima quando vede che nonostante l'attesa qualche colonna è gia stata trovata ma non ancora tutte quelle che si volevano..
Codice:Option Explicit Class clsLunghetta Private aNumeri ' contiene i numeri della lunghetta Private mInizio,mFine,aRuote,mSorte ' parametri per il range analisi Private mClasse ' contine la classe della lunghetta Private aElencoRit ' conterra l'elenco dei ritardi per la lunghetta Private aIdEstrElencoRit ' conterra l'elenco dei ritardi per la lunghetta Private aElencoIncrRitMax ' contiene l'elnco degli incrementi del ritardo max Private aIdEstrIncrRitMax ' conterra l'elenco degli id estrazione in ' cui si è registrato l'incremento del ritmax conosciuto Private aRitardiAllIncremento ' contiene il valore del ritardo all'idestrazione in cui ' si è verificato l'incremento Private mRitardo,mRitardoMax,mIncrRitMax,mFrequenza ' valori statistici Public Property Get Ritardo Ritardo = mRitardo End Property Public Property Get RitardoMax RitardoMax = mRitardoMax End Property Public Property Get IncrRitMax IncrRitMax = mIncrRitMax End Property Public Property Get Frequenza Frequenza = mFrequenza End Property Public Property Get LunghettaString LunghettaString = StringaNumeri (aNumeri) End Property ' inizializza le proprietà dell'oggetto Sub Init(sLunghetta,sChrSep,RangeInizio,RangeFine,vetRuote,SorteInGioco) ' acquisisco i parametri per l'analisi mInizio = RangeInizio mFine = RangeFine aRuote = vetRuote mSorte = SorteInGioco ' alimento il vettore con i numeri della lunghetta Call AlimentaVettoreLunghetta(sLunghetta,sChrSep) ' calcolo l'elenco dei ritardi Call ElencoRitardiTurbo(aNumeri,aRuote,mSorte,mInizio,mFine,aElencoRit,aIdEstrElencoRit) ' alimento il vettore che contien l'elenco degli incrementi rit max Call AlimentaVettoreIncrRitMax End Sub ' esegue il calcolo dei valori statistici della lunghetta Sub EseguiStatistica Call StatisticaFormazioneTurbo(aNumeri,aRuote,mSorte,mRitardo,mRitardoMax,mIncrRitMax,mFrequenza,mInizio,mFine) End Sub Private Sub AlimentaVettoreLunghetta(sLunghetta,sChrSep) Dim k If IsArray(sLunghetta) Then ' se la lunghetta è gia un array lo copio nel vettore locale dei numeri ReDim aNumeri(UBound(sLunghetta)) For k = 1 To UBound(sLunghett a) aNumeri(k) = sLunghetta(k) Next Else ' antepongo un carattere separatore per fare in modo che ' aNumeri si valorizzi dall'indice 1 (senno si sarebeb valorizzato dall'indice 0) Call SplitByChar((sChrSep & sLunghetta),sChrSep,aNumeri) End If ' valorizzo la classe della lunghetta mClasse = UBound(aNumeri) End Sub Private Sub AlimentaVettoreIncrRitMax Dim nRitMax,nIncr,nId,k nId = 0 ' inizializzo il vettore a 0 elementi ReDim aElencoIncrRitMax(0) ReDim aIdEstrIncrRitMax(0) ReDim aRitardiAllIncremento(0) ' ciclo sul vettore dei ritardi For k = 1 To UBound(aElencoRit) ' se il ritardo corrente supera il ritmax attuale.. If aElencoRit(k) > nRitMax Then If nRitMax > 0 Then ' se il ritmax attuale è >0 (ivvero ne esiste uno) ' calcolo di quanto si è incrementato nIncr = aElencoRit(k) - nRitMax ' incremento il contatore dei valori trovati nId = nId + 1 ' ridimensiono il vettore mantenendo i valori precedenti ma ' aggiungendone uno ReDim Preserve aElencoIncrRitMax(nId) ' memorizzo il valore aElencoIncrRitMax(nId) = nIncr ' ridimensiono il vettore mantnendo i valori precedenti ma ' aggiungendone uno ReDim Preserve aIdEstrIncrRitMax(nId) ' memorizzo l'id dell'estrazione dove si è avuto l'incremento aIdEstrIncrRitMax(nId) = aIdEstrElencoRit(k) ' ridimensiono il vettore mantnendo i valori precedenti ma ' aggiungendone uno ReDim Preserve aRitardiAllIncremento(nId) ' memorizzo il valore del ritardo all'id dell'estrazione dove si è avuto l'incremento aRitardiAllIncremento(nId) = aElencoRit(k) End If nRitMax = aElencoRit(k) End If Next End Sub Function IsCondizioneRispettata ' verifica che l'incremento dell'ultimo ritmax sia uguale al massimo incr rit max conosciuto. Dim nUpper nUpper = UBound(aElencoIncrRitMax) If aIdEstrIncrRitMax(nUpper) = mFine Then IsCondizioneRispettata =(aElencoIncrRitMax(nUpper) >= MassimoV(aElencoIncrRitMax,1,nUpper - 1)) Else IsCondizioneRispettata = False End If End Function Sub DisegnaGraficoIncrRitMax Dim x,y,k Dim nValoreMaxX,nValoreMaxY,nValoreMinX Dim nStepX,nStepY Dim nUpperVetIncrRit nValoreMinX = MinimoV(aIdEstrIncrRitMax,1) nValoreMaxX = aIdEstrIncrRitMax(UBound(aIdEstrIncrRitMax)) nValoreMaxY = MassimoV(aElencoRit,1) nStepX =(nValoreMaxX -(mInizio - 1)) \10 nStepY = nValoreMaxY \10 Call PreparaGrafico("Formaziione " & StringaNumeri(aNumeri),nValoreMinX,nValoreMaxX,0,nValoreMaxY,nStepX,nStepY) nUpperVetIncrRit = UBound(aElencoIncrRitMax) ' linea dell'incremento rit max 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") ' linea dell' rit max ReDim aV(nUpperVetIncrRit - 1,2) For k = 1 To nUpperVetIncrRit x = aIdEstrIncrRitMax(k) y = aRitardiAllIncremento(k) aV(k - 1,1) = x aV(k - 1,2) = y Next Call DisegnaLineaGrafico(aV,vbBlue,"RitMax") ' scrive grafico nell'output Call InserisciGrafico End Sub End Class Sub Main Dim Inizio,Fine,aRuote,Sorte Inizio = EstrazioneIni Fine = EstrazioneFin Sorte = ScegliEsito Call ScegliRuote(aRuote,Nothing) If(Fine > Inizio) And UBound(aRuote) > 0 And Sorte > 0 Then Select Case ScegliTipoSviluppo Case 1 Call AnalisiLunghetteFromFileTxt(Inizio,Fine,aRuote,Sorte) Case 2 Call AnalisiLunghetteFromNumeriCasuali(Inizio,Fine,aRuote,Sorte) End Select End If End Sub Function ScegliTipoSviluppo ReDim aVoci(2) aVoci(1) = "Da file txt con lunghette" aVoci(2) = "Da sviluppo casuale" ScegliTipoSviluppo = ScegliOpzioneMenu(aVoci,1) End Function Function GetChrSepFromRiga(sRiga) Dim k,schr schr = "" For k = 1 To Len(sRiga) schr = Mid(sRiga,k,1) If IsNumeric(schr) = False Then Exit For End If Next GetChrSepFromRiga = schr End Function Sub AnalisiLunghetteFromFileTxt(Inizio,Fine,aRuote,Sorte) Dim sFile,aLunghette,nTotLunghette Dim k,sChrSep Dim clsL,collLunghette Set collLunghette = GetNewCollection sFile = ScegliFile(GetDirectoryAppData,".txt") If FileEsistente(sFile) Then Call LeggiRigheFileDiTesto(sFile,aLunghette) nTotLunghette = UBound(aLunghette) If nTotLunghette > 0 Then sChrSep = GetChrSepFromRiga(aLunghette(1)) For k = 1 To nTotLunghette Set clsL = New clsLunghetta Call clsL.Init(aLunghette(k),sChrSep,Inizio,Fine,aRuote,Sorte) If clsL.IsCondizioneRispettata Then Call clsL.EseguiStatistica collLunghette.Add clsL End If If k Mod 50 = 0 Then Call Messaggio("Righe esaminate " & k) Call AvanzamentoElab(1,nTotLunghette,k) If ScriptInterrotto Then Exit For End If Next Scrivi "Range analisi : " & GetInfoEstrazione(Inizio) & " - " & GetInfoEstrazione(Fine) Scrivi "Lunghette esaminate : " & nTotLunghette & " Valide : " & collLunghette.count Scrivi "Sorte : " & NomeSorte(Sorte) Scrivi "Ruote : " & StringaRuote(aRuote) Scrivi Scrivi "Lunghette ordinate per incremento ritardo max",True,,vbYellow Call Scrivi If collLunghette.count > 0 Then Call OrdinaItemCollection(collLunghette,"IncrRitMax",,,- 1) For Each clsL In collLunghette Call Scrivi("Lunghetta : " & clsL.LunghettaString ) Call Scrivi("Ritardo : " & clsL.Ritardo) Call Scrivi("RitMax : " & clsL.RitardoMax) Call Scrivi("Freq : " & clsL.Frequenza) Call Scrivi("IncrRitMx : " & clsL.IncrRitMax) Call clsL.DisegnaGraficoIncrRitMax Next Else Scrivi "Nessuna lunghetta rispetta le condizioni" Scrivi "Lunghette esaminate " & nTotLunghette End If End If End If End Sub Sub AnalisiLunghetteFromNumeriCasuali(Inizio,Fine,aRuote,Sorte) Dim sFile,aLunghette,nTotLunghette,nClasse Dim nTrov,nProdotte Dim clsL,collLunghette Set collLunghette = GetNewCollection nTotLunghette = Int(InputBox("Quante lunghette devono essere trovate ?",,10)) nClasse = Int(InputBox("Quanti numeri nella lunghetta",,Sorte)) If nTotLunghette > 0 And nClasse >= Sorte And nClasse <= 10 Then nTrov = 0 nProdotte = 0 Do While nTrov < nTotLunghette Set clsL = New clsLunghetta ReDim aNum(nClasse) Call GetColonnaCasuale(nClasse,aNum) nProdotte = nProdotte + 1 Call clsL.Init(aNum,"",Inizio,Fine,aRuote,Sorte) If clsL.IsCondizioneRispettata Then Call clsL.EseguiStatistica collLunghette.Add clsL nTrov = nTrov + 1 End If If nProdotte Mod 50 = 0 Then Call Messaggio("combinazioni esaminate " & nProdotte & " valide " & nTrov) Call DoEventsEx If ScriptInterrotto Then Exit Do End If Loop Scrivi "Range analisi : " & GetInfoEstrazione(Inizio) & " - " & GetInfoEstrazione(Fine) Scrivi "Lunghette esaminate : " & nTotLunghette & " Valide : " & collLunghette.count Scrivi "Sorte : " & NomeSorte(Sorte) Scrivi "Ruote : " & StringaRuote(aRuote) Scrivi Scrivi "Lunghette ordinate per incremento ritardo max",True,,vbYellow Call Scrivi If collLunghette.count > 0 Then Call OrdinaItemCollection(collLunghette,"IncrRitMax",,,- 1) For Each clsL In collLunghette Call Scrivi("Lunghetta : " & clsL.LunghettaString ) Call Scrivi("Ritardo : " & clsL.Ritardo) Call Scrivi("RitMax : " & clsL.RitardoMax) Call Scrivi("Freq : " & clsL.Frequenza) Call Scrivi("IncrRitMx : " & clsL.IncrRitMax) Call clsL.DisegnaGraficoIncrRitMax Next Else Scrivi "Nessuna lunghetta rispetta le condizioni" Scrivi "Lunghette esaminate " & nTotLunghette End If End If End Sub
[/COLOR][/SIZE][/FONT]clsL.IncrRitMax [FONT=Courier New][SIZE=2][COLOR=#000000]
Call Scrivi("IncrRitMx : " & clsL.IncrRitMax)
silop2005;n1937308 ha scritto:[TABLE="border: 0, cellpadding: 0, cellspacing: 0, width: 832"]
[TR]
[TD][/TD]
[/TR]
[TR]
[TD] [/TD]
[/TR]
[TR]
[TD]Ciao LuigiB o I Legend o LottoTom,[/TD]
[/TR]
[TR]
[TD]ho provato il vostro bellissimo script sugli IncrMax[/TD]
[/TR]
[TR]
[TD]con un mio file txt di 138 lunghette di ottine[/TD]
[/TR]
[TR]
[TD]ed ho notato che non le legge tutte[/TD]
[/TR]
[TR]
[TD]ne manca sempre UNA ( ho provato anche con altri file.txt)[/TD]
[/TR]
[TR]
[TD]le valide sono 137 invece di 138 :[/TD]
[/TR]
[TR]
[TD]========================[/TD]
[/TR]
[TR]
[TD]Range analisi : [03950] [ 37] 14.09.1946 - [09085] [140] 21.11.2015[/TD]
[/TR]
[TR]
[TD]Lunghette esaminate : 137 Valide : 16[/TD]
[/TR]
[TR]
[TD]Sorte : Quaterna[/TD]
[/TR]
[TR]
[TD]Ruote : TT[/TD]
[/TR]
[TR]
[TD]========================[/TD]
[/TR]
[TR]
[TD]Forse sbaglio qualcosa ?[/TD]
[/TR]
[TR]
[TD]========================[/TD]
[/TR]
[TR]
[TD][/TD]
[/TR]
[TR]
[TD]Buona domenica a tutti.[/TD]
[/TR]
[TR]
[TD]A presto[/TD]
[/TR]
[TR]
[TD]Silop [/TD]
[/TR]
[/TABLE]
vincenzo4221;n1937329 ha scritto:HO notato , qualcosa che non mi quadra , durante l'esecuzione dello script per esito di estratto su 1 ruota con lunghette di 2 soli numeri(coppie) , da sviluppo casuale , il numero delle combinazioni esaminate dovrebbe fermarsi a 4005? mentre lo script continua ad analizzare oltre le 300.000 combinazioni che non esistono se non ripetute , o no?
Per SILOP , sembra che hai tutto o quasi , posso chiederti un file .txt con lo sviluppo in coppie integrali (4005) e magari in terzine (117mila....) x la sorte di estratto e ambo.
nTotLunghette = UBound(aLunghette)
nTotLunghette = UBound(aLunghette) + 1
i legend;n1937342 ha scritto:Ciao
......
Tom cosa ti serve vedere?
Se mi spieghi ci provo senza compromettere l originale.
Premesso che riesco a farlo funzionare.
Il tethering funziona ma non voglio fare copia incolla
Ciao
Sub AnalisiLunghetteFromSceglinumeri (Inizio,Fine,aRuote,Sorte)
Dim nTotLunghette
Dim k,sChrSep,nClasse
Redim aLunghette (0)
Dim clsL,collLunghette
Set collLunghette = GetNewCollection
SChrSep =" "
Sceglinumeri ( aLunghette )
nClasse =cint (InputBox ( " classe sviluppo ",,2)
nTotLunghette = initsviluppointegrale ( aLunghette, nClasse )
K=0
Do while getcombsviluppo ( aLunghette )
K=k+1
Set clsL = New clsLunghetta
Call clsL.Init(aLunghette,sChrSep,Inizio,Fine,aRuote,Sorte)
If clsL.IsCondizioneRispettata Then
Call clsL.EseguiStatistica
collLunghette.Add clsL
End If
If k Mod 50 = 0 Then
Call Messaggio("Righe esaminate "& k&" valide "&collLunghette. count )
Doeventsex
Call AvanzamentoElab(1,nTotLunghette,k)
If ScriptInterrotto Then Exit do
End If
Loop
Scrivi "Range analisi : " & GetInfoEstrazione(Inizio) & " - " & GetInfoEstrazione(Fine)
Scrivi "Lunghette esaminate : " & nTotLunghette & " Valide : " & collLunghette.count
Scrivi "Sorte : " & NomeSorte(Sorte)
Scrivi "Ruote : " & StringaRuote(aRuote)
Scrivi
Scrivi "Lunghette ordinate per incremento ritardo max",True,,vbYellow
Call Scrivi
If collLunghette.count > 0 Then
Call OrdinaItemCollection(collLunghette,"IncrRitMax",,,- 1)
For Each clsL In collLunghette
Call Scrivi("Ritardo : " & clsL.Ritardo)
Call Scrivi("RitMax : " & clsL.RitardoMax)
Call Scrivi("Freq : " & clsL.Frequenza)
Call Scrivi("IncrRitMx : " & clsL.IncrRitMax)
Call clsL.DisegnaGraficoIncrRitMax
Next
Else
Scrivi "Nessuna lunghetta rispetta le condizioni"
Scrivi "Lunghette esaminate " & nTotLunghette
End If
End If
End If
End Sub
================================ [TABLE="border: 0, cellpadding: 0, cellspacing: 0, width: 832"]LuigiB;n1937311 ha scritto:ciao Silop
va corretta questa riga
For k = 1 To nTotLunghette
con
For k = 0 To nTotLunghette
i legend;n1937367 ha scritto:Ciao
...
Tom le immagini che hai inserite non le vedo non si aprono non so se dipende da me.
Ciao
...
i legend;n1937431 ha scritto:Ciao tom visto il grafico.
Che ne pensi della sub scegli numeri?
Grazie luigi seguirò la tua guida.
Domani lavoro tutto il giorno cerco di postare il tutto domani sera
Buon inizio settimana a tutti
Private mIncrRitMaxSto
Public property get IncrRitMaxSto
IncrRitMaxSto =mIncrRitMaxSto
End property
Function IsCondizioneRispettata
Dim nUpper
NUpper =ubound ( aElencoIncrRitMax )
mIncrRitMaxSto =massimov ( aElencoIncrRitMax, 1, nUpper -1)
If aElencoRit ( ubound ( aElencoRit ) ) > 0 and aidestrIncrRitMax ( nUpper ) = mFine then
'
IsCondizioneRispettata = (aElencoIncrRitMax ( nUpper ) > mIncrRitMaxSto )
Else
IsCondizioneRispettata = False
End If
End function
'
For Each clsL In collLunghette
' m nel For Each aggiungi questa linea
Call Scrivi ( " IncrRitMaxSto : "& clsL.IncrRitMaxSto )
Next