Novità

Funzione incRitMax

i legend

Premium Member
Ciao , Ho scritto la funzione per calcolare gli ultimi 5 ritardi, mi aiutate per favore a scrivere quella degli ultimi 3incrementiMax? Funzione ultimi 5 ritardi
Codice:
Function Ultimi5Ritardi(aRetRit()) 	Dim n1,r1 	 	For n1 = UBound(aRetRit) - 1 To UBound(aRetRit)-5 Step-1 	     r1= Format2(aRetRit(n1))&"."&r1 	     r1=RimuoviLastChr(r1,".") 	Next 		Ultimi5Ritardi =r1 End Function
Ciao e grazie :)
 
Codice:
 Function Ultimi5Ritardi(aRetRit()) 	Dim n1,r1 	For n1 = UBound(aRetRit) - 1 To UBound(aRetRit) - 5 Step - 1 		r1 = Format2(aRetRit(n1)) & "." & r1 		r1 = RimuoviLastChr(r1,".") 	Next 	Ultimi5Ritardi = r1 End Function
 
Codice:
Function Ultimi5Ritardi(aRetRit()) 	Dim n1,r1 	For n1 = UBound(aRetRit) - 1 To UBound(aRetRit) - 5 Step - 1 		r1 = Format2(aRetRit(n1)) & "." & r1 		r1 = RimuoviLastChr(r1,".") 	Next 	Ultimi5Ritardi = r1 End Function
spero sia leggibile...:) Ho riscontrato che se utilizzo la funzione su ruota singola funzione correttamente mentre se utilizzo tutte mi restituisce errore 9 fuori intervallo? Ciao:) se non dovesse essere legibile aspetto che si risolva il problema e posto piu avanti
 
Codice:
Function Ultimi5Ritardi(aRetRit()) 	Dim n1,r1 	For n1 = UBound(aRetRit) - 1 To UBound(aRetRit) - 5 Step - 1 		r1 = Format2(aRetRit(n1)) & "." & r1 		r1 = RimuoviLastChr(r1,".") 	Next 	Ultimi5Ritardi = r1 End Function
spero sia leggibile...:) Ho riscontrato che se utilizzo la funzione su ruota singola funzione correttamente mentre se utilizzo tutte mi restituisce errore 9 fuori intervallo? Ciao:) se non dovesse essere legibile aspetto che si risolva il problema e posto piu avanti

Ciao I legend, molto interessante la tua ricerca "degli ultimi 3incrementiMax".

Posteresti lo script relativo? Grazie :)

In sostanza se ho ben capito... avresti esteso di uno l'attuale ricerca di incmax di 2° livello?

Ho provato ad usare la tua funzione ma non riesco a fare in modo che non mi dia errore :( :) e mi piacerebbe tanto valutarne i risultati...

Grazie

Ciao!

:o
 
Ultima modifica:
ciao tom la funzione postata elenca solo gli ultimi 5 ritardi, purtroppo ci sono problemi , ma lo generalizzata cosi si possono vedere quanti ritardi si vuole, per l'incremento max so come fare ma sicuramente non è corretto. prendo l'elenco ritardi completo ,poi,con il bubble sort lo ordino e faccio la differenza dei primi 4 ritardatari maggiori. r(0)=800,r(1)= 600,r(2)=549,r3(400) =>incremento max= 800-600,=200 , incremento p1=600-549=51 incrementop2=549-400=149, credo che la logica sia questa. Se ci riesco la posto, sperando che non rallenti troppo gli script..... Sperando che Joe o Luigi o Mike abbiano qualche suggerimento migliore:)
 
Ciao I legend, nella cartella test luigi ha già fatto un qualcosa del genere di valutare tutti gli incrementi max per la combinazione e sorte voluta, l'approccio al problema rispecchia +/- il tuo ragionamento.

Se non lo trovi te lo posto ma anche tom dovrebbe averlo in quanto mi pare di ricordare che lo stesso script era stato fatto su sua richiesta.

Ciao

questo è l'output ottenuto

Sulla ruota di : Firenze
Formazione analizzata : 26
Da Estrazione : [07953] [104] 28.08.2008
A Estrazione : [08953] [ 8 ] 17.01.2015

Ritardo : 111
RitardoMax : 111
Frequenza : 39

