Algoritmo per il calcolo dei numeri di Eulero a zig-zag

[recalcatiiti]

Ciao a tutti,

https://www.dropbox.com/s/r5ulqpc46n1n5z9/Numeri_di%20Eulero_a_zig_zag.xls?dl=0

all'interno del file, c'è una spiegazione di quello che dovrebbe fare la macro. (spero sia chiara)

per chi volesse c'è questo sopraffino articolo di Mauro Fiorentini circa questi curiosi numeri http://www.bitman.name/math/article/44 (è richiesta qualche base di matematica).

L'idea è quella di creare una macro che esegua un algoritmo semi-grafico di P. L. Seidel del 1877 che genera i numeri di Eulero a zig-zag (la spiegazione di M. Fiorentini dell'algoritmo è nel suo articolo (più sintetica), la mia nel file(MENO sintetica ma più comprensibile (spero))).

la migliore macro è quella che prevede come variabile solo il numero di piani n.

Piccola appendice per spiegare in poche parole di cosa sto parlando (se interessasse).

presi i primi n interi (es .1, 2, 3, 4), quante sono le disposizione possibili in cui le cifre di posizione pari sono maggiori dei due numeri adiacenti? esattamente 5. L'immagine successiva dovrebbe rendere il tutto più chiaro.



l'algoritmo genera la sequenza:

1
1
1
2
5 (la risposta dell'esempio)
16
61
272
1385
7936
50521
353792
2702765
22368256
199360981
1903757312
19391512145
209865342976
2404879675441
29088885112832
370371188237525
...

la quale è l'insieme di tutte le soluzioni da 1 a n, che ha loro volta sono i numeri di Eulero a zig-zag

Conscio del fatto che la richiesta sia spinosa, c'è qualcuno che si vuole imbarcare con me?

Grazie A TUTTI.

[recalcatiiti]

Rettifico, la sequenza generata è da 0 a n.

[Anthony47]

L'argomento mi incuriosisce, soprattutto lo zigo-zago; ma e' anche tosto...
Senza garantire che arrivero' a qualche conclusione la guardero', ma con comodo.

Ciao

[recalcatiiti]

Ciao Anthony! Grazie per il riscontro. Se vuoi darmi una mano, prenditi tutto il tempo che vuoi. Volevo solo sapere se il procedimento utilizzato nell'algoritmo (spiegato nel file allegato) ti é chiaro, altrimenti riformulo in altro modo. Mi piacerebbe avere il riscontro di qualcun altro (almeno sulla chiarezza della spiegazione), ma forse chiedo troppo...

Volevo chiederti in quale modo affronteresti la questione, magari riesco a sviluppare qualcosa. Giusto in linea di massima, del tipo:"io farei prima questo, poi una cosa del genere ed in fine così".
Grazie e a presto
Ciao!

[Anthony47]

Mah, la spiegazione teorica in alcuni punti mi lascia un po' dubbioso, sono rinvenuto solo al graziozo algoritmo scoperto da Philipp Ludwig von Seidel.
Per rispondere alle domande poste vorrei sapere se ti interessa lo sviluppo con "albero" su foglio Excel, solo lo sviluppo, o solo il risultato.
Se ti interessa lo sviluppo, allora sia chiaro che Excel ha un limite di 15 cifre significative, quindi oltre E*(20) non si potra' andare.

Ciao

[cromagno]

Ciao a tutti,
anche a me ha incuriosito questo "metodo" anche se non sono sicuro di aver capito cosa dovrebbe fare la macro.

Nel file che allego, si deve mettere il valore di n nella cella B1 e cliccare sul pulsante "Calcola...".
Il codice:
- creerà il "triangolo" a partire dalla riga 3
- darà il numero di permutazioni per quel valore di n nella cella B2
- restituirà la stringa con tutte le permutazioni 2 righe sotto il triangolo

Codice: Seleziona tutto

Option Explicit

Sub Eulero()
Dim n As Long, Sequenza As String, Permutazioni As Long
Dim i As Long, j As Long, col As Double, InizioCol As Long, Ultimo As Long

If Range("B1").Value > 15 Then
    MsgBox "Il limite massimo per excel è di 15 cifre significative!", vbCritical, _
    "Come detto da Anthony..."
    Range("B1").Value = 15
    n = 15
    GoTo quindici
ElseIf Range("B1").Value = "" Or Range("B1").Value = 0 Then
    MsgBox "Dati errati!"
    Exit Sub
End If
   
n = Range("B1").Value
quindici:
InizioCol = n - Int(n / 2)
Range(Cells(3, 1), Cells(Rows.Count, Columns.Count)).Clear

Permutazioni = 0
Cells(3, InizioCol) = 1
Sequenza = "1, 1,"
Ultimo = InizioCol
For i = 4 To n + 2
    If i Mod 2 = 0 Then
        For j = Ultimo To InizioCol + Int(col) + 1
            Select Case j
                Case Is = Ultimo
                    Cells(i, j) = Cells(i - 1, j)
                Case Is = InizioCol + Int(col) + 1
                    Cells(i, j) = Cells(i, j - 1)
                    Permutazioni = Cells(i, j)
                Case Else
                    Cells(i, j) = Cells(i - 1, j) + Cells(i, j - 1)
            End Select
            Ultimo = j
        Next j
    Else
        For j = Ultimo To InizioCol - Int(col) - 1 Step -1
            Select Case j
                Case Is = Ultimo
                    Cells(i, j) = Cells(i - 1, j)
                Case Is = InizioCol - Int(col) - 1
                    Cells(i, j) = Cells(i, j + 1)
                    Permutazioni = Cells(i, j)
                Case Else
                    Cells(i, j) = Cells(i - 1, j) + Cells(i, j + 1)
            End Select
            Ultimo = j
        Next j
    End If
    col = col + 1 / 2
    Sequenza = Sequenza & " " & Permutazioni & ","
Next i

Range("B2").Value = Permutazioni
Sequenza = Mid(Sequenza, 1, Len(Sequenza) - 1)
Range("A" & i + 1).Value = Sequenza
Range(Cells(3, 1), Cells(Rows.Count, Columns.Count)).Font.Bold = True
Range(Cells(3, 1), Cells(Rows.Count, Columns.Count)).HorizontalAlignment = xlCenter
Range("A" & i + 1).Font.ColorIndex = 3
Range(Cells(i + 1, 1), Cells(i + 1, n)).Merge

End Sub


N.B.
come detto da Anthony (un saluto), con questo metodo il valore massimo per n sarà di 15.
Mentre se si vuole solo la stringa finale... credo che qualcosa si possa fare (anche se non ho ancora provato).

Fammi sapere se (come credo) non ho capito un tubo...

link per scaricare il file:
http://www.filedropper.com/numeridieuleroazigzag

se dovessi avere problemi per scaricare, prova da qui:
http://www.fileconvoy.com/dfl.php?id=g37013a99bf7f6c1d9999027642bcbd1c73dd66bf7

[recalcatiiti]

Ciao cromagno, grazie per il riscontro! Oggi non potrò testare la macro, lo farò presto.

Sì, immaginavo non potessi andare oltre la 15esima cifra... In ogni caso, allo stato attuale avere il "triangolo o albero" completo fino ad n=20 é abbastanza. Quest'ultima frase anche per rispondere a Anthony.
Per chi interessasse anche tutti i numeri "all'interno" del triangolo sono interessanti (pur non c'entrano con i ZZ), per questo vorrei il triangolo completo.

Ciao cromagno e Anthony, a presto

[cromagno]

Ciao,

dopo il giusto consiglio di Anthony (thanks ) ho modificato la dichiarazione della variabile "Permutazioni" da long a double.
In questo modo, otterrai il triangolo anche per n > 15 , ma tieni presente che dopo le 15 cifre significative i numeri restituiti non sono esatti .
Il codice corretto:

Codice: Seleziona tutto

Option Explicit

Sub Eulero()
Dim n As Long, Sequenza As String, Permutazioni As Double, x
Dim i As Long, j As Long, col As Double, InizioCol As Long, Ultimo As Double

If IsNumeric(Range("B1").Value) = False Then GoTo errore
If Range("B1").Value > 20 Then
    MsgBox "Il limite massimo per excel è di 15 cifre significative!" & vbNewLine & _
    "I numeri che contengono più di 15 cifre potrebbero non essere esatti.", vbCritical, _
    "Come detto da Anthony..."
ElseIf Range("B1").Value = "" Or Range("B1").Value = 0 Or IsNumeric(Range("B1").Value) = False Then
errore:
    MsgBox "Dati errati!"
    Exit Sub
End If
   
n = Range("B1").Value
quindici:
InizioCol = n - Int(n / 2)
Range(Cells(3, 1), Cells(Rows.Count, Columns.Count)).Clear

Permutazioni = 0
Cells(3, InizioCol) = 1
Sequenza = "1, 1,"
Ultimo = InizioCol
For i = 4 To n + 2
    If i Mod 2 = 0 Then
        For j = Ultimo To InizioCol + Int(col) + 1
            Select Case j
                Case Is = Ultimo
                    Cells(i, j) = Cells(i - 1, j)
                Case Is = InizioCol + Int(col) + 1
                    Cells(i, j) = Cells(i, j - 1)
                    Permutazioni = Cells(i, j)
                Case Else
                    Cells(i, j) = Cells(i - 1, j) + Cells(i, j - 1)
            End Select
            Ultimo = j
        Next j
    Else
        For j = Ultimo To InizioCol - Int(col) - 1 Step -1
            Select Case j
                Case Is = Ultimo
                    Cells(i, j) = Cells(i - 1, j)
                Case Is = InizioCol - Int(col) - 1
                    Cells(i, j) = Cells(i, j + 1)
                    Permutazioni = Cells(i, j)
                Case Else
                    Cells(i, j) = Cells(i - 1, j) + Cells(i, j + 1)
            End Select
            Ultimo = j
        Next j
    End If
    col = col + 1 / 2
    Sequenza = Sequenza & " " & Permutazioni & ","
Next i

Range("B2").Value = Permutazioni
Sequenza = Mid(Sequenza, 1, Len(Sequenza) - 1)
Range("A" & i + 1).Value = Sequenza
Range(Cells(3, 1), Cells(Rows.Count, Columns.Count)).Font.Bold = True
Range(Cells(3, 1), Cells(Rows.Count, Columns.Count)).HorizontalAlignment = xlCenter
Range("A" & i + 1).Font.ColorIndex = 3
Range(Cells(i + 1, 1), Cells(i + 1, n)).Merge
Cells.Columns.AutoFit
End Sub


P.S.
Ho eliminato il pulsante ed aggiunto questo codice nel modulo di classe del foglio "Prove":

Codice: Seleziona tutto

Private Sub Worksheet_Change(ByVal Target As Range)

If Not Intersect(Target, Range("B1")) Is Nothing Then
    Range("B2").ClearContents
    Call Eulero
End If
End Sub

in questo modo il codice parte alla modifica della cella B1.

Ti riallego il file:
http://www.filedropper.com/numeridieuleroazigzag_1

[recalcatiiti]

Grazie ancora cromagno.

Non leggo nessun messaggio contenente il consiglio, dove ha spiegato questa cosa?

[cromagno]

Si, scusa... ho dimenticato di scriverlo..
me l'ha fatto notare tramite messaggio privato.

[Anthony47]

A scopo puramente ludico ho elaborato queste due varianti di calcolo
La prima e' "classica", cioe' usa le funzioni di calcolo di Excel pertanto non puo' elaborare serie di indice superiore a 20 (perche' con 21 il risultato dovrebbe essere 4951498053124096, superiore alla capacita' di calcolo Excel)

Codice: Seleziona tutto

Sub Eulero2()
Dim CurCol As Long, DxSx As Long, CurLn As Long, EBase As Long
Dim ZigoZago As String, perMutaz As Double

DxSx = 1
CurLn = 3
'Cells(CurLn, Columns.Count).End(xlToLeft).Select
'Selection.CurrentRegion.ClearContents
Range("A2").Resize(50, 50).ClearContents

EBase = Range("B1").Value
If EBase > 20 Then
    MsgBox ("Excel non puo' calcolare questa serie; procedura abortita")
    Exit Sub
End If

Range("B1").Value = EBase
ZigoZago = "1, "
CurCol = 1 + Int(EBase / 2)
Cells(CurLn, CurCol) = 1
For I = EBase - 1 To 1 Step -1
    CurLn = CurLn + 1
    For j = 0 To EBase
    DoEvents
        If j = 0 Then
            Cells(CurLn, CurCol) = Cells(CurLn - 1, CurCol)
        Else
            Cells(CurLn, CurCol + DxSx) = Cells(CurLn, CurCol) + Cells(CurLn - 1, CurCol + DxSx)
            CurCol = CurCol + DxSx
            If Cells(CurLn - 1, CurCol) = 0 Then
                ZigoZago = ZigoZago & Cells(CurLn, CurCol) & ", "
                perMutaz = Cells(CurLn, CurCol)
                Exit For
            End If
        End If
    Next j
    DxSx = DxSx * (-1)
Next I
'
Cells(2, "B") = perMutaz
Columns("A").Resize(, EBase).EntireColumn.AutoFit
Range(Cells(3, 1), Cells(CurLn, EBase + 1)).HorizontalAlignment = xlCenter
Cells(CurLn + 2, 1) = Left(ZigoZago, Len(ZigoZago) - 2)
Cells(CurLn + 2, 1).HorizontalAlignment = xlLeft
End Sub


Ovviamente ho "rubato" qualche pezzo alla macro di cromagno, eh eh..

La seconda e' "enhanced" in quanto non usa la somma Excel, ma la fa tramite una Function che accetta "stringhe" di qualsiasi lunghezza; in questo caso non c'e' un limite superiore di calcolo e quindi si puo' calcolare la sequenza e il risultato anche con indici molto alti (ma senza esagerare). Il codice complessivo:

Codice: Seleziona tutto

Sub Eulero3()
Dim CurCol As Long, DxSx As Long, CurLn As Long, EBase As Long
Dim ZigoZago As String, perMutaz As String

DxSx = 1
CurLn = 3
Range("A2").Resize(60, 60).ClearContents
Range("A2").Resize(60, 60).NumberFormat = "@"

EBase = Range("B1").Value
Range("B1").Value = EBase
ZigoZago = "1, "
CurCol = 1 + Int(EBase / 2)
Cells(CurLn, CurCol) = 1
For I = EBase - 1 To 1 Step -1
    CurLn = CurLn + 1
    For j = 0 To EBase
    DoEvents
        If j = 0 Then
            Cells(CurLn, CurCol) = Cells(CurLn - 1, CurCol)
        Else
'Debug.Print SommaStr(Cells(CurLn, CurCol), Cells(CurLn - 1, CurCol + DxSx))
            Cells(CurLn, CurCol + DxSx) = SommaStr(Cells(CurLn, CurCol), Cells(CurLn - 1, CurCol + DxSx)) & ""
            CurCol = CurCol + DxSx
            If Cells(CurLn - 1, CurCol) = 0 Then
                ZigoZago = ZigoZago & Cells(CurLn, CurCol) & ", "
                perMutaz = Cells(CurLn, CurCol)
                Exit For
            End If
        End If
    Next j
    DxSx = DxSx * (-1)
Next I

Cells(2, "B") = perMutaz
Columns("A").Resize(, EBase).EntireColumn.AutoFit
Range(Cells(3, 1), Cells(CurLn, EBase + 1)).HorizontalAlignment = xlCenter
Cells(CurLn + 2, 1) = Left(ZigoZago, Len(ZigoZago) - 2)
Cells(CurLn + 2, 1).HorizontalAlignment = xlLeft
End Sub


Function SommaStr(ByVal Add1 As String, ByVal Add2 As String) As String
Dim lA1 As Long, lA2 As Long, cIc As Long, I As Long, Ript As Long
Dim cRis As String
'
If Len(Add1) > Len(Add2) Then
    Add2 = String(Len(Add1) - Len(Add2), "0") & Add2
Else
    Add1 = String(Len(Add2) - Len(Add1), "0") & Add1
End If
cIc = Len(Add1)
'If cIc > 30 Then Stop
Ript = 0
For I = cIc To 1 Step -1
    interm = Val(Mid(Add1, I, 1)) + Val(Mid(Add2, I, 1)) + Ript
    cRis = Right(Format(interm, "0"), 1) & cRis
    If interm > 9 Then
        Ript = 1
    Else
        Ript = 0
    End If
Next I
If Ript > 0 Then cRis = "1" & cRis
SommaStr = cRis
End Function


Buon divertimento!

[cromagno]

Ciao Anthony,
me la studio bene (specialmente la seconda)

però, forse c'è qualcosa di anomalo (per entrambi i codici) a partire da n=12 (sicuramente una cosa da nulla):

[recalcatiiti]

Ciao cromagno,

a me funziona molto bene,

ottenuto con Eulero3 e n=22

a parte un problema nella visualizzazione dell'intera sequenza (l'ultimo numero risulta troncato) per un numero di interi superiore a 50 (probabilmente lo stesso problema si presenta con meno di 50 interi, ma non ho testato). Parlo di visualizzazione perché quando selezioni la cella e leggi il contenuto nella barra superiore la sequenza è corretta (a parte un piccolo appunto che riporto di seguito).

C'è soltanto un piccolo difetto di forma, poiché nella sequenza andrebbe aggiunto un 1 iniziale.

1, 1, 1, 2, 5, 16, 61, 272, 1385, 7936, 50521, 353792, 2702765, 22368256, 199360981, 1903757312, 19391512145, 209865342976, 2404879675441, 29088885112832, 370371188237525, 4951498053124096, 69348874393137901

ho provato anche la tua macro cromagno, e funziona perfettamente, hai capito a pieno la richiesta, complimenti per la soluzione.

complimenti anche a te Anthony che sei sempre in grado di andare oltre.

ciao a tutti.

[cromagno]

Ciao a tutti,

@recaltatiiti
grazie per il riscontro

@Anthony
ho avuto un pò di tempo per controllare...
"l'errore" non dipendeva dai tuoi codici ma dal mio adattamento dei tuoi codici al mio file dove usavo il "mio" codice.

Facendo la copia del foglio per provare le tue macro è stata anche copiata l'unione delle celle (A14:J14) dove viene riportata la stringa finale (col mio codice).
Nei tuoi codici questa "unione" viene considerata come un'unica cella e quindi sfasava tutto.

Ancora complimenti e scusa per la segnalazione di un errore causato da me

Ciao
Tore

[Anthony47]

@cromagno: ah.. meno male! E ora che lo spieghi, nell'immagine che avevi postato si vedono bene le celle unite dove comincia l'errore!

@Stefano: Si, e' vero, manca un "1", ma non e' il primo (inserito con ZigoZago = "1, ") ma il secondo della serie; va modificata questa parte (in ambedue i codici proposti):

Codice: Seleziona tutto

            If j = 0 Then
                Cells(CurLn, CurCol) = Cells(CurLn - 1, CurCol)
                ZigoZago = ZigoZago & Cells(CurLn, CurCol) & ", "     'AGGIUNGERE!
            Else

Quanto alla visualizzazione della serie complessiva, con indici alti interverra' il limite di 1024 max caratteri visualizzati nella cella (ma la cella contiene fino a 8mila caratteri); questo limite verra' superato con indici oltre 45.

Ciao

[recalcatiiti]

Voilà, ecco chiarito ogni dubbio.

[OT]Grazie ragazzi, è bello vedere che là fuori ci sia ancora chi si appassiona e vuole vedere un po' più in là, sempre più in là.
Quel passo che ci permette di andare oltre, di espandere i nostri confini (esistono? questo meriterebbe una discussione a parte), lo stesso passo che garantisce le immense potenzialità che abbiamo. Perchè le abbiamo! Io ne sono sempre stato convinto e lo sarò sempre; sono solo celate dalla superficialità dell'ignoranza e dalla pigrizia che contraddistingue l'uomo medio oggigiorno.
Allo stesso tempo, però, non sono nessuno per giudicare. Se non sono gigli son pur sempre figli vittime di questo mondo.[/OT]

Ciao a tutti e grazie

Stefano

[Anthony47]

Cio' letto, devo correggere la correzione: non
If j = 0 Then
Cells(CurLn, CurCol) = Cells(CurLn - 1, CurCol)
ZigoZago = ZigoZago & Cells(CurLn, CurCol) & ", " 'AGGIUNGERE!
Else
Ma

Codice: Seleziona tutto

        If j = 0 Then
            Cells(CurLn, CurCol) = Cells(CurLn - 1, CurCol)
            If I = EBase - 1 Then ZigoZago = ZigoZago & Cells(CurLn, CurCol) & ", "
        Else


Infatti da quella posizione si passa a ogni variazione di I e la stringa con la sequenza dei numeri a zig-zag sarebbe errata (ci sarebbero molti doppioni)

Ciao, alla prossima.