Si può fare di meglio?

LuigiB · 8 Ottobre 2018

Ciao . L hai installata l ultima versione della libreria che ho postato sopra ? Ti funzionava lo script modificato da Magia ?

fillotto · 8 Ottobre 2018

lo script di magia mi funziona eccetto se metto tutte , l ultima versione della libreria l'ho scaricata ...ma scusa l' ignoranza

lo step successivo?

LuigiB · 8 Ottobre 2018

Installarla...Se l hai scaricata è basta è ovvio che non funziona...è come quando vai a comprare un panino se il panino lo lasci nelle busta del salumiere il panino ce l avrai pure ma anche la fame...

solare · 8 Ottobre 2018

Ciao Luigi, io ho installato il tuo file delle librerie. Il problema dell'errore persiste solo se si seleziona "Tutte"

LuigiB · 8 Ottobre 2018

Certo perché tutte non è previsto per fare tutte vanno segnate le 10 ruote o lo script se si rende conto che l utente ha messo tutte deve provvedere da solo a creare l array con le 10 ruote

fillotto · 8 Ottobre 2018

Grazie Luigi adesso funziona.
Per tutti gli imbranati come me fate come quando istallate una nuova versione di spaziometria,insomma istallatelo!!!

solare · 8 Ottobre 2018

Grazie Luigi

solare · 8 Ottobre 2018

Ciao Fillotto, come hai risolto il problema della ricerca a tutte ?

Membro cancellato 16574 · 8 Ottobre 2018

Buonanotte ,
Salutando gli intervenuti .
Ringraziamo LuigiB , per le modifiche ,
che abbiamo appena provato e che funzionano bemissimo .
Pertanto abbiamo provedduto a modificare il listato ,
Controllare Sempre .
Salvo Errori ed Omissis .

fillotto · 8 Ottobre 2018

solare;n2134130 ha scritto:
Ciao Fillotto, come hai risolto il problema della ricerca a tutte ?

L'ha risolto Magia correggendo lo script di cui al #50

LuigiB · 8 Ottobre 2018

infatti , la coppia Magia Amaretto interviene sempre al momento del bisogno .. ottimo il modo in cui hanno sitematola faccenda delel ruote... a proposito ma che ad Amaretto gli si è rotto il tasto Enter e gli si è inchiodato il tasto dei due puunti

? Eheh scherzo ...ognuno ha il suo stile ..ciao ...

LuigiB · 8 Ottobre 2018

Per Nikor il discorso sulla combinazione base di cui hai accennato è valido ma credo cosi ad intuito lo sia solo nel caso della ricerca dei ritardi .. nel caso della ricerca delle presenze per me è probabilissimo che la combinazione piu presente di classe Sorte sia anche contenuta nella lunghetta piu prolifica ...il mio script infatti si basa su quello non prende colonen a caso ma ha una sua logica , tenta di costuire le lunghette migliori partendo dalla classifica delle singole combinazioni di classe sorte ordinate per presenza.
Che ne pensi ? Dalle prove sommarie che ho fatto mi sembra che le lunghette che trova siano equiparabili a quelle di una ricerca determiiistica anche se ovviamente il mio script non puo indicare tutte le lunghette esistenti con un dato valore di presenza...

ciao ..

Membro cancellato 16574 · 8 Ottobre 2018

Buonanotte ,
Salutando silop2005 .
Abbiamo modificato il listato , per le funzioni FT .
Da provare e verificare .

Codice:

Option Explicit
'Si può fare di meglio? di fillotto
'https://forum.lottoced.com/forum/lottoced/area-download/2133073-si-pu%C3%B2-fare-di-meglio
'messaggio #39
Dim clsHSS
Class clsCombinazione
   Private aNum
   Private aBNum
   Private mFrequenze
   Private mPresenze
   Private mClasse
   Private mKey
   Private aIdEstr
   Private nTrov
   Private Sub Class_Initialize()
      mFrequenze = 00
      mPresenze = 00
      ReDim aBnum(55)
   End Sub
   Public Property Get Classe
      Classe = mClasse
   End Property
   Public Property Let Classe(v)
      mClasse = v
   End Property
   Public Property Get ArrayNum
      ArrayNum = aNum
   End Property
   Public Property Get Key
      Key = mKey
   End Property
   Public Property Let Key(v)
      mKey = v
   End Property
   Public Property Get Presenze
      Presenze = mPresenze
   End Property
   Public Property Get Frequenze
      Frequenze = mFrequenze
   End Property
   Public Property Get Combinazione
      Combinazione = StringaNumeri(aNum,,True)
   End Property
   Sub IncrementaFrequenze
      mFrequenze = mFrequenze + 01
   End Sub
   Sub SetNumeri(aNumTmp)
      Dim k
      aNum = aNumTmp
      For k = 01 To UBound(aNum)
         aBNum(aNum(k)) = True
      Next
   End Sub
   Sub CalcolaFrequenza(nSorte,nIni,nFin)
      'mFrequenze = SerieFreqTurbo(nIni,nFin,aNum,aRuote,nSorte)
      mFrequenze = clsHSS.SerieFreqTxt(nIni,nFin,aNum,nSorte)
   End Sub
   Sub CalcolaPresenze(nSorte,Inizio,Fine)
      Dim k,r,e,nPunti,nPresenze
      Dim aB
      ReDim aNumRuota(05)
      nPresenze = 00
      For k = Inizio To Fine
         Call GetArrayNumeri(k,aNumRuota)
         nPunti = 00
         For e = 01 To 05
            If aBNum(aNumRuota(e)) Then
               nPunti = nPunti + 01
            End If
         Next
         If nPunti >= nSorte Then
            nPresenze = nPresenze + 01
         End If
      Next
      mPresenze = nPresenze
   End Sub
   Sub AddIdEstr(v)
      nTrov = nTrov + 01
      ReDim Preserve aIdEstr(nTrov)
      aIdEstr(nTrov) = v
   End Sub
End Class
Private aEstrattiBool
Sub Main
   Dim sFileArchivio : sFileArchivio = GetDirectoryAppData & "Archivio MillionDAY\MillionDay_ordinato.txt"
   Call ApriBaseDatiFT(sFileArchivio,05,";",05)
   Set clsHSS = CreateObject("HSS.ClsHighSpeedStat") : Call clsHSS.Init(sFileArchivio,09,";",05)
   '
   Dim nEstrDaUSare,nClasse,nSorte,CollLunghette,nIni,nFin,k
   nEstrDaUSare = 10' 18 '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
   '
   nClasse = ScegliClasse()' 7 '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
   nSorte = ScegliSorte()' 2 '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
   nIni =(EstrazioniArchivioFT - nEstrDaUSare) + 01
   nFin = EstrazioniArchivioFT
   Set CollLunghette = GetCollLunghettaMigliori(nIni,nFin,nClasse,nSorte,nEstrDaUSare)
   Call AlimentaTabOutput(CollLunghette,nClasse,nSorte)
   Set clsHSS = Nothing
End Sub
Sub GetArrayNumeri(k,aNum)
   aNum(01) = EstrattoFT(k,01)
   aNum(02) = EstrattoFT(k,02)
   aNum(03) = EstrattoFT(k,03)
   aNum(04) = EstrattoFT(k,04)
   aNum(05) = EstrattoFT(k,05)
End Sub
Sub AlimentaTabOutput(CollLunghette,nClasse,nSorte)
   Dim av,cLung
   Call Scrivi("Classe : " & nClasse)
   Call Scrivi("Sorte  : " & nSorte)
   Call Scrivi("Tempo Trascorso : " & TempoTrascorso)
   av = Array("","Lunghetta","Frequenza","Presenza")
   Call InitTabella(av)
   For Each cLung In CollLunghette
      av(01) = cLung.Combinazione
      av(02) = cLung.Frequenze
      av(03) = cLung.Presenze
      Call AddRigaTabella(av)
   Next : Call MsgBox(TempoTrascorso) : Call ScegliTipoTabella()
