Conjoncture de collât

Le 25/12/2017 à 16:40

Bonjour tout le monde et Joyeux Noël!

J'ai un programme qui fait planter mon ordi, et je ne sais pas d'où vient le problème!

quelqu'un saurait me pointer dans la direction de mes erreurs?

Sub collatzwhelp()

Dim startRow As Double, intCount As Double, x As Double

Dim n As Double, ev As Long, z As Long

startRow = 2
duree = 1 'C'est le début du décompte du nombre d'étapes avant d'obtenir 1
x = Range("C2")
Range("C1").Value = "Nombre de départ"

 'On vide le classeur
Range("A2:B" & Rows.Count).Value = vbNullString

'On donne pour valeur initiale à n le nombre donné par l'utilisateur
n = x

maxn = 0

'On crée une boucle qui fonctionne tant que n n'a pas atteint 0
Do While n <> 1

    If (n Mod 2) > 0 Then
'Si le nombre est pair
    n = (n * 3) + 1
    ev = ev + 1
    If n > x Then z = z + 1
Else
'Si le nombre est impair
    n = n / 2
    ev = ev + 1
    If n > x Then z = z + 1
End If

'If n > x And am = duree Then
'dva = dva + 1
'End If
'Range("F2") = dva

'duree = duree + 1

'On fait apparaitre la valeur à chaque boucle
Range("A" & startRow) = duree: Range("B" & startRow) = n
startRow = startRow + 1: duree = duree + 1

If WorksheetFunction.Max(x, n) > maxn Then
maxn = WorksheetFunction.Max(x, n)
End If

Loop

'On affiche les réponses
Range("D1").Value = "Durée du vol"
Range("D2") = ev
Range("E1").Value = "Durée du vol en altitude"
Range("E2") = z
Range("F1").Value = "Altitude maximale"
Range("F2") = maxn

End Sub
Le 25/12/2017 à 17:14

Bonjour

Peux-tu nous envoyer ton fichier ??

Nous ne pouvons pas aider ainsi...

Je viens de voir qu'apparemment tu ne fais pas évoluer n , donc ton do loop est une boucle infinie ???!!!

Merci

Le 25/12/2017 à 18:28

Bonjour, merci pour la remarque mais il me semble que je fais évoluer n? avec une formule si n est pair est une autre si il est impair.

Je n'ai pas la possibilité de joindre un fichier excel, mais voici mon code avec quelques modifications:

Sub test()

Dim startRow As Double, duree As Double, x As Double

Dim n As Double, c As Long, z As Long

startRow = 2
duree = 1 'Le décompte des étapes du vol commence ici

x = InputBox("Entrez un nombre entier")

'On établit que la valeur intiale de n est le nombre entré par l'utilisateur
n = x

Range("C2").Value = n

 'On vide le classeur
Range("A2:B" & Rows.Count).Value = vbNullString

'On crée une boucle qui fonctionne tant que n n'est pas égal à 1
Do While n <> 1

    If n Mod 2 > 0 Then
        n = n / 2
        c = c + 1
    If n < x Then z = z + 1
Else
'Si n est impair
    n = (n * 3) + 1
    c = c + 1
    If n < x Then z = z + 1
End If

'On montre les résultats
Range("A" & startRow) = duree: Range("B" & startRow) = x
startRow = startRow + 1: duree = duree + 1

Loop

'display summary
Range("D2") = c
Range("E2") = z

End Sub
Le 25/12/2017 à 18:46

Re

Tu as raison, mais si je rentre la valeur 5, je vais le diviser par 2 une première fois , puis il va être à 2,5 et en débuguant, on voit que il est toujours systématiquement pair et on l'augmente en permanence ( n = (n * 3) + 1), donc il sera toujours différent de 1 et on ne peut pas sortir de la boucle, fais du pas à pas tu verras..... à moins que Noël ne m'ait complètement brouillé l'esprit

A+

Le 25/12/2017 à 18:53

Salut,

merci pour la précision, je me suis peut être embrouillée entre les versions, en tout cas celle là marche:

Sub testplzworkk()
Dim colonne As Double, duree As Double, x As Double
Dim n As Double, ev As Long, z As Long, am As Long

'On vide le classeur
Range("A1:B" & Rows.Count).Value = nbNullString

x = InputBox("Entrez un nombre entier")
'On donne pour valeur initiale à n le nombre donné par l'utilisateur
n = x

startRow = 2
duree = 1 'C'est le début du décompte du nombre d'étapes avant d'obtenir 1
Range("C2").Value = x
Range("C1").Value = "nombre de départ"
am = 0
z = 0

'On crée une boucle qui fonctionne tant que n n'a pas atteint 0
Do While n <> 1
    If n Mod 2 = 0 Then
        n = n / 2
    Else
'si le nombre est impair
        n = (n * 3) + 1
    End If

If n > x Then
    dva = IIf(dva = 0, ev, dva)
End If

'On fait apparaitre la valeur à chaque boucle
Range("A" & startRow) = duree: Range("B" & startRow) = n
startRow = startRow + 1: duree = duree + 1

If WorksheetFunction.Max(x, n) > am Then
am = WorksheetFunction.Max(x, n)
End If

Loop

'On affiche les réponses
Range("D1").Value = "Durée du vol"
Range("D2") = duree
Range("E1").Value = "Durée du vol en altitude"
Range("E2") = dva
Range("F1").Value = "Altitude maximale"
Range("F2") = am

End Sub

le seul problème est qu'il me manque la variable dva:

le nombre d'étapes avant que la valeur de N devienne inférieure à la valeur initiale de n (soit à x).

J'imagine que c'est possible avec une fonction équiv mais je ne sais pas comment m'y prendre!

Le 25/12/2017 à 19:23

Re

