Condividi:        

Classi e radici quadrate applicate ai 90 numeri del lotto.

Vuoi potenziare i tuoi documenti Word? Non sai come si fa una macro in Excel? Devi creare una presentazione in PowerPoint?
Oppure sei passato a OpenOffice e non sei sicuro di come lavorare al meglio?

Moderatori: Anthony47, Flash30005

Classi e radici quadrate applicate ai 90 numeri del lotto.

Postdi nelson1331 » 30/12/21 12:47

Ciao Anthony47,
ogni tanto mi faccio vivo, per proporti nuovi test sui 90 numeri del lotto.
Questa volta, parliamo di classi e radici quadrate.
Esprimo meglio le classi :
2 numeri = ambo
3 numeri = terno
4 Numeri = quaterna
5 Numeri = cinquina
6 Numeri = sestina
7 Numeri = settina
Per la mia richiesta, vista la mole di dati che verranno movimentati, soprattutto dalle settine, penso che basti ed avanzi.
Parliamo delle radici quadrate, applicando ad ogni classe il suo quadrato.
Se avessi la coppia di ambi 31 e 47 il seguito sarebbe :
31^2+47^2=961+2209=3170
Infine : radice quadrata di 3170 = 56,3027 Questo risultato, implica dei decimali ed a me non interessa.
Questa coppia, percio' la escludo.
Cosa serve a me ?
Solo quelle linee che, per ogni classe, abbiano resto=zero.
L' esempio piu' facile da comprendere e' la coppia di ambi 3.4 ----> Teorema di Pitagora
3^2+4^2=9+16=25 Radice quadrata di 25 = 5 resto =zero Perfetta Ok la prendo.
Il programma dovrebbe percio' evidenziarmi in ordine : prima l' indice di posizione, poi gli elementi che compongono quella classe.
Nello specifico caso, l' indice di posizione della coppia 3.4 e' il 178.
Ho gia' fatto questo lavoro per la classe =2 trovando 56 condizioni soddisfacenti.
Cosi' pure per la classe =3 dove ho trovato 607 condizioni soddisfacenti.
Dalla 4° classe in poi fino alla 7°, chiedo il tuo aiuto.
Grazie se potrai.
Nelson
nelson1331
Utente Junior
 
Post: 93
Iscritto il: 18/02/08 08:58

Sponsor
 

Re: Classi e radici quadrate applicate ai 90 numeri del lott

Postdi nelson1331 » 31/12/21 18:02

nelson1331 ha scritto:Ciao Anthony47,
ogni tanto mi faccio vivo, per proporti nuovi test sui 90 numeri del lotto.
Questa volta, parliamo di classi e radici quadrate.
Esprimo meglio le classi :
2 numeri = ambo
3 numeri = terno
4 Numeri = quaterna
5 Numeri = cinquina
6 Numeri = sestina
7 Numeri = settina
Per la mia richiesta, vista la mole di dati che verranno movimentati, soprattutto dalle settine, penso che basti ed avanzi.
Parliamo delle radici quadrate, applicando ad ogni classe il suo quadrato.
Se avessi la coppia di ambi 31 e 47 il seguito sarebbe :
31^2+47^2=961+2209=3170
Infine : radice quadrata di 3170 = 56,3027 Questo risultato, implica dei decimali ed a me non interessa.
Questa coppia, percio' la escludo.
Cosa serve a me ?
Solo quelle linee che, per ogni classe, abbiano resto=zero.
L' esempio piu' facile da comprendere e' la coppia di ambi 3.4 ----> Teorema di Pitagora
3^2+4^2=9+16=25 Radice quadrata di 25 = 5 resto =zero Perfetta Ok la prendo.
Il programma dovrebbe percio' evidenziarmi in ordine : prima l' indice di posizione, poi gli elementi che compongono quella classe.
Nello specifico caso, l' indice di posizione della coppia 3.4 e' il 178.
Ho gia' fatto questo lavoro per la classe =2 trovando 56 condizioni soddisfacenti.
Ho gia' fatto questo lavoro per la classe =3 dove ho trovato 607 condizioni soddisfacenti.
Ho gia' fatto questo lavoro per la classe =4 trovando 9772 condizioni soddisfacenti.
Dalla 5° classe in poi fino alla 7°, chiedo il tuo aiuto.
Grazie se potrai.
Nelson
nelson1331
Utente Junior
 
