﻿ Project Euler Problem 55
You are on the Home/Other Tutorials/Project Euler/Problem 55 page

Web This Site

# Project Euler - Problem 55

## 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
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```