Dettaglio evoluzione RitMax
Estrazione : 7969 RitMax : 17 InccrRitMax : 17
Estrazione : 8002 RitMax : 32 InccrRitMax : 15
Estrazione : 8053 RitMax : 50 InccrRitMax : 18
Estrazione : 8279 RitMax : 61 InccrRitMax : 11
Estrazione : 8841 RitMax : 62 InccrRitMax : 1
Estrazione : 8953 RitMax : 111 InccrRitMax : 49
 
Ultima modifica:
Ciao I legend, nella cartella test luigi ha già fatto un qualcosa del genere di valutare tutti gli incrementi max per la combinazione e sorte voluta, l'approccio al problema rispecchia +/- il tuo ragionamento.

Se non lo trovi te lo posto ma anche tom dovrebbe averlo in quanto mi pare di ricordare che lo stesso script era stato fatto su sua richiesta.

Ciao

questo è l'output ottenuto

Sulla ruota di : Firenze
Formazione analizzata : 26
Da Estrazione : [07953] [104] 28.08.2008
A Estrazione : [08953] [ 8 ] 17.01.2015

Ritardo : 111
RitardoMax : 111
Frequenza : 39

Dettaglio evoluzione RitMax
Estrazione : 7969 RitMax : 17 InccrRitMax : 17
Estrazione : 8002 RitMax : 32 InccrRitMax : 15
Estrazione : 8053 RitMax : 50 InccrRitMax : 18
Estrazione : 8279 RitMax : 61 InccrRitMax : 11
Estrazione : 8841 RitMax : 62 InccrRitMax : 1
Estrazione : 8953 RitMax : 111 InccrRitMax : 49

Giusto Mike, ma i legend credo volesse ampliarlo fino al 3° livello se ho capito.. bene.. ovvero avere l'incmax di III° grado ma forse mi sbaglio... Ciao! :)

Ad ogni modo i legend questo è lo script per incmax di 2° livello, realizzato su mia richiesta dal grandissimo Luigi, cui si riferiva Mike.

Codice:
Option Explicit
Class clsParStat
	Dim idEstr
	Dim RitMax
	Dim IncrRitMax
End Class
Sub Main
	Dim idEstr,Ruota,Sorte
	Dim Inizio,Fine
	Dim k,p,i,r,pMax
	Dim Rit,RitMax,IncRitMax,Fre
	Dim collStoria
	Dim cParStat
	Dim bEstrValida
	Set collStoria = GetNewCollection
	Inizio = EstrazioneIni
	Fine = EstrazioneFin
	ReDim aN(90)
	If ScegliFormazione(aN) Then
		ReDim aRuoteSel(12)
		Ruota = ScegliRuotaEx(aRuoteSel)
		Sorte = ScegliEsito
		If Ruota > 0 And Sorte > 0 Then
			For idEstr = Inizio To Fine
				If Ruota = 11 Then
					bEstrValida = False
					pMax = 0
					For r = 1 To 10
						If Estratto(idEstr,r,1) > 0 Then bEstrValida = True
						p = 0
						For k = 1 To 5
							If aN(Estratto(idEstr,r,k)) Then
								p = p + 1
							End If
						Next
						If p > pMax Then pMax = p
					Next
					If bEstrValida Then
						If pMax >= Sorte Then
							If IncRitMax > 0 Then
								Set cParStat = New clsParStat
								cParStat.idEstr = idEstr - 1
								cParStat.RitMax = RitMax
								cParStat.IncrRitMax = IncRitMax
								collStoria.Add cParStat
							End If
							Rit = 0
							Fre = Fre + 1
							IncRitMax = 0
						Else
							Rit = Rit + 1
							If Rit > RitMax Then
								IncRitMax = IncRitMax + 1
								RitMax = Rit
							End If
						End If
					End If
					
				ElseIf Ruota = 13 Then
					bEstrValida = False
					pMax = 0
					For r = 1 To 12
						If aRuoteSel(r) Then
							If Estratto(idEstr,r,1) > 0 Then bEstrValida = True
							p = 0
							For k = 1 To 5
								If aN(Estratto(idEstr,r,k)) Then
									p = p + 1
								End If
							Next
							If p > pMax Then pMax = p
						End If
					Next
					If bEstrValida Then
						If pMax >= Sorte Then
							If IncRitMax > 0 Then
								Set cParStat = New clsParStat
								cParStat.idEstr = idEstr - 1
								cParStat.RitMax = RitMax
								cParStat.IncrRitMax = IncRitMax
								collStoria.Add cParStat
							End If
							Rit = 0
							Fre = Fre + 1
							IncRitMax = 0
						Else
							Rit = Rit + 1
							If Rit > RitMax Then
								IncRitMax = IncRitMax + 1
								RitMax = Rit
							End If
						End If
					End If

				Else
					If Estratto(idEstr,Ruota,1) > 0 Then
						p = 0
						For k = 1 To 5
							If aN(Estratto(idEstr,Ruota,k)) Then
								p = p + 1
							End If
						Next
						If p >= Sorte Then
							If IncRitMax > 0 Then
								Set cParStat = New clsParStat
								cParStat.idEstr = idEstr - 1
								cParStat.RitMax = RitMax
								cParStat.IncrRitMax = IncRitMax
								collStoria.Add cParStat
							End If
							Rit = 0
							Fre = Fre + 1
							IncRitMax = 0
						Else
							Rit = Rit + 1
							If Rit > RitMax Then
								IncRitMax = IncRitMax + 1
								RitMax = Rit
							End If
						End If
					End If
				End If
				Call AvanzamentoElab(Inizio,Fine,idEstr)
				If ScriptInterrotto Then Exit For
			Next
			If IncRitMax > 0 Then
				Set cParStat = New clsParStat
				cParStat.idEstr = idEstr - 1
				cParStat.RitMax = RitMax
				cParStat.IncrRitMax = IncRitMax
				collStoria.Add cParStat
			End If
			Call GestioneOutput(collStoria,RitMax,aN,Sorte,Inizio,Fine,Ruota,Rit,Fre,aRuoteSel)
		Else
			MsgBox "Ruota non valida"
		End If
	End If
