VBA Longest Collatz Sequence-CodePudding

I am writing a Sub to identify the longest Collatzs Sequenze between 1 and 1000. Since I just started learning VBA am wondering how I can add the process to count the length of each sequence.

Sub Collatz()

Dim i As Long
Dim maxSteps As Integer


    For i = 1 To 1000
    
        If i = 1 Then
            maxSteps = CInt(20.856 * Log(2))
        Else
            maxSteps = CInt(20.856 * Log(i))
        End If
    
        If i Mod 2 = 0 Then
            i = i / 2
        Else
            i = 3 * i   1
        End If
    
    Debug.Print i
    
    Next i
    
End Sub

CodePudding user response：

I am not sure what the Log is supposed to do in your example but I would write it like this:

Sub Collatz()
    Dim i As Long, j As Long
    Dim steps As Long
    Dim n As Long
    Dim maxSteps As Long

    For i = 1 To 1000
        j = i
        steps = 1
        Do Until j = 1
            If j Mod 2 = 0 Then
                j = j / 2
            Else
                j = 3 * j   1
            End If
            steps = steps   1
        Loop
        If steps > maxSteps Then
            n = i
            maxSteps = steps
        End If
    Next i
    Debug.Print n, maxSteps
End Sub

CodePudding user response：

Collatz

Option Explicit

Sub IdentifyFirstLongestCollatz()

    Const nStart As Long = 1
    Const nEnd As Long = 1000

    Dim n As Long
    Dim nCurr As Long
    Dim nMax As Long
    Dim RootNumber As Long
    
    For n = nStart To nEnd
        nCurr = CountHailstoneNumbers(n)
        If nMax < nCurr Then
            nMax = nCurr
            RootNumber = n
        End If
    Next n
    
    Debug.Print "Root Number:       " & RootNumber
    Debug.Print "Hailstone Numbers: " & nMax
    Debug.Print "Collatz Path:      " & Join(ArrCollatzPath(RootNumber), ",")
 
' Result:
' Root Number:       871
' Hailstone Numbers: 179
' Collatz Path:      871,2614,1307,3922,1961,5884,2942,1471,4414,2207,6622,3311,9934,4967,14902,7451,22354,11177,33532,16766,8383,25150,12575,37726,18863,56590,28295,84886,42443,127330,63665,190996,95498,47749,143248,71624,35812,17906,8953,26860,13430,6715,20146,10073,30220,15110,7555,22666,11333,34000,17000,8500,4250,2125,6376,3188,1594,797,2392,1196,598,299,898,449,1348,674,337,1012,506,253,760,380,190,95,286,143,430,215,646,323,970,485,1456,728,364,182,91,274,137,412,206,103,310,155,466,233,700,350,175,526,263,790,395,1186,593,1780,890,445,1336,668,334,167,502,251,754,377,1132,566,283,850,425,1276,638,319,958,479,1438,719,2158,1079,3238,1619,4858,2429,7288,3644,1822,911,2734,1367,4102,2051,6154,3077,9232,4616,2308,1154,577,1732,866,433,1300,650,325,976,488,244,122,61,184,92,46,23,70,35,106,53,160,80,40,20,10,5,16,8,4,2,1
End Sub

' A008908: 1, 2, 8, 3, 6, 9, 17, 4, 20, 7, 15, 10, 10, 18, 18,...
' The count of the numbers in the sequence
Function CountHailstoneNumbers( _
    ByVal RootNumber As Long) _
As Long
    Dim cNum As Long: cNum = RootNumber
    CountHailstoneNumbers = 1
    Do Until cNum = 1
        If cNum Mod 2 = 0 Then
            cNum = cNum / 2
        Else
            cNum = 3 * cNum   1
        End If
        CountHailstoneNumbers = CountHailstoneNumbers   1
    Loop
End Function

Function ArrCollatzPath( _
    ByVal RootNumber As Long) _
As Variant
    Dim dict As Object: Set dict = CreateObject("Scripting.Dictionary")
    Dim cNum As Long: cNum = RootNumber
    dict(cNum) = Empty
    Do Until cNum = 1
        'DoEvents
        If cNum Mod 2 = 0 Then
            cNum = cNum / 2
        Else
            cNum = 3 * cNum   1
        End If
        dict(cNum) = Empty
    Loop
    ArrCollatzPath = dict.Keys
End Function


Sub PrintHailstoneNumbersCount()
    Dim n As Long
    For n = 1 To 20
        Debug.Print n, CountHailstoneNumbers(n)
    Next n
' Result:
' 1             1
' 2             2
' 3             8
' 4             3
' 5             6
' 6             9
' 7             17
' 8             4
' 9             20
' 10            7
' 11            15
' 12            10
' 13            10
' 14            18
' 15            18
' 16            5
' 17            13
' 18            21
' 19            21
' 20            8
End Sub


' A006577: 0, 1, 7, 2, 5, 8, 16, 3, 19, 6, 14, 9, 9, 17, 17,...
' The number of steps to reach 1
Function CountSteps( _
    ByVal RootNumber As Long) _
As Long
    Dim cNum As Long: cNum = RootNumber
    Do Until cNum = 1
        If cNum Mod 2 = 0 Then
            cNum = cNum / 2
        Else
            cNum = 3 * cNum   1
        End If
        CountSteps = CountSteps   1
    Loop
End Function