VBA : La conjecture de Syracuse

Comment reprendre l'activité sur le blog, fortement délaissé ces derniers mois.  Une idée pour aider mes lecteurs à la manipulation du VBA, est de reprendre tous les grands classiques que l'on peut rencontrer dans l'enseignement de l'algorithmie. Aussi je commence cette semaine avec l'indécidable (au sens mathématique du terme) conjecture de Syracuse.

Également appelé suite de Collatz, du nom du mathématicien allemand qui l’énonça  pour la première fois en 1928. Puis, elle apparu à nouveau à l'université de Syracuse (New-York) dans les années 50. Aucune solution n'étant trouvée, le probléme s'est propagé aux autres universités américaines. Dans le contexte de la guerre froide, on évoqua une manœuvre russe pour paralyser la recherche américaine.

Considérons un entier n positif auquel on va faire subir une transformation.

• Si n est pair on le divise par deux
• Si n est impair, on le multiplie par 3 et on ajoute 1

Puis, on recommence sur le résultat obtenu.
Par exemple, en prenant n = 10, on obtient : 10 - 5 -16 - 8 - 4 - 2 - 1

Conjecture :  Quel que soit l'entier n choisit, on finit toujours par atteindre la valeur 1.

Dans cette procédure VBA, nous testons la conjecture pour un entier n compris entre 1 et 100 (l'intervalle [1, 100] est vérifié et on ne peut faire que trois saisies). Ensuite elle calcule le temps de vol ( nombre d'entier rencontré avant de trouver 1 ) et l'altitude maximale ( la valeur maximale de la suite ).

Bonne programmation...

Sub Syracuse()
Dim n As Long
Dim vol As Long
Dim am As Long
Dim cpt As Byte
vol = 0
cpt = 1
n = 0
am = 0
On Error GoTo Sierreur
'******************************
'nettoyage des afichages précédents
Range("d1:d3").ClearContents
Range("a:a").ClearContents
'********************
n = InputBox("Saisir un entier n = ", _
"Conjecture de Syracuse - " & cpt & " fois", 1)
Do While n < 1 Or n > 100
    cpt = cpt + 1
    n = InputBox("Saisir un entier n = ", _
    "Conjecture de Syracuse - " & cpt & " fois", 1)
    If cpt = 3 And ((n < 1) Or (n > 100)) Then
        MsgBox "vous avez essayé 3 fois", _
        vbOKOnly + vbCritical, "Conjecture de Syracuse"
        Exit Sub
    End If
Loop
Range("d3").Value = n
'*****************************
Do While n <> 1
    If n Mod 2 = 0 Then
    'rien de mieux que le modulo pour savoir si un
    'nombre est pair ou impair
        n = n / 2
    Else
        n = (n * 3) + 1
    End If
    vol = vol + 1
    'incrementons le temps de vol
    Cells(vol, 1).Value = n
    If n > am Then
    'recuperons le max
        am = n
    End If
Loop
    Range("d1").Value = vol
    Range("d2").Value = am
Sierreur:
End Sub

Partager |