Si j'ai bien compris ce que tu veux récupérer dans dva , tu pourrais peut-être faire simplement cela :

If n > x Then
    dva = dva + 1
End If

en ayant au préalable initialisé dva à 0

au lieu de cela :

If n > x Then
    dva = IIf(dva = 0, ev, dva)
End If

????

A voir

A+

Le 25/12/2017 à 19:38

Merci!

Oui c'est plus logique en effet!

Le problème est que n peut passer en dessous de x et ensuite repasser au dessus; Dans ce cas là la macro ne comptera pas le nombre d'étapes jusqu'à ce que n soit en dessous de x, mais toutes les étapes pour lesquelles n>x vous voyez ce que je veux dire?

Le 25/12/2017 à 19:57

RE

J'ai du mal à suivre, mais ici :

If n > x Then
    dva = IIf(dva = 0, ev, dva)
End If

ev n'a jamais été initialisé donc toujours à 0 ????

dva de même ??

Dur,dur

A +

Le 26/12/2017 à 00:26

Bonsoir, Salut Patty !

Assez plaisant exercice pour Noël ! Ça m'a tenté... 

Sub SuiteCollatz()
    Dim Vol() As Long, Tbl(1, 2), denr&, n&, d&, am&, dva&, fin As Boolean, valt As Boolean
    If MsgBox("La feuille active va être effacée !" & Chr(10) & "Voulez-vous continuer ?", _
     vbYesNo, "Démarrage...") = vbNo Then Exit Sub
    ActiveSheet.UsedRange.Clear
    On Error GoTo Fini
    n = CLng(InputBox("Entrez un nombre entier positif", "Initialisation"))
    If n < 1 Then Exit Sub
    On Error GoTo 0
    Do
        ReDim Preserve Vol(1, denr + 1000)
        If denr = 0 Then Vol(0, 0) = 0: Vol(1, 0) = n: am = n: valt = True
        Do
            d = d + 1
            Select Case n Mod 2
                Case 0: n = n / 2
                Case 1: n = n * 3 + 1
            End Select
            Vol(0, denr + d) = denr + d
            Vol(1, denr + d) = n
            If n > am Then am = n
            If valt Then
                If n > Vol(1, 0) Then dva = denr + d Else valt = False
            End If
            If n = 1 Then
                ReDim Preserve Vol(1, denr + d)
                fin = True: Exit Do
            End If
        Loop While d < 1000
        If fin Then Exit Do
        If MsgBox("La durée de vol a atteint " & denr + 1000 & "." & Chr(10) _
         & "Voulez-vous continuer ?", vbYesNo, "Poursuite Vol") = vbYes Then
            denr = denr + 1000
        Else
            Exit Do
        End If
    Loop
    Tbl(0, 0) = "Durée Vol"
    Tbl(0, 1) = "Durée Vol en altitude"
    Tbl(0, 2) = "Altitude maximale"
    Tbl(1, 0) = UBound(Vol, 2)
    Tbl(1, 1) = dva
    Tbl(1, 2) = am
    Application.ScreenUpdating = False
    With ActiveSheet
        .Range("A1").Resize(UBound(Vol, 2) + 1, 2).Value = WorksheetFunction.Transpose(Vol)
        With .Range("D2:F3")
            .Value = Tbl
            .HorizontalAlignment = xlCenter
            .Borders.Weight = xlThin
            .Columns.AutoFit
        End With
    End With
Fini:
End Sub

J'ai introduit quelques éléments supplémentaires : une précaution pour interroger l'utilisateur toutes les 1000 itérations... sans doute inutile car pour un nombre initial jusqu'à 1000000 on est encore loin d'atteindre 1000 ! Il est donc fort possible que le nombre entré dépasse les capacités de calcul d'Excel avant que le résultat puisse poser problème... Cela servira donc juste à incrémenter le tableau de vol par tranche de 1000 (mais je n'ai pas fait de test pour essayer de dépasser la première tranche...

Enregistrement sur tableau, l'affectation sur feuille n'intervient qu'à la fin...

Un autre point me chagrine un peu : c'est la durée maximal de vol en altitude. Je me suis fié à la définition de Wikipédia, mais il apparaît vite qu'avec cette définition cette durée sera 0 pour tout nombre pair choisi au départ !

Et je n'ai pas trouvé d'autre définition ailleurs (sans beaucoup cherché toutefois).

Cordialement.

Le 26/12/2017 à 01:46

Bonsoir à tous, bonsoir mferrand

Mferrand, je vois que Noël t'a donné des ailes...

Parfait

merveilleux travail comme d'habitude, très bien pour Candice

Je n'ai plus qu'à me coucher

A +

Le 26/12/2017 à 03:18

Bonjour à tous ...

J'apporterais juste une précision sur le titre : il s'agit bien d'une conjecture (assertion pour laquelle on ne connaît pas encore de démonstration, mais que l'on croit fortement être vraie, en l'absence de contre-exemple) et non une conjoncture (ensemble des éléments qui constituent une situation présente, passée ou future et qui entrent en conjonction) ...

Sujet intéressant pour une programmation VBA qui doit aboutir à 1 ... si ce n'est pas le cas, vous aurez un prix Field ou Abel !

Le 26/12/2017 à 05:21

Je n'ai pas compris les histoires de vol ... sur la suite de Syracuse, il y a plus simple :

Sub Syracuse()
Dim n As Long, cpt As Integer
n = Abs(Int(InputBox("Entrer un entier ...")))
cpt = 1
Do While n > 1
    Debug.Print cpt & " :: " & n
    n = IIf(n Mod 2 = 0, n / 2, n * 3 + 1)
    cpt = cpt + 1
Loop
Debug.Print cpt & " :: " & n
End Sub
Rechercher des sujets similaires à "conjoncture collat"