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
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...
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
