You are on the Home/Other Tutorials/Project Euler/Problem 55 page
Google
Web This Site

Project Euler - Problem 55

More about Project Euler.

Problem description

If we take 47, reverse and add, 47 + 74 = 121, which is palindromic.

Not all numbers produce palindromes so quickly. For example,

349 + 943 = 1292,
1292 + 2921 = 4213
4213 + 3124 = 7337

That is, 349 took three iterations to arrive at a palindrome.

Although no one has proved it yet, it is thought that some numbers, like 196, never produce a palindrome. A number that never forms a palindrome through the reverse and add process is called a Lychrel number. Due to the theoretical nature of these numbers, and for the purpose of this problem, we shall assume that a number is Lychrel until proven otherwise. In addition you are given that for every number below ten-thousand, it will either (i) become a palindrome in less than fifty iterations, or, (ii) no one, with all the computing power that exists, has managed so far to map it to a palindrome. In fact, 10677 is the first number to be shown to require over fifty iterations before producing a palindrome: 4668731596684224866951378664 (53 iterations, 28-digits).

Surprisingly, there are palindromic numbers that are themselves Lychrel numbers; the first example is 4994.

How many Lychrel numbers are there below ten-thousand?

NOTE: Wording was modified slightly on 24 April 2007 to emphasise the theoretical nature of Lychrel numbers.

Solution

Using the Large Number Arithmetic module, specifically, the LargeAdd routine it was easy to directly implement the problem description into code.  Since a requirement towards getting the correct solution was to compute the actual palindrome, I took the time to list them.

Function IsPalindrome(ByVal X As String) As Boolean
    IsPalindrome = X = StrReverse(X)
    End Function
Sub Euler055()
    Dim I As Integer, aNbr As String, Palindromes() As String, _
        PalindromeCount As Integer, _
        TimeIt As Single
    TimeIt = Timer
    ReDim Palindromes(9998)
    For I = 1 To 9999
        aNbr = CStr(I)
        Dim RetryCount As Integer, EndLoop As Boolean
        RetryCount = 0: EndLoop = False
        Do
            aNbr = LargeAdd(aNbr, StrReverse(aNbr))
            If IsPalindrome(aNbr) Then
                Palindromes(PalindromeCount) = aNbr
                PalindromeCount = PalindromeCount + 1
                EndLoop = True
            ElseIf RetryCount >= 50 Then EndLoop = True
            Else
                RetryCount = RetryCount + 1
                End If
            Loop Until EndLoop
        Next I
    Debug.Print PalindromeCount, Timer - TimeIt
    ReDim Preserve Palindromes(PalindromeCount - 1)
    ActiveSheet.Cells(1, 1).Resize(PalindromeCount, 1).Value = _
        Application.WorksheetFunction.Transpose(Palindromes)
    End Sub