End Sub
Function ScegliFormazione(aN)
	Dim sFormazione
	Dim k,i
	sFormazione = InputBox("Inserire la formazione da analizzare separando i numeri che la compongono con il punto",,"1.10.20")
	ReDim aV(0)
	Call SplitByChar(sFormazione,".",aV)
	For k = 0 To UBound(aV)
		If Int(aV(k)) > 0 And Int(aV(k)) <= 90 Then
			aN(Int(aV(k))) = True
			i = i + 1
		End If
	Next
	If i > 0 Then ScegliFormazione = True
End Function
Sub GestioneOutput(coll,RitMax,aN,Sorte,Inizio,Fine,Ruota,Rit,Fre,aRuoteSel)
	Dim x,y,k
	Dim sFrz
	Dim clsP
	For k = 1 To 90
		If aN(k) Then
			sFrz = sFrz & Format2(k) & "."
		End If
	Next
	sFrz = Left(sFrz,Len(sFrz) - 1)
	If Ruota = 13 Then
		Call Scrivi("Sulla ruota di        : " & GetStringaRuote(aRuoteSel))

	Else
		Call Scrivi("Sulla ruota di        : " & NomeRuota(Ruota))
	End If
	Call Scrivi("Formazione analizzata : " & sFrz)
	Call Scrivi("Da Estrazione         : " & GetInfoEstrazione(Inizio))
	Call Scrivi("A  Estrazione         : " & GetInfoEstrazione(Fine))
	Call Scrivi
	Call Scrivi("Ritardo              : " & Rit)
	Call Scrivi("RitardoMax           : " & RitMax)
	Call Scrivi("Frequenza            : " & Fre)
	Call Scrivi
	Call Scrivi("Dettaglio evoluzione RitMax",True)
	For Each clsP In coll
		Call Scrivi("Estrazione : " & FormatSpace(clsP.idEstr,5,True) & _
		" RitMax : " & FormatSpace(clsP.RitMax,5,True) & _
		" InccrRitMax : " & FormatSpace(clsP.IncrRitMax,5,True))
	Next
	Call Scrivi
	Call Scrivi("Grafico di confronto RitMax / IncRitMax",True)
	Call PreparaGrafico("",0,coll.count,0,RitMax,1,5)
	' prima riga
	ReDim aV(coll.count,2)
	For Each clsP In coll
		x = x + 1
		aV(x,1) = x
		aV(x,2) = clsP.RitMax
	Next
	Call DisegnaLineaGrafico(aV,vbBlue,"RitMax")
	x = 0
	ReDim aV(coll.count,2)
	For Each clsP In coll
		x = x + 1
		aV(x,1) = x
		aV(x,2) = clsP.IncrRitMax
	Next
	Call DisegnaLineaGrafico(aV,vbRed,"IncRitMax")
	' scrive grafico nell'output
	Call InserisciGrafico