End Sub
Function GetCollLunghettaMigliori(Inizio,Fine,nClasse,nSorte,nEstrUsate)
   Dim CollComb,cComb
   Dim CollLung,cLung
   Dim k,j,e
   Dim nFatte,nDaFare
   Dim nRetFrequenze
   Dim sKey
   ReDim aCol(nSorte)
   ReDim abNumValidi(55)
   ReDim aEstrattiBool(nEstrUsate,55)
   Call AlimentaArrayEstrattiBool(aEstrattiBool,Inizio,Fine)
   Set CollComb = GetNewCollection
   Set CollLung = GetNewCollection
   ' alimento una collection con tutte le combinazioni di classe <nSorte> che si
   ' formano con le cinquine comprese nel range interessato
   ' di ogni singola combinazione si calcolano le frequenze
   For k = Inizio To Fine
      ReDim aNum(05)
      Call GetArrayNumeri(k,aNum)
      For e = 01 To 05
         abNumValidi(aNum(e)) = True
      Next
      Call OrdinaMatriceTurbo(aNum,01)
      Call InitSviluppoIntegrale(aNum,nSorte)
      Do While GetCombSviluppo(aCol)
         sKey = "k" & StringaNumeri(aCol,,True)
         If GetItemCollection(CollComb,sKey,cComb) Then
            cComb.IncrementaFrequenze
         Else
            Set cComb = New clsCombinazione
            cComb.Classe = nSorte
            cComb.SetNumeri(aCol)
            cComb.key = sKey
            cComb.IncrementaFrequenze
            Call AddItemColl(CollComb,cComb,sKey)
         End If
      Loop
      Call AvanzamentoElab(Inizio,Fine,k)
   Next
   Call AvanzamentoElab(Inizio,Fine,Inizio)
   ' ordino la collection contenente tutte le combinazioni di classe <nSorte> per il valore frequenza
   Call OrdinaItemCollection(CollComb,"Frequenze","Key")
   ' da ognuna delle combinazioni base scasturirà una lunghetta quindi ciclo su tutte
   ' le combinazioni base presenti nella collection e per ciascuna costruirò una lunghetta
   nDaFare = CollComb.count
   nFatte = 00
   For Each cComb In CollComb
      ReDim aRetCol(nClasse)
      ' ottiene la lunghetta "migliore" che contiene la combinazione base
      If GetLung(cComb,aRetCol,nRetFrequenze,CollComb,Inizio,Fine,nSorte,nClasse,abNumValidi,nEstrUsate) Then
         ' aggiungo la lunghetta trovata in una nuova collection
         Set cLung = New clsCombinazione
         cLung.Classe = nClasse
         Call OrdinaMatriceTurbo(aRetCol,01)
         cLung.SetNumeri(aRetCol)
         sKey = "k" & StringaNumeri(aRetCol,,True)
         Call cLung.CalcolaFrequenza(nSorte,Inizio,Fine)
         Call cLung.CalcolaPresenze(nSorte,Inizio,Fine)
         Call AddItemInColl(cLung,sKey,CollLung)
      End If
      nFatte = nFatte + 01
      If nFatte Mod 10 = 00 Then
         Call Messaggio(nFatte)
         Call AvanzamentoElab(1,nDaFare,nFatte)
         If ScriptInterrotto Then Exit For
         Call DoEventsEx()
      End If
   Next
   ' ordino la collection delle lunghette trovate per poi mostrarle in output
   Call OrdinaItemCollection(CollLung,"Presenze")
   Set GetCollLunghettaMigliori = CollLung
End Function
Sub AlimentaArrayEstrattiBool(aEstrattiBool,Inizio,Fine)
   Dim idEstr,i,e
   ReDim aNum(05)
   For idEstr = Inizio To Fine
      i = i + 01
      Call GetArrayNumeri(idEstr,aNum)
      For e = 01 To 05
         aEstrattiBool(i,aNum(e)) = True
      Next
   Next
End Sub
Sub AddItemInColl(cItem,sKey,Coll)
   On Error Resume Next
   Coll.Add cItem,sKey
   If Err <> 00 Then Err.Clear