Post: 93
Iscritto il: 18/02/08 08:58

Re: Classi e radici quadrate applicate ai 90 numeri del lott

Postdi Anthony47 » 01/01/22 21:09

Che fai, solleciti? :D :D

Questi esercizi mi fanno sorridere, pensando che saranno usati come il fondo per il caffè per la ricerca della combinazione vincente; ma anche mi incuriosiscono, perche' costringono a elaborare algoritmi in grado di digerire grandi quantita' di dati.
Quindi, indipendentemente dallo scopo, ho sviluppato questo codice:
Codice: Seleziona tutto
Dim wArr() As Long, myI As Long, Level As Long, LastN As Long
Dim OArr(1 To 10000, 1 To 9) As Integer, LB As Double, ColOut As Long

Sub MainBah()
Dim myTim As Single
'
LastN = 90
Level = Range("A1").Value
Range("A2").Resize(Rows.Count - 1, Level * 3 + 5).ClearContents
DoEvents: DoEvents
LB = 10 ^ (-15)
ColOut = 1
ReDim wArr(1 To Level)
myTim = Timer
Application.ScreenUpdating = False
myI = 0
    Call RecurBah(1)
If myI > 0 Then
    nextr = Cells(Rows.Count, ColOut).End(xlUp).Row + 1
    If nextr + myI > Rows.Count Then
        ColOut = ColOut + Level + 2
        nextr = 2
    End If
    Cells(nextr, ColOut).Resize(myI, Level).Value = OArr
End If
Application.ScreenUpdating = True
MsgBox ("Completato, sec. " & Format(Timer - myTim, "0.00"))
End Sub


Sub RecurBah(ByVal Colonna As Long)
'
If Colonna = Level Then
    Do
        wArr(Colonna) = wArr(Colonna) + 1
        Call CkArr(Level)
        If wArr(Colonna) - Colonna + Level >= LastN Then
            Exit Do
        End If
    Loop
    goBack = True
    Exit Sub
Else
    If Not wArr(Colonna) - Colonna + Level >= LastN Then
        Do
            wArr(Colonna) = wArr(Colonna) + 1
            wArr(Colonna + 1) = wArr(Colonna)
            If wArr(Colonna) - Colonna + Level >= LastN Then Exit Do
            Call RecurBah(Colonna + 1)
        Loop
    End If
End If
End Sub


Sub CkArr(J As Long)
Dim I As Long, WVal As Long, SRVal As Double
'
For I = 1 To J
    WVal = WVal + wArr(I) ^ 2
Next I
SRVal = WVal ^ 0.5
If (SRVal - Int(SRVal)) < LB Then
    myI = myI + 1 '
    For I = 1 To Level
        OArr(myI, I) = wArr(I)
    Next I
    If myI = UBound(OArr) Then
        nextr = Cells(Rows.Count, ColOut).End(xlUp).Row + 1
        If nextr + myI > Rows.Count Then
            ColOut = ColOut + Level + 2
            nextr = 2
        End If
        Cells(nextr, ColOut).Resize(myI, Level).Value = OArr
        Erase OArr
        myI = 0
        DoEvents
    End If
End If
End Sub


Va inserito in un modulo standard del vba vuoto, in modo che le Dim iniziali siano in testa al modulo.

Poi si seleziona un foglio vuoto, si scrive in A1 il raggruppamento che si vuole testare (mai superiore a 9) e poi si avvia la Sub MainBah
I risulati (i gruppi che rispondono alla regola del quadrato perfetto) saranno scritti dalla riga 2 in giu'; se le righe non sono sufficienti (cosa che succede gia' provando le sestine)si ricomincia da riga 2 in un nuovo gruppo di colonne.
Si tenga presente che ad ogni incremento di 1 nel raggruppamento i tempi aumentano di un fattore di circa 15; per cui le cinquine richiedono ancora "secondi", ma le sestine richiederanno "minuti" e le settine temo che richiederanno ore. Se hai tempo puoi provare fino alle "novine", che probabilmente richiederanno una settimana.

Fai sapere...
Avatar utente
Anthony47
Moderatore
 