End Sub
Function GetStringaRuote(aRuoteSel)
	Dim k
	Dim s
	
	For k = 1 To 12
		If aRuoteSel(k) Then
			s = s & SiglaRuota(k) & " "
		End If
	Next
	GetStringaRuote = s
End Function
Function ScegliRuotaEx(aRuoteSel)

	Dim k
	
	If MsgBox("Vuoi elaborare su piu ruote ?",vbQuestion + vbYesNo) = vbYes Then
		ReDim aV(10)
		ReDim aVociSel(10)
		
		For k = 1 To 10
			aV(k - 1) = NomeRuota(k)
		Next
		aV(10) = "Nazionale"
		
		Call ScegliDaLista(aV,aVociSel,"Selezione ruote")
		For k = 0 To 9
			aRuoteSel(k + 1) = aVociSel(k)
		Next
		aRuoteSel(12) = aVociSel(10)
		ScegliRuotaEx = 13
	Else
		ReDim aV(12)
		For k = 1 To 12
			aV(k) = NomeRuota(k)
		Next
		ScegliRuotaEx = ScegliOpzioneMenu(aV)
	End If
End Function
 
Ultima modifica:
Grazie Mike e Tom per il supporto. Avevo già trovato e cercato di studiare questo script, ma per me ora è troppo difficile .Credo che per quello che mi serve utilizzando il parametro aRitardi della funzione elencoRitardi dovrebbe comportare una scorciatoia. Voglio scrivere una funzione ad hoc. Buona serata, vi tengo aggiornati, grazie mille ragazzi:) x tom , si cerco di capire di quanto si sono incrementati gli ultimi 3 ritardi massimi.... devo avere solo la testa e la pazienza per farlo forse non è difficile.
 
Ciao la soluzione era cosi semplice che arrossirei se avessi le faccine da postare....:) Ecco il codice, la soluzione è ordina matrice
Codice:
 Function OrdIncrementiMax(aRitardi()) 	Dim x,y,ris 	Call OrdinaMatrice(aRitardi,1) 	For x = UBound(aRitardi) - 1 To UBound(aRitardi) - 3 Step - 1 		y = x + 1 		ris = aRitardi(y) - aRitardi(x) & "." & ris 		ris = RimuoviLastChr(ris,".") 	Next 	OrdIncrementiMax = ris End Function
X Luigi : hai utilizzato il quick sort per ordinaMatrice?-------------------------------------- ciao e grazie a tutti----------------------------------------------------------------------------- P.S:-------------------------------------------------------------------------------------------- per utilizzare la funzione bisogna richiamare la---------------------------------------------- Call ElencoRitardiTurbo(aNumeri,aRu,nSorte,Ini,Fin,aRetRitardi,aRetIdEstr)--------------
 
Ciao la soluzione era cosi semplice che arrossirei se avessi le faccine da postare....:) Ecco il codice, la soluzione è ordina matrice
Codice:
 Function OrdIncrementiMax(aRitardi()) 	Dim x,y,ris 	Call OrdinaMatrice(aRitardi,1) 	For x = UBound(aRitardi) - 1 To UBound(aRitardi) - 3 Step - 1 		y = x + 1 		ris = aRitardi(y) - aRitardi(x) & "." & ris 		ris = RimuoviLastChr(ris,".") 	Next 	OrdIncrementiMax = ris End Function
X Luigi : hai utilizzato il quick sort per ordinaMatrice?-------------------------------------- ciao e grazie a tutti----------------------------------------------------------------------------- P.S:-------------------------------------------------------------------------------------------- per utilizzare la funzione bisogna richiamare la---------------------------------------------- Call ElencoRitardiTurbo(aNumeri,aRu,nSorte,Ini,Fin,aRetRitardi,aRetIdEstr)-------------- Controllare se ci sono Errori
 
