Appel d'une fonction à partir d'une macro

[garnote]

Bonjour à tous et à toutes,

Voici ma fonction et ma macro:

Function Syracuse(n As Long) As Long
    k = 1
    Do Until n = 1
        If n Mod 2 = 0 Then
            n = n / 2
        Else
            n = 3 * n + 1
        End If
        k = k + 1
    Loop
    Syracuse = k
End Function

Sub Essai()
    Dim x(1 To 12, 1 To 1)
    Dim y(1 To 12, 1 To 1)
    For i = 1 To 12
        x(i, 1) = 2 + i
    Next i
    y(1, 1) = Syracuse(3)
    y(2, 1) = Syracuse(4)
    y(3, 1) = Syracuse(5)
    y(4, 1) = Syracuse(6)
    y(5, 1) = Syracuse(7)
    y(6, 1) = Syracuse(8)
    y(7, 1) = Syracuse(9)
    y(8, 1) = Syracuse(10)
    y(9, 1) = Syracuse(11)
    y(10, 1) = Syracuse(12)
    y(11,1) =Syracuse(13)
    y(12,1)=Syracuse(14) 
    maxi = WorksheetFunction.Max(y)
    For i = 1 To 12
        If y(i, 1) = maxi Then
            [A1] = x(i, 1)
            Exit For
        End If
    Next i
    [B1] = maxi
End Sub

Comme je veux faire mes tests (Essai) sur des milliers de valeurs, il me faudrait faire une boucle pour "remplir" y avec Syracuse, mais quand je tente le coup, ça bogue. Probablement dû à une mauvaise déclaration de variables. J'ai un peu perdu la main depuis le temps lointain d'Excelabo! Vous avez des suggestions?

Serge

 

[mapomme]

Re : Appel d'une fonction à partir d'une macro

Bonjour garnote,

Un essai dans le fichier joint:

Function Syracuse(ByVal N As Long) As Long
Dim k&
  k = 1
  Do Until N = 1
    If N Mod 2 = 0 Then N = N / 2 Else N = 3 * N + 1
    k = k + 1
  Loop
  Syracuse = k
End Function

Sub Essai()
Dim N&, i&, x&(), y&(), maxi&
  Range("a:b").ClearContents
  Application.ScreenUpdating = False
  N = Val(InputBox("Nbr élément =?"))
  If N <= 0 Then Exit Sub
  ReDim x(1 To N, 1 To 1): ReDim y(1 To N, 1 To 1)
  For i = 1 To N: x(i, 1) = 2 + i: Next i
  For i = 1 To N: y(i, 1) = Syracuse(x(i, 1)): Next i
  maxi = WorksheetFunction.Max(y)
  i = WorksheetFunction.Match(maxi, y, 0)
  [A1] = x(i, 1): [B1] = maxi
  '--- pour vérif
    [a4].Resize(N) = x: [b4].Resize(N) = y
    [a3] = "X()": [b3] = "Y()"
  '--- fin vérif
End Sub

Edit: l'appel à la fonction Excel 'WorksheetFunction.Max(y) me limite à 65 536 lignes pour Y

la version v1a franchit ce seuil pour en atteindre un autre au delà duquel les calculs intermédiaires pour la fonction Syracuse aboutissent à des nombres plus grands que le maximum permis pour un entier long.

 

[Modeste geedee]

Re : Appel d'une fonction à partir d'une macro

Bonsour® Tatanka


je me perd en conjectures...
la conjecture a déjà été vérifiée numériquement jusqu’à 10^20 (par Tomas Oliveira e Silva),

ta quête de la médaille FIELDS expliquerait donc tes éclipses ???

 

[garnote]

Re : Appel d'une fonction à partir d'une macro

Ave Modeste,

Comme toujours, tes lumières m'éclairent beaucoup. J'ai bien saisi les tenants et aboutissants de ton premier fichier et après mûres et mûres réflexions, j'ai trouvé une façon bien plus simple de procéder. Je n'ai pas réussi à passer par des tableaux VBA mais ça va quand même très très vite, même pour de très grands nombres! Ce qui reste à découvrir, c'est le nombre de départ, inférieur ou égal à 1 000 000 qui a la "chaîne" la plus longue pour arriver à 1. Pour le moment, je bloque. As-tu une boucle à me proposer

Merci pour ta précieuse aide.

Serge

 

[garnote]

Re : Appel d'une fonction à partir d'une macro

Ben trop vieux pour la Fields! Je laisse ça à des dingues comme Cédric Villani!

 

[garnote]

Re : Appel d'une fonction à partir d'une macro

...
n = Val(InputBox("Premier nombre =?"))
If n = 0 Then Exit Sub ' Prudence!
...

et fou raide ton Rubik assisté!

 

[mapomme]

Re : Appel d'une fonction à partir d'une macro

Bonjour à tous ,

Une version plus aboutie.

Pour contourner les dépassements de capacité en cours de calcul, j'ai tenté d'intercepter ces dépassements et, dans ce cas, j'utilise un calcul via Excel (colonne A). Les bornes sont à saisir en F6 et F7.
(L'entier long max (en VBA) pour mon Excel est de: 2 147 483 647).
On peut faire un calcul direct en saisissant un nombre en A2.

le code:

Sub syracuse()
Dim borne1&, borne2&, i&, n&, syr&, max&, i0&, Ti
  
  Ti = Timer: [a2] = 1
  If [f6] > [c23] Or [f7] > [c23] Then
    MsgBox "Au moins une borne est sup. à l'entier long max (vba)."
    Exit Sub
  End If
  borne1 = [f6]: borne2 = [f7]
  Application.ScreenUpdating = False
  For i = borne1 To borne2
    If i Mod 50000 = 0 Then Application.StatusBar = _
        Format(i, "#,##0") & "  /  " & Format(borne2, "#,##0")
    On Error Resume Next
    ' syracuse pour n=i
    n = i: syr = 0
    Do Until n = 1
      syr = syr + 1
      If n Mod 2 = 0 Then n = CLng(n / 2) Else n = CLng(1 + n * 3)
      ' y a t il eu débordement au niveau entier long ?
      If Err.Number = 6 Then
        ' si oui, alors on utilise Excel pour le calcul
        [a2] = i: DoEvents
        syr = [c5]: n = 1: Err.Clear
      End If
    Loop
    If syr > max Then
      max = syr: i0 = i
    End If
  Next i
  Application.StatusBar = Format(i - 1, "#,##0") & _
          "  /  " & Format(borne2, "#,##0")
  [a2] = i0
  MsgBox Format(Timer - Ti, "#,##0.0") & " sec."
  Application.StatusBar = False
End Sub

 

[garnote]

Re : Appel d'une fonction à partir d'une macro

Salut mapomme,

Superbe présentation. Merci beaucoup.
J'obtiens les mêmes résultats mais de façon fort différente. J'ai vaincu les grands nombres
en remplaçant If n Mod 2 =0 Then par If int(x/2) = x/2 Then.

Bonne journée à toi et Modeste

Serge