Valutazione 4.87/ 5 (100.00%) 5838 voti

Condividi:        

Calcoli con la tabella dei 64 Esagrammi o I Ching.

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

Calcoli con la tabella dei 64 Esagrammi o I Ching.

Postdi nelson1331 » 28/03/21 08:55

Un doveroso saluto ai responsabili di questa community, alcuni dei quali gia' conosco in modo virtuale.

Sono ricerche dedicate al lotto italiano.
Il pc fisso ha Windows10 a 64 bit.
Uso excel 2010.

https://1drv.ms/x/s!BJTdq9BQgwZZnSZhuumPrHOv6c_j?e=BSoUKK

Questa e' la tabella in esame :

1.34.5.26.11.9.14.43 8° Linea

25.51.3.27.24.42.21.17 7° Linea

6.40.29.4.7.59.64.47 6° Linea

33.62.39.52.15.53.56.31 5° Linea

12.16.8.23.2.20.35.45 4° Linea

44.32.48.18.46.57.50.28 3° Linea

13.55.63.22.36.37.30.49 2° Linea

10.54.60.41.19.61.38.58 1° Linea

54.74.75.33.70.68.38.48 1° Totale

Il lavoro da eseguire non e' altro che una ripetizione di calcoli, per ottenere i totali con la regola del fuori 90 (ogni valore, non puo' superare il 90), tante volte quante sono le combinazioni, cioe' : 8*8*8*8*8*8*8*8=16.777.216 ottine.