Post: 19469
Iscritto il: 21/03/06 16:03
Località: Ivrea

Re: Classi e radici quadrate applicate ai 90 numeri del lott

Postdi nelson1331 » 02/01/22 08:59

Ciao Anthony47.
Grazie ancora una volta per il tuo impegno.
Per la classe 5 impiego pochi secondi.
Per la classe 6 impiego 11 minuti.
Non ho provato per le classi superiori, ovviamente.
Manca un piccolo ma, per me significativo tassello : l' indice di posizione, che se possibile, dovresti inserire all' inizio di ciascuna riga, cioe' prima delle formazioni di ogni classe. In sintesi e' questa la domanda : dove si colloca, quella formazione che tu hai individuato ?
Questo e' un mio aforisma : gli occhi delle persone, vedono in base agli occhiali che indossano.
Allargo un po' i miei commenti, se me lo permetti.
Quando partii molti anni fa, con lo studio dei numeri del lotto mi dissi : "Se e' opera di Dio, non ho alcuna possibilita' di trovare una soluzione vincente. La mente umana e' assai inferiore a quella Divina ! Se pero' e' opera dell' uomo, allora posso riuscirvi".
Dentro le combinazioni del lotto, vi sono delle regole matematiche che gl' inganni, le manipolazioni, o a volte peggio con le truffe, non possono sovvertirle, altrimenti tutto il creato andrebbe a rotoli. Spero che tu ed i lettori di Pcfacile siate riusciti a comprendere il mio pensiero ed esprimo nuovamente a te ed a tutti i collaboratori di Pcfacile ed ai numerosi lettori, un augurio di Buon Anno.
nelson1331
Utente Junior
 
Post: 93
Iscritto il: 18/02/08 08:58

Re: Classi e radici quadrate applicate ai 90 numeri del lott

Postdi Anthony47 » 02/01/22 12:33

Manca un piccolo ma, per me significativo tassello : l' indice di posizione, che se possibile, dovresti inserire all' inizio di ciascuna riga, cioe' prima delle formazioni di ogni classe. In sintesi e' questa la domanda : dove si colloca, quella formazione che tu hai individuato ?
Non ho proprio capito che cosa e' questo "indice di posizione", in prima battuta mi verrebbe da dire "Si posiziona dopo il precedente e prima del successivo"; ma credo tu voglia qualcosa di diverso, prova a spiegarlo con qualche esempio.

Ciao
Avatar utente
Anthony47
Moderatore
 
Post: 19469
Iscritto il: 21/03/06 16:03
Località: Ivrea

Re: Classi e radici quadrate applicate ai 90 numeri del lott

Postdi nelson1331 » 02/01/22 12:45

Ok.
Ti faccio l' esempio sulla classe piu' piccola, per rendere tutto piu' semplice.
Classe =2 Ambi
1.2 Posizione=1
1.3 Posizione=2
1.4 Posizione=3
1.5 Posizione=4
.....
89.90 posizione=4005
E cosi' via per tutte le altre classi.
nelson1331
Utente Junior
 
Post: 93
Iscritto il: 18/02/08 08:58

Re: Classi e radici quadrate applicate ai 90 numeri del lott

Postdi Anthony47 » 02/01/22 15:10

Inserito contatore qua, ridimensionato array là, piu' un paio di modifiche accessorie:
Codice: Seleziona tutto
Dim wArr() As Long, myI As Long, Level As Long, LastN As Long
Dim OArr(1 To 10000, 0 To 9) As Long, LB As Double, ColOut As Long, myColl As Long

Sub MainBah()
Dim myTim As Single
'
LastN = 90
Level = Range("A1").Value
Range("A2").Resize(Rows.Count - 1, Level * 3 + 5).ClearContents
DoEvents: DoEvents
LB = 10 ^ (-15)
ColOut = 1
ReDim wArr(1 To Level)
myTim = Timer
Application.ScreenUpdating = False
myI = 0
myColl = 0
    Call RecurBah(1)
If myI > 0 Then
    nextr = Cells(Rows.Count, ColOut).End(xlUp).Row + 1
    If nextr + myI > Rows.Count Then
        ColOut = ColOut + Level + 2
        nextr = 2
    End If
    Cells(nextr, ColOut).Resize(myI, Level + 1).Value = OArr