Ciao se può interessare questa è la funzione che ho scritto
spero non ci siano errori
Codice:
Function OrdIncrementiMax(nIncMax,aRitardi()) 
' nIncMax=numero di incrementi che vogliamo valutare
' ovviamente nIncMax<degli elementi della matrice aRitardi
' altrimenti restituisce errore
    Dim x,y,ris
' in questo caso valuto gli ultimi 5 incrementi, se due ritmax sono  uguali restituisce 0 
' SE cerco un terno a ruota probabilmente 5 incrementi sono troppo
'nIncMax=5 quando valuto la funzione nIncMax lo scelgo io nel momento che scrivo la funzione, altrimenti sarebbe
' inutile come parametro
    Call OrdinaMatrice(aRitardi,1)
    For x = UBound(aRitardi) - 1 To UBound(aRitardi) - nIncMax Step - 1
        y = x + 1
        ris = Format2(aRitardi(y) - aRitardi(x)) & "." & ris
        ris = RimuoviLastChr(ris,".")
    Next
    OrdIncrementiMax = ris
End Function

Se si può migliorare od ottimizzare chiedo ai miei maestri:)
Ciao e grazie a tutti:)
 
Ultima modifica:
ciao Legend .. a che serve levare il punto alla fine della stringa ad ogni iterazione del ciclo ?
 
Ultima modifica di un moderatore:
ciao Luigi, serve a rallentare di molto la funzione?
ciao ho riscritto la funzione con solo 3 incrementi,
Domanda se le estrazioni sono cosi poche da non avere 3 incrementi come lo gestisco ho provato con la parte remmata ma se se non ci sono Rit l'indice è zero ....
Non so....
Ciao e grazie:)
Codice:
Function OrdIncrementiMax(aRitardi())
    Dim x,y,ris,nIncr,conta
    nIncr = 3
    'For conta = 1 To UBound(aRitardi)-2
        'conta = conta + 1
    'Next
       ' If nIncr > conta Then nIncr = conta 
            Call OrdinaMatrice(aRitardi,1)
    For x = UBound(aRitardi) - 1 To UBound(aRitardi) - nIncr Step - 1
        y = x + 1
        ris = Format2(aRitardi(y) - aRitardi(x)) & "." & ris
    Next
    ris = RimuoviLastChr(ris,".")
    OrdIncrementiMax = ris
End Function
 
Ultima modifica:
invece del ciclo next usa un ciclo do
prima di entrare nel ciclo do avrai valorizzato una variabile all'indice piu alto che vuoi valutare dell array Ritardi
nel ciclo do calcoli la differenza tra l'elemento corrente identificato dalla suddetta variabile e l'elemento precedente a questo.
Questo calcolo pero va racchiuso dentro una condizione che verifica che gli id che identificano gli elementi dell'array Ritardi
siano coerenti (ovvero >0 ) , se non lo sono vuol dire che l'array non ha abbastanza elementi quindi esci dal ciclo.
Dentro la condizione if di cui sopra e dopo il calcolo avrai cura di incrementare una variabile che indica il numero di differenze trovate
con questa variabile ridimensionerai un array preservandone il condenuto e nel nuovo elemento andrai a scrivere il valore della differenza
fuori dall'if dovrai decrementare la variabile che avevi preparato all'inizio e che identificava l'indice piu alto dell'array

All'uscita del ciclo do avrai quindi un array che memorizza le n differenze trovate che potrebbero essere 0 , 1 , 10 ... quelle che ci sono
poi tu se vuoi usare solo le ultime 3 le leggi nelle posizioni appropriate
...
Vediamo un po' se segui bene la ricetta..fatti aiutare anche dagli altri
 
Ok , mi hai fatto venire il mal di testa....Ci provo :)..... Mi sembrava strano che fosse così semplice come avevo fatto io.....
Mi metto a lavoro:)
Grazie mille per le indicazioni:)
A dopo
 
provaci , è seplice lo stesso devi solo tradurre quello che ti ho scritto.. poi se non ci riesci ti postero io la funzione ..appena me lo dirai.
 
ciao, Luigi, grazie. ci provo stasera.Sei sempre disponibile. ci studio su ...spero di dimostrarti, che sei un buon seminatore:)
 
Ciao Luigi. puoi segnare con un asterisco tutte le righe sbagliate?
Non postare ancora la funzione per favore,