Lavora sul modello del cubo di Rubik (tanto per darvene un' idea).

Andro' percio' a scrivere e memorizzare il 1° totale ottenuto (quello riportato sopra).

Le operazioni intermedie a me non serviranno ma, avro' solo bisogno dei 16.777.216 totali in ottine.

1.34.5.26.11.9.14.43

25.51.3.27.24.42.21.17

6.40.29.4.7.59.64.47

33.62.39.52.15.53.56.31

12.16.8.23.2.20.35.45

44.32.48.18.46.57.50.28

13.55.63.22.36.37.30.49

54.60.41.19.61.38.58.10

8.80.56.11.22.45.58.90 2° Totale

Le operazioni e gli spostamenti, li eseguo, partendo dal basso verso l' alto.

Adesso sposto la stringa della 1° linea, in blocco, movimentando 1 sola casella per volta, da destra a sinistra.

Avra' cosi' la forma suesposta.

Andro' a scrivere ordinatamente questo totale appena ottenuto, sotto al 1° totale ottenuto in precedenza.

Adesso eseguo il 3° spostamento.

1.34.5.26.11.9.14.43

25.51.3.27.24.42.21.17

6.40.29.4.7.59.64.47

33.62.39.52.15.53.56.31

12.16.8.23.2.20.35.45

44.32.48.18.46.57.50.28

13.55.63.22.36.37.30.49

60.41.19.61.38.58.10.54

14.61.34.53.89.65.10.44 3° Totale

Andro' a scrivere ordinatamente questo totale appena ottenuto, sotto al 1° e 2° totale, ottenuti in precedenza.

E cosi' via, per 8 volte, fino a quando non avro' completato tutti gli spostamenti della 1° linea ed ottenuto 8 totali.

In questo modo, la 1° linea, sara' tornata al punto di partenza e muovero' questa volta la stringa della 2° linea, che assumera' questa forma :

1.34.5.26.11.9.14.43 8° Linea

25.51.3.27.24.42.21.17 7° Linea

6.40.29.4.7.59.64.47 6° Linea

33.62.39.52.15.53.56.31 5° Linea

12.16.8.23.2.20.35.45 4° Linea

44.32.48.18.46.57.50.28 3° Linea

55.63.22.36.37.30.49.13 2° Linea

10.54.60.41.19.61.38.58 1° Linea

6.82.34.47.71.61.57.12 9° Totale

Adesso, tenendo fissa questa configurazione appena generata, tornero' a spostare la stringa della 1° linea.

Faro' cosi' nuovamente per 8 volte generando altri 8 totali, che sommati ai precedenti diventano 16 e quando avro' fatto questa iterazione, muovero' per la 2° volta la 2° linea e la configurazione, diventera' come segue :

1.34.5.26.11.9.14.43 8° Linea

25.51.3.27.24.42.21.17 7° Linea

6.40.29.4.7.59.64.47 6° Linea

33.62.39.52.15.53.56.31 5° Linea

12.16.8.23.2.20.35.45 4° Linea

44.32.48.18.46.57.50.28 3° Linea

63.22.36.37.30.49.13.55 2° Linea

10.54.60.41.19.61.38.58 1° Linea

14.41.48.48.64.80.21.54 17° Totale

Avvertenze : e' consigliabile, per fare una verifica accurata del procedimento, caricare inizialmente 1 tabella contenente i numeri da 1 a 64.

In tal modo, si potra' verificare se la presenza di ciascuno dei numeri corrispondera' a 16.777.216 volte, altrimenti vi sara' certamente 1 errore.

Inoltre i fogli excel al max. possono contenere poco piu' di 1 milione di linee.

Dovrete percio' indicarmi un modo per l' eventuale acquisizione di tutte queste linee.

Rinnovo la raccomandazione di scrivere i totali che si ricaveranno, in modo ordinato e sequenziale.

Se questo lavoro sara' possibile, sappiate che dovro' ottenere le analoghe operazioni ma, questa volta con la tabella (sempre 8x8) in una forma modificata.

L' ideale per me sarebbe, avere un programma, nel quale possa inserire i miei 64 numeri (in una matrice sempre e solo 8x8) ed alla fine, raccogliere tutti i totali.

Se fosse possibile, gradirei l' area di input box, nella quale digitare i 64 numeri, nel settore Excel A1-H8.

Le righe dei totali, vorrei che fossero scritte nelle colonne M-T (1° milione di linee) poi colonna bianca U ed ancora colonne V-AC (2° milione di linee) poi colonna bianca AD e cosi' via e via fino al completamento di tutti i totali.

Grazie fin da ora a chi potra' dare impulso e concretezza a questa richiesta.

Nelson
nelson1331
Utente Junior
 
Post: 58
Iscritto il: 18/02/08 08:58

Sponsor
 

Re: Calcoli con la tabella dei 64 Esagrammi o I Ching.

Postdi Anthony47 » 28/03/21 22:31

Non so a che cosa possa servire 'sto gioco, ma per gioco ho preparato questo codice:
Codice: Seleziona tutto
Dim oArr(0 To 1048575, 0 To 7) As Integer
Dim wArr(0 To 7, 0 To 7), iArr(0 To 7, 0 To 7) As Long
Dim oInd As Long, cHor As Long, ccI As Long, ccJ As Long
Dim Largh As Long, Alt As Long

Sub Mix8x8()
Dim lArr(0 To 7), myTim As Single
'
Alt = 8 - 1
Largh = 8 - 1
'
For I = 0 To 16
    Range("M1").Offset(0, I * 9).Resize(1048576, 10).ClearContents
Next I
myTim = Timer
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
oInd = 0: cHor = 0: ccI = 0
'Prepara WArr e iArr:
For I = 0 To Alt
    For j = 0 To Largh
        wArr(I, j) = Cells(I + 1, j + 1)
        iArr(I, j) = j
    Next j
Next I
'Core:
Do
'Stop
If ccI > Alt Then Exit Do
Erase lArr
        For li = 0 To Alt
            For lJ = 0 To Largh
                lArr(li) = lArr(li) + wArr(lJ, iArr(lJ, li))
            Next lJ
        Next li
        For li = 0 To Largh
            oArr(oInd, li) = lArr(li) Mod 90
        Next li
        oInd = oInd + 1
        If oInd > 1048575 Then
            Debug.Print cHor + 1, Format(Timer - myTim, "0.00")
            DoEvents: Beep
            Range("M1").Offset(0, cHor * 9).Resize(1048576, 8) = oArr
            cHor = cHor + 1
            Erase oArr
            oInd = 0
        End If
Call RecurShift(0)
'DoEvents
Loop
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
Debug.Print oInd, Format(Timer - myTim, "0.00")
If oInd > 0 Then
    Range("M1").Offset(0, cHor * 9).Resize(oInd, 8) = oArr
End If
End Sub



Sub RecurShift(ByVal cI As Integer)
Dim lJ As Long, rI As Long
'
rI = Alt - cI
basej = iArr(rI, 0)
For lJ = 0 To Largh - 1
    iArr(rI, lJ) = iArr(rI, lJ + 1)
Next lJ
iArr(rI, lJ) = basej
If basej = Largh Then
    ccI = cI + 1
    If cI < Alt Then
        Call RecurShift(cI + 1)
    End If
End If
End Sub

Va messo in un modulo standard vuoto del tuo progetto vba.

I dati vanno inseriti in A1:H8, poi all'occorrenza si lancia la Sub Mix8x8
Richiedera' alcuni minuti; tieni presente che ogni 1milione di righe preparate esegue un Beep, cosi' puoi sapere quanto tempo hai per prendere il caffè.

Io ho fatto un collaudo all'acqua di rose, il resto tocca a te

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

Re: Calcoli con la tabella dei 64 Esagrammi o I Ching.

Postdi nelson1331 » 29/03/21 12:02

Grazie Anthony47.
Dovro' fare verifiche un po' piu' accurate ma, il concetto di calcolo e' proprio quello che hai recepito.
Una piccola correzione da fare (se puoi) : quando nei totali, compare lo zero, sostituirlo con il 90.
Sei in gamba e ben preparato.
Grazie ancora per la tua disponibilita' ed un augurio di buona giornata e te ed a tutta la community.
Nelson
nelson1331
Utente Junior
 
Post: 58
Iscritto il: 18/02/08 08:58

Re: Calcoli con la tabella dei 64 Esagrammi o I Ching.

Postdi Anthony47 » 29/03/21 17:03

Basterebbe aggiungere questa istruzione in questa posizione:
Codice: Seleziona tutto
        For li = 0 To Largh
            oArr(oInd, li) = lArr(li) Mod 90
            If oArr(oInd, li) = 0 Then oArr(oInd, li) = 90             '<<< QUESTA
        Next li

Ma questo provocherebbe un aumento dei tempi di esecuzione di circa il 5%
Preferisco quindi complicare leggermente per avere gli stessi tempi precedenti. Il nuovo codice complessivo:
Codice: Seleziona tutto
Dim oArr(0 To 1048575, 0 To 7) As Integer
Dim wArr(0 To 7, 0 To 7), iArr(0 To 7, 0 To 7) As Long
Dim oInd As Long, cHor As Long, ccI As Long, ccJ As Long
Dim Largh As Long, Alt As Long
Dim Modular(1 To 720, 1 To 2) 'As Long

Sub Mix8x8()
Dim lArr(0 To 7), myTim As Single
'
Alt = 7 - 1
Largh = 7 - 1
'
oInd = 0
For I = 1 To 7
    For j = 1 To 90
        oInd = oInd + 1
        Modular(oInd, 1) = oInd
        Modular(oInd, 2) = j
    Next j
Next I


For I = 0 To 16
    Range("M1").Offset(0, I * 9).Resize(1048576, 10).ClearContents
Next I
myTim = Timer
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
oInd = 0: cHor = 0: ccI = 0
'Prepara WArr e iArr:
For I = 0 To Alt
    For j = 0 To Largh
        wArr(I, j) = Cells(I + 1, j + 1)
        iArr(I, j) = j
    Next j
Next I
'Core:
Do
'Stop
If ccI > Alt Then Exit Do
Erase lArr
        For li = 0 To Alt
            For lJ = 0 To Largh
                lArr(li) = lArr(li) + wArr(lJ, iArr(lJ, li))
            Next lJ
        Next li
        For li = 0 To Largh
            oArr(oInd, li) = Modular(lArr(li), 2)
        Next li
        oInd = oInd + 1
        If oInd > 1048575 Then
            Debug.Print cHor + 1, Format(Timer - myTim, "0.00")
            DoEvents: Beep
            Range("M1").Offset(0, cHor * 9).Resize(1048576, 8) = oArr
            cHor = cHor + 1
            Erase oArr
            oInd = 0
        End If
Call RecurShift(0)
'DoEvents
Loop
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
Debug.Print oInd, Format(Timer - myTim, "0.00")
If oInd > 0 Then
    Range("M1").Offset(0, cHor * 9).Resize(oInd, 8) = oArr
End If
End Sub



Sub RecurShift(ByVal cI As Integer)
Dim lJ As Long, rI As Long
'
rI = Alt - cI
basej = iArr(rI, 0)
For lJ = 0 To Largh - 1
    iArr(rI, lJ) = iArr(rI, lJ + 1)
Next lJ
iArr(rI, lJ) = basej
If basej = Largh Then
    ccI = cI + 1
    If cI < Alt Then
        Call RecurShift(cI + 1)
    End If
End If
End Sub


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


Torna a Applicazioni Office Windows


Topic correlati a "Calcoli con la tabella dei 64 Esagrammi o I Ching.":


Chi c’è in linea

Visitano il forum: Nessuno e 14 ospiti