End If
   
Application.ScreenUpdating = True
MsgBox ("Completato, sec. " & Format(Timer - myTim, "0.00"))
End Sub

Sub RecurBah(ByVal Colonna As Long)
'
If Colonna = Level Then
    Do
        wArr(Colonna) = wArr(Colonna) + 1
        Call CkArr(Level)
        If wArr(Colonna) - Colonna + Level >= LastN Then
            Exit Do
        End If
    Loop
    goBack = True
    Exit Sub
   
Else
    If Not wArr(Colonna) - Colonna + Level >= LastN Then
   
        Do
            wArr(Colonna) = wArr(Colonna) + 1
            wArr(Colonna + 1) = wArr(Colonna)
            If wArr(Colonna) - Colonna + Level >= LastN Then Exit Do
           
            Call RecurBah(Colonna + 1)
        Loop
    End If
End If
End Sub

Sub CkArr(J As Long)
Dim I As Long, WVal As Long, SRVal As Double
'
If myColl = 2147483647 Then
    Debug.Print Now
    myColl = 0
End If
myColl = myColl + 1
If myColl = 2147483647 Then myColl = 0
For I = 1 To J
    WVal = WVal + wArr(I) ^ 2
Next I
SRVal = WVal ^ 0.5
If (SRVal - Int(SRVal)) < LB Then
    myI = myI + 1 '
    OArr(myI, 0) = myColl
    For I = 1 To Level
        OArr(myI, I) = wArr(I)
    Next I
    If myI = UBound(OArr) Then
        nextr = Cells(Rows.Count, ColOut).End(xlUp).Row + 1
        If nextr + myI > Rows.Count Then
            ColOut = ColOut + Level + 2
            nextr = 2
        End If
        Cells(nextr, ColOut).Resize(myI, Level + 1).Value = OArr
        Erase OArr
        myI = 0
        DoEvents
    End If
End If
End Sub

Il contatore andra' in overflow sulle settine e dovrebbe ripartire da Zero

Ciao
Avatar utente
Anthony47
Moderatore
 
Post: 19469
Iscritto il: 21/03/06 16:03
Località: Ivrea

Re: Classi e radici quadrate applicate ai 90 numeri del lott

Postdi nelson1331 » 08/01/22 11:46

Ciao Anthony47,
fino ad ora sono solo riuscito ad ottenere i risultati fino alle classi delle sestine.
Gia' cosi', col numero delle formazioni che ne derivano, con excel e' assai complicato gestirle.
Rinnovo un grazie per il tuo impegno e se riusciro' ad ottenere risultati anche sulle formazioni superiori, stanne certo che te lo comunichero'.
Buona giornata ed a presto.
Nelson
nelson1331
Utente Junior
 
Post: 93
Iscritto il: 18/02/08 08:58

Re: Classi e radici quadrate applicate ai 90 numeri del lott

Postdi Anthony47 » 09/01/22 15:02

Non so il motivo per cui non hai ottenuto risultati con le "settine", io ho ottenuto un file mostro, poco pratico da gestire, dopo qualche ora di elaborazione notturna.
Per evitare la creazioni di risultati "mostruosi" ho modificato il codice in modo da creare tanti file di circa 70 Mbyte, numerati come _001, _002, etc
Le modifiche prevedono l'aggiunta di una nuova Sub SaveNow, piu' modifiche alla Sub MainBah e alla Sub CkArr. Il nuovo codice complessivo:
Codice: Seleziona tutto
Dim wArr() As Long, myI As Long, Level As Long, LastN As Long, SaveNum As Long, iFName As String
Dim OArr(1 To 10000, 0 To 9) As Long, LB As Double, ColOut As Long, myColl As Long

Sub MainBah()
Dim myTim As Single
'
LastN = 90
Level = Range("A1").Value
Range("A2").Resize(Rows.Count - 1, Level * 3 + 5).ClearContents
DoEvents: DoEvents
LB = 10 ^ (-15)
ColOut = 1
ReDim wArr(1 To Level)
myTim = Timer
Debug.Print ">>> Starting, " & Level, Now
iFName = ThisWorkbook.FullName
ThisWorkbook.Sheets(1).Cells(1, 3) = "'" & Format(SaveNum, "0000")
DoEvents
Application.ScreenUpdating = False
myI = 0
myColl = 0
    Call RecurBah(1)