Codice:
Function IncrementiMax(aRitardi())
    Dim x,y,ris,nIncr,conta,z
    Dim qIncr
    ReDim aArrayInc(0)
    
    qIncr = UBound(aRitardi)-1 
    conta = 0
    Call OrdinaMatrice(aRitardi,1)
    Do While conta < qIncr
        For x = 1 To qIncr- 1
            y = x + 1
            conta = conta + 1
            ris =(aRitardi(y) - aRitardi(x))
        Next
        If conta>0 Then

                    ReDim Preserve aArrayInc(conta)
                    aArrayInc(conta)=ris
else
exit do
        End If
        
    Loop
    
    For conta =  1 To 3
        ris= aArrayInc(conta)&"."&ris
    Next

    ris=RimuoviLastChr(ris,".")
    IncrementiMax=ris
End Function

Purtroppo anche la funzione ultimi 5 ritardi mi da errore se le estrazioni sono poche
Codice:
Function Ultimi5Ritardi(aRetRit())
    Dim n1,r1
    For n1 = UBound(aRetRit) - 1 To UBound(aRetRit) - 5 Step - 1
        r1 = Format2(aRetRit(n1)) & "." & r1
        r1 = RimuoviLastChr(r1,".")
    Next
    Ultimi5Ritardi = r1
End Function
 
ciao Legend , non ho corretto il tuo script perche vorre che tu seguissi questo algoritmo nel quale non sono presenti cicli for ma un solo ciclo do


image hosting
 
Ciao Luigi, Wow hai fatto lo script, l'ho trascritto, è ovviamente funziona:)
Questa funzione può essere molto utile a tutti ai fini statistici
Ecco il Codice, ho aggiunto un altro dato in input, per renderlo più flessibile per tutti...senza modificare la funzione:)
Spero che sia corretto,
Se non è corretto Mi dai altre indicazioni?
Ciao e grazie Mille:)
Codice:
Function aIncRit(qIncr,aRitardi())
    Dim nPuntatore
    Dim nPuntatoreTmp
    Dim nDiffTrovate
    'Dim aRetDiff(0)
    Dim i,Ris
    Call OrdinaMatrice(aRitardi,1)
    nPuntatore = UBound(aRitardi)
    nDiffTrovate = 0
    ReDim aRetDiff(nDiffTrovate)
    Do While nPuntatore > 0
        If nPuntatore > 0 Then
            nPuntatoreTmp = nPuntatore - 1
            If nPuntatoreTmp > 0 Then
                nDiffTrovate = nDiffTrovate + 1
                ReDim Preserve aRetDiff(nDiffTrovate)
                aRetDiff(nDiffTrovate) = aRitardi(nPuntatore) - aRitardi(nPuntatoreTmp)
                nPuntatore = nPuntatore - 1
            Else
                Exit Do
            End If
        Else
            Exit Do
        End If
    Loop
    ' ho aggiunto questo pezzo sele estrazioni sono poche
    ' oppure il numero di incrementi scelto è maggiore delle
    ' differenze trovate
    If nDiffTrovate = 0 Then
        aIncRit = "N.P"
    ElseIf nDiffTrovate < qIncr Then
        qIncr = nDiffTrovate 
    ElseIf nDiffTrovate > qIncr Then
        For i = 1 To qIncr
            Ris = aRetDiff(i) & "." & Ris
        Next
        Ris = RimuoviLastChr(Ris,".")
        aIncRit = Ris
    End If
End Function
 

Ultima estrazione Lotto

  • Estrazione del lotto
    martedì 21 gennaio 2025
    Bari
    78
    09
    70
    03
    23
    Cagliari
    32
    88
    30
    13
    45
    Firenze
    87
    23
    15
    39
    86
    Genova
    71
    48
    67
    59
    23
    Milano
    58
    50
    80
    85
    29
    Napoli
    90
    81
    79
    82
    62
    Palermo
    70
    33
    90
    05
    10
    Roma
    15
    71
    55
    85
    76
    Torino
    89
    09
    18
    33
    69
    Venezia
    44
    80
    82
    73
    58
    Nazionale
    80
    25
    13
    63
    17
    Estrazione Simbolotto
    Bari
    39
    36
    34
    14
    31
Indietro
Alto