End Sub
Function GetLung(cComb,aRetCol,nRetPres,collComb,Inizio,Fine,nSorte,nClasse,abNumValidi,nQtEstrUsate)
   ' a partire dalla combinazione base costruisce la lunghetta migliore (piu prolifica per presenze)
   Dim nPos,n,nPresMax,nNum,nPresTmp,k,aNumBase
   Dim aNumDaSvil,nQtNumDaSvil,aColDaPrendere,bFound
   ReDim aBUsati(55)
   Dim objSvil
   Dim sKey
   Dim cCombTmp
   Dim nClasseSvilTmp
   ' inizializzo un nuovo motore di sviluppo
   Set objSvil = GetMotoreSviluppoIntegrale
   ' leggo i numeri della combinazione base
   aNumBase = cComb.ArrayNum
   For k = 01 To cComb.Classe
      aRetCol(k) = aNumBase(k)
      aBUsati(aRetCol(k)) = True
   Next
   ' faccio in clclo che dura fino a quando la lunghetta non arriva a contenere la quantità
   ' di numeri voluta
   ' la lunghetta parte con i numeri della combinazione base
   ' i numeri vengono aggiunti sviluppandoli con combinazioni di classe <nSorte>
   ' al termine del ciclo do sia avrà la combinazione migliore da aggiungere
   ' alla lunghetta base
   ' il giro continua finche la lunghetta non raggiunge la quantita di numeri voluti
   nPos = cComb.Classe
   Do While nPos < nClasse
      ' calcolo  la classe per sviluppare le combinazioni da testare insieme ai numeri gia presenti
      ' nella lunghetta
      ' se possibile la classe di sviluppo è pari a <nSorte> senno viene calcolata e assume un valore inferiore
      If nClasse - nPos >= nSorte Then
         nClasseSvilTmp = nSorte
      Else
         nClasseSvilTmp = nClasse - nPos
      End If
      ' predispongo la lunghetta per accogliere i numeri che otterremo dallo sviluppo
      ReDim Preserve aRetCol(nPos + nClasseSvilTmp)
      ' individuo i numeri da sviluppare i quali devono avere la c aratteristica sia di essere usciti
      ' nelle estrazioni coinvolte dal range sia di non essere gia presenti nella lunghetta stessa
      ReDim aNumDaSvil(55)
      nQtNumDaSvil = 00
      For n = 01 To 55
         If Not(aBUsati(n)) Then
            If abNumValidi(n) Then
               nQtNumDaSvil = nQtNumDaSvil + 01
               aNumDaSvil(nQtNumDaSvil) = n
            End If
         End If
      Next
      ReDim Preserve aNumDaSvil(nQtNumDaSvil)
      ' inizio a sviluppare le combinazioni da testare insieme ai numeri della lunghetta
      ReDim aCol(nClasseSvilTmp)
      bFound = False
      Call objSvil.InitSviluppoIntegrale(aNumDaSvil,nClasseSvilTmp)
      Do While objSvil.GetCombSviluppo(aCol)
         ' nelle opportune posizioni dell'array della lunghetta pongo i numeri della combinazione sviluppata
         For k = 01 To nClasseSvilTmp
            aRetCol(nPos + k) = aCol(k)
         Next
         ' calcolo le presenze della lunghetta
         '
         nPresTmp = Presenze(aRetCol,nQtEstrUsate,UBound(aRetCol),nSorte)''''''''''''''''''''''''''''''''''
         '
         ' se le presenze calcolate sono >= a quelle gia inidviduate allora
         ' devo tenere traccia della combinazione da prendere per inserirla
         ' nella lunghetta all'uscita  del ciclo
         If nPresTmp >= nPresMax Then
            aColDaPrendere = aCol
            nPresMax = nPresTmp
            bFound = True
         End If
      Loop
      ' se ho trovato una combinazione da poter inserire nella lunghetta
      ' procedo ad inserirla e tengo traccia della nuova dimensione (quantita dei numeri)
      ' della lunghetta
      ' se non ho trovato niente è inutile continuare esce
      If bFound Then
         For k = 01 To nClasseSvilTmp
            aRetCol(nPos + k) = aColDaPrendere(k)
            aBUsati(aColDaPrendere(k)) = True
         Next
         nPos = nPos + nClasseSvilTmp
      Else
         Exit Do
      End If
   Loop
   ' se la lunghetta ha raggiunto la dimesnione prevista la funzione torna true
   If nPos = nClasse Then
      GetLung = True
   Else
      GetLung = False
   End If
End Function
Sub AlimentaNumValidi(aCol,Inizio,Fine,aRuote,abNumValidi)
   ' funzione usata per test non nello script
   ReDim abNumValidi(55)
   ReDim aNumRuota(05)
   Dim idEstr,e
   For idEstr = Inizio To Fine
      Call GetArrayNumeri(idEstr,aNumRuota)
      If PuntiSuArray(aNumRuota,aCol) > 01 Then
         For e = 01 To 05
            abNumValidi(aNumRuota(e)) = True
         Next
      End If
   Next
End Sub
Function Presenze(aColDaSvilTmp,nQtEstrUsate,nClasseLunghetta,Sorte)
   ' calcola le presenze di una lunghetta
   Dim k,r,e,nPunti,aNumRuota,nPresenze
   ' Dim aB
   nPresenze = 00
   ' aB = ArrayNumeriToBool(aColDaSvilTmp)
   For k = 01 To nQtEstrUsate
      '         Call GetArrayNumeriRuota(k,aRuote(r),aNumRuota)
      nPunti = 00
      For e = 01 To nClasseLunghetta
         If aEstrattiBool(k,aColDaSvilTmp(e)) Then
            nPunti = nPunti + 01
         End If
      Next
      If nPunti >= Sorte Then
         nPresenze = nPresenze + 01
      End If
   Next
   Presenze = nPresenze
End Function
Function ScegliClasse()
   Dim k,i,aVoci(10) : For k = 01 To(01 - 01) + UBound(aVoci) : i = i + 01 : aVoci(i) = k : Next
   k = ScegliOpzioneMenu(aVoci,07,"Selezionare Classe Sviluppo Lunghetta")
   ScegliClasse = Int(aVoci(k))
End Function
Function ScegliSorte()
   Dim i,aVoci(05) : For i = 01 To 05 : aVoci(i) = NomeSorte(i) : Next
   ScegliSorte = ScegliOpzioneMenu(aVoci,02,"Selezionare Sorte da Analizzare")
End Function
Function ScegliTipoTabella()
   Dim aVoci : aVoci = Array(aVoci,"Tabella Normale","Tabella Ordinabile")
   ScegliTipoTabella = ScegliOpzioneMenu(aVoci,02,"Selezionare Tipo Tabella")
   If ScegliTipoTabella = 01 Then : Call CreaTabella() : Else : Call CreaTabellaOrdinabile() : End If
End Function

Controllare Sempre .
Salvo Errori ed Omissis .

fillotto · 8 Ottobre 2018

X magia lo script di cui al # 50 mi sembra errato in quanto se si sceglie una ruota diversa da BA mi da sempre la situazione di BARI

solare · 8 Ottobre 2018

Ottimo grazie magia

solare · 8 Ottobre 2018

Per Magia, ho provato lo script, a tutte funziona però ho notato un errore dopo elaborazione non indica le ruote che ho messo.
inizialmente avevo inserito la ricerca su to ve mentre nella tabella dopo elaborazione mi riporta ca ve.

Nikor · 8 Ottobre 2018

LuigiB;n2134138 ha scritto:
Per Nikor il discorso sulla combinazione base di cui hai accennato è valido ma credo cosi ad intuito lo sia solo nel caso della ricerca dei ritardi .. nel caso della ricerca delle presenze per me è probabilissimo che la combinazione piu presente di classe Sorte sia anche contenuta nella lunghetta piu prolifica ...il mio script infatti si basa su quello non prende colonen a caso ma ha una sua logica , tenta di costuire le lunghette migliori partendo dalla classifica delle singole combinazioni di classe sorte ordinate per presenza.
Che ne pensi ? Dalle prove sommarie che ho fatto mi sembra che le lunghette che trova siano equiparabili a quelle di una ricerca determiiistica anche se ovviamente il mio script non puo indicare tutte le lunghette esistenti con un dato valore di presenza...

ciao ..

Buona sera Luigi. Il mio parere non è che possa contare molto, ma l’argomento ritardi è senza ombra di dubbio come lo avevo esposto, salvo qualche rara eccezione perché di prove ne avevo fatte a bizzeffe!

Per le frequenze quanto hai scritto è in primis il filo logico per trovare la strada più breve , ed è anche possibile che nelle lunghette siano presenti formazioni minori di sotto gruppi che siano stati i più generosi in fase di congrui!

Ma anche per le frequenze c’è un Ma !

Sai che io sono un ritardista , ma non per questo non è che non mi sia in passato cimentato anche sulle frequenze.
Ti posto 2 esempi dove potrai appurare che anche nelle frequenze rimane sempre quel Mà !!!

Range Venus dal 11/06/2009 al 25/06/2003 = a 633 estrazioni.
Decina più generosa per punti 9 con ben 4 presenze !!!

01.04.20.32.50.51.56.66.68.78 ( a saperlo prima mi facevo invitare a tue spese a mangiare gli gnocchi alla romana perché sono golosissimo…)
Stesso range di 633 estrazioni , terni più frequenti:

Sono 13 terni dove si evince che nella lunghetta non solo non ci siano terni ma manco gli ambi , solo pochissime ambate!
Secondo esempio , range 1137 estrazioni dal 11/06/2009 al 13/09/2016:
Settine più frequenti per 7 punti ! ( 4 presenze per settina del punteggio pieno del 7! )
15.25.33.45.69.76.78
02.07.46.57.58.75.76
11.20.25.35.80.87.88
18.20.51.56.66.68.78
Stesso range 1137 estrazioni , terni più frequenti:

Non troviamo nelle settine un terno dei più frequenti manco a pagarlo oro! me pare pure che non ci siano ambi......

Ciao ripasso la palla…. a Er mejo….

Nikor.

silop2005 · 8 Ottobre 2018

magia;n2134141 ha scritto:
Buonanotte ,
Salutando silop2005 .
Abbiamo modificato il listato , per le funzioni FT .
Da provare e verificare .

Controllare Sempre .
Salvo Errori ed Omissis .

====================================== [TABLE="border: 0, cellpadding: 0, cellspacing: 0"]
[TR]
[TD="width: 755"]SPMT vers. 1.6.26_Agg.Web e relativo plugin SVP vers. 1.0.56 e Plugin_FTP vers. 1.0 e SpazioScript vers.1.0.9[/TD]
[/TR]
[TR]
[TD]====================== [/TD]
[/TR]
[TR]
[TD]Ciao Magia ,[/TD]
[/TR]
[TR]
[TD]ho verificato e funziona tutto.[/TD]
[/TR]
[TR]
[TD]GRAZIE per le modifiche FT allo script di LuigiB[/TD]
[/TR]
[TR]
[TD]alla lotteria Millionday.[/TD]
[/TR]
[TR]
[TD]Ricambio i saluti e sempre a disposizione per gli amici virtuali.[/TD]
[/TR]
[TR]
[TD]====================== [/TD]
[/TR]
[TR]
[TD]

[/TD]
[/TR]
[TR]
[TD]Buona notte a tutti.[/TD]
[/TR]
[TR]
[TD]A presto [/TD]
[/TR]
[TR]
[TD] Silop

[/TD]
[/TR]
[/TABLE]

LuigiB · 9 Ottobre 2018

Ciao Nikor il tuo parere ovviamente conta è mi fa piacere delle delucidazioni che hai dato...è chiaro che in ambito pc vada accettato qualche compromesso altrimenti non è possibile avere ina soluzione perciò ho scelto la strada delle combinazioni base...dai alla prima vincita vieni tu a offrirmi gli gnocchi alla romana....Io penserò alla scelta dello hosteria....non sono tipo da ristorante guida Michelin....ciao...

solare · 9 Ottobre 2018

Scusate, succede anche a voi l'errore che da a me per quanto riguarda il listato di magia: nella richiesta di elaborazione metto pa ed elabora bari. oppure ba-ca ed elabora altre ruote.

Si può fare di meglio?

LuigiB

Guest

Advanced Member >PLATINUM<

LuigiB

Guest

Advanced Member >PLATINUM<

LuigiB

Guest

Advanced Member >PLATINUM<

Advanced Member >PLATINUM<

Advanced Member >PLATINUM<

Membro cancellato 16574

Guest

Advanced Member >PLATINUM<

LuigiB

Guest

LuigiB

Guest

Membro cancellato 16574

Guest

Advanced Member >PLATINUM<

Advanced Member >PLATINUM<

Advanced Member >PLATINUM<

Premium Member

Advanced Member >PLATINUM<

LuigiB

Guest

Advanced Member >PLATINUM<