If myI > 0 Then
    nextr = Cells(Rows.Count, ColOut).End(xlUp).Row + 1
    If nextr + myI > Rows.Count Then
        ColOut = ColOut + Level + 2
        nextr = 2
    End If
    Cells(nextr, ColOut).Resize(myI, Level + 1).Value = OArr
End If
   
Application.ScreenUpdating = True
Debug.Print "<<< Completed:", Now
MsgBox ("Completato, sec. " & Format(Timer - myTim, "0.00"))
End Sub

Sub RecurBah(ByVal Colonna As Long)
'
If Colonna = Level Then
    Do
        wArr(Colonna) = wArr(Colonna) + 1
        Call CkArr(Level)
        If wArr(Colonna) - Colonna + Level >= LastN Then
            Exit Do
        End If
    Loop
    goBack = True
    Exit Sub
   
Else
    If Not wArr(Colonna) - Colonna + Level >= LastN Then
   
        Do
            wArr(Colonna) = wArr(Colonna) + 1
            wArr(Colonna + 1) = wArr(Colonna)
            If wArr(Colonna) - Colonna + Level >= LastN Then Exit Do
           
            Call RecurBah(Colonna + 1)
        Loop
    End If
End If
End Sub

Sub CkArr(J As Long)
Dim I As Long, WVal As Long, SRVal As Double
'
If myColl = 2147483647 Then
    Debug.Print Now
    myColl = 0
End If
myColl = myColl + 1
''    If myColl = 2147483647 Then myColl = 0
For I = 1 To J
    WVal = WVal + wArr(I) ^ 2
Next I
SRVal = WVal ^ 0.5
If (SRVal - Int(SRVal)) < LB Then
    myI = myI + 1 '
    OArr(myI, 0) = myColl
    For I = 1 To Level
        OArr(myI, I) = wArr(I)
    Next I
    If myI = UBound(OArr) Then
        nextr = Cells(Rows.Count, ColOut).End(xlUp).Row + 1
        If nextr + myI > Rows.Count Then
            ColOut = ColOut + Level + 2
            nextr = 2
            'Se superiore a.. salva copia:
            If ColOut > 10 Then
                Application.ScreenUpdating = True
                DoEvents
                Application.ScreenUpdating = False
                Call SaveNow(1)
            End If
        End If
        Cells(nextr, ColOut).Resize(myI, Level + 1).Value = OArr
        Erase OArr
        myI = 0
        DoEvents
    End If
End If
End Sub



Sub SaveNow(Dummy As Long)
'
Debug.Print Now, SaveNum, myColl
'Mostra avanzamento:
    Application.ScreenUpdating = True
    DoEvents
'Salva copia:
    ThisWorkbook.SaveCopyAs Replace(iFName, ".xlsm", "_" & Format(SaveNum, "0000") & ".xlsm", , , vbTextCompare)
'reset valori:
    SaveNum = SaveNum + 1
    ThisWorkbook.Sheets(1).Cells(1, 3) = "'" & Format(SaveNum, "0000")
    ColOut = 1
    ThisWorkbook.Sheets(1).Range("A2").Resize(Rows.Count - 2, 100).ClearContents
    DoEvents
    Application.ScreenUpdating = False
End Sub


Con questo nuovo codice se il numero di colonne di dati prodotti e' superiore a 12 (cosa che succede gia' con le sestine) la macro crea file intermedi chiamati NomeIniziale_001, NomeIniziale_002 etc, ognuno di circa 70MB, prima di riprendere da colonna 1. L' ULTIMO BLOCCO, quello visibile al termine della macro, non e' ancora salvato, devi provvedere manualmente se la cosa serve.

Ciao
Avatar utente
Anthony47
Moderatore
 
Post: 19469
Iscritto il: 21/03/06 16:03
Località: Ivrea


Torna a Applicazioni Office Windows


Topic correlati a "Classi e radici quadrate applicate ai 90 numeri del lotto.":


Chi c’è in linea

Visitano il forum: Nessuno e 37 ospiti