Project Euler - Problem 14

More about Project Euler.

Problem description

The following iterative sequence is defined for the set of positive integers:

n → n/2 (n is even)
n → 3n + 1 (n is odd)

Using the rule above and starting with 13, we generate the following sequence:

13 → 40 → 20 → 10 → 5 → 16 → 8 → 4 → 2 → 1

It can be seen that this sequence (starting at 13 and finishing at 1) contains 10 terms. Although it has not been proved yet (Collatz Problem), it is thought that all starting numbers finish at 1.

Which starting number, under one million, produces the longest chain?

NOTE: Once the chain starts the terms are allowed to go above one million.

Solution

I delayed tackling this problem because the brute force approach did not appeal to me. I expected it to take well over the expectation of the duration for a Project Euler problem, which happens to be 1 minute.

The solution I finally came up with was a recursive routine that populates a table with results as they become available. The benefit of this approach is that as soon as we find an existing entry in the table, we know the length of the chain from that number on out and can use it. Since each even number will be halved in the first step, if we build the data base from 1 to 999,999, we will have the answer for each even number in just 1 step! For odd numbers, we will populate the table for numbers greater than the starting number itself. Here's an example. Consider the chain in the statement of the problem. In computing the length of the chain starting with 13, we also discover that the chain starting with 40 has a length of 9 and the chain starting with 20 has a length of 8. Further, we would not even have to compute the entire chain for 20 since the next number, 10, has already been analyzed (remember, we started from 1). So, the length of the chain for 13 requires building only 3 values (40, 20, and 10). In addition, we can update our table for the chain length for starting values 20 and 40.

As it turns out the best way to implement this method is to use a recursive approach. This way we let the OS / compiler do the heavy lifting of keeping track of what counter goes with what value.

The code below ran in about 50 seconds.

Option Explicit
Function CheckOneNbr(ByVal aNbr As Variant, SeqCount As Collection) As Integer
    Debug.Assert TypeName(aNbr) = "Decimal"
    On Error GoTo AddData
    CheckOneNbr = SeqCount(CStr(aNbr))
    Exit Function
AddData:
    On Error GoTo 0
    If CDec(Right(aNbr, 1)) Mod 2 = 0 Then CheckOneNbr = CheckOneNbr(aNbr / 2, SeqCount) + 1 _
    Else CheckOneNbr = CheckOneNbr(3 * aNbr + 1, SeqCount) + 1
    SeqCount.Add CheckOneNbr, CStr(aNbr)
    End Function
Sub Euler014()
    Dim I As Long
    Dim ProcTime As Single, MaxRslt As Integer, MaxStartNbr As Long
    Dim SeqCount As Collection
    ProcTime = Timer
    Set SeqCount = New Collection
    SeqCount.Add 1, CStr(1)
    MaxRslt = 1: MaxStartNbr = 1
    For I = 2 To 1000000 - 1
        CheckOneNbr CDec(I), SeqCount
        If MaxRslt < SeqCount(CStr(I)) Then
            MaxRslt = SeqCount(CStr(I))
            MaxStartNbr = I
            End If
        Next I
    Debug.Print MaxRslt, MaxStartNbr, Timer - ProcTime
    End Sub

Given how long it took, I entertained the possibility that the recursive solution was not the way to go. So, I wrote and checked the performance of the "flat" routine. It ran in about 120 seconds on my laptop.

Sub Euler014s()
    Dim I As Long
    Dim ProcTime As Single, MaxRslt As Integer, MaxStartNbr As Long
    ProcTime = Timer
    MaxRslt = 1: MaxStartNbr = 1
    For I = 2 To 1000000 - 1
        Dim Rslt As Variant, ThisSeqLen As Integer
        Rslt = CDec(I): ThisSeqLen = 1
        Do While Rslt <> 1
            If Right(Rslt, 1) Mod 2 = 0 Then Rslt = Rslt / 2 _
            Else Rslt = 3 * Rslt + 1
            ThisSeqLen = ThisSeqLen + 1
            Loop
        If MaxRslt < ThisSeqLen Then MaxRslt = ThisSeqLen: MaxStartNbr = I
        Next I
    Debug.Print MaxRslt, MaxStartNbr, Timer - ProcTime
    End Sub