# Euler Problem 36

‘The decimal number, 585 = 1001001001_(2) (binary),
‘is palindromic in both bases.

‘Find the sum of all numbers, less than one million, which
‘are palindromic in base 10 and base 2.

‘(Please note that the palindromic number, in either base,

A palindrome reads the same left-to-right as right-to-left. Examples are “Able was I ere I saw Elba” and “A man, a plan, a canal. Panama”, and for Euler-purposes, 585. Project Euler, when discussing hints, says to read the details of the problem carefully. In this problem, there is a big hint.

Not including leading zeros means no ending zeros. In base 10, then there are no palindromic even multiples of ten. In base 2, there are no palindromic evens at all.

Here is my code. It runs in a few tenths of a second.

Sub Problem_036()
Dim i       As Long
Dim Min     As Long
Dim Max     As Long
Dim IsTest  As Boolean
Dim t       As Single
Dim Dec     As String
Dim Dec_rev As String
Dim Bits    As String
Dim Bits_rev As String

t = Timer
IsTest = False
If IsTest Then
Min = 585
Max = 585
Else
Min = 1
Max = 999999   ‘ Less than 1000000
End If

For i = Min To Max Step 2   ‘Even numbers need not apply…
Dec = CStr(i)
Dec_rev = VBA.StrReverse(Dec)
If Dec = Dec_rev Then
Bits = LongToBit04(i)   ‘returns a 32-bit string
While Left(Bits, 1) = “0”   ‘stripping leading zeros
Bits = Mid(Bits, 2, Len(Bits) – 1)
Wend
Bits_rev = VBA.StrReverse(Bits)
If Bits = Bits_rev Then
End If
End If
Next i

Debug.Print Answer; ”  Time:”; Timer – t

End Sub

Function LongToBit04(ByVal lLong As Long) As String
‘ by Don/Egbert, 20001222
‘    donald@xbeat.net
‘    egbert_nierop@goovy.hotmail.com
Dim i       As Long

LongToBit04 = String\$(32, 48)    ’48 = “0”

‘ handle sign bit
If lLong And &amp;H80000000 Then
Mid\$(LongToBit04, 1, 1) = “1”
lLong = lLong And Not &amp;H80000000
End If

For i = 32 To 2 Step -1
If lLong And 1 Then Mid\$(LongToBit04, i, 1) = “1”
lLong = lLong 2   ‘shift right
Next

End Function

It takes the decimal number as a string and reverses it. If they are equal, then they are palindromic. For these cases, it turns the decimal via LongToBit04() into a 32-bit binary, strips the leading zeros, and reverses that. Again if equal, it adds to the running sum.

The LongToBit04() function comes from the people over at VBSPEED, “The Visual Basic Performance Site” at http://www.xbeat.net/vbspeed/. Over there they rack and stack algorithms for dozens of purposes. They score 10 different longs-to-bits schemes, for instance, and #4 isn’t even the fastest. The site doesn’t seem to be as active as it once was, but it’s a great resource still.

…mrt

Posted in Uncategorized

## 5 thoughts on “Euler Problem 36”

1. fzz says:

Good that you noticed that only odd numbers would work, bad that you’re iterating through all odd numbers between 1 and 999999. Sufficient to iterate only through palindromic numbers, and it’s far more efficient to construct palindromic decimal numbers recursively.

Do 1-digit numbers count as degeneratively palindromic? If so, all 1-decimal digit odds are also binary palindromic.

Realize that the 2-digit palindromic numbers are just the multiples of 11 from 11 to 99, so only 5 of them that are odd. It’s a lot faster to check 5 numbers than all 50 odd numbers between 1 and 99 inclusive.

The 3-digit palindromic numbers are the cross product of the set of odd 2-digit palindromic numbers above and the set of numerals 0 to 9. That is, generate 3-digit palindromic numbers by inserting each numeral 0 to 9 between the numerals in the previous set of 2-digit palindromic numbers. There are 50 such numbers vs 450 odd numbers between 101 and 999.

The 4-digit palindromic numbers are the cross product of the set of odd 2-digit palindromic numbers with the set of all 2-digit palindromic numbers (00, 11, 22, 33, . . ., 88, 99), so 50 such decimal numbers vs 4500 odd numbers between 1001 and 9999.

The 5-digit palindromic numbers are the cross product of the set of 4-digit palindromic numbers above and the set of numberals 0 to 9, so 500 such numbers vs 45000 odd numbers between 10001 and 99999. The set of 6-digit palindromic numbers are the cross product of the set of 4-digit palindromic numbers above with the set of all 2-digit palindromic numbers (00, 11, 22, 33, . . ., 88, 99), so 500 such decimal numbers vs 450000 odd numbers between 100001 and 999999.

There are times brute force is very far from optimal. Your approach checks all 500000 odd numbers between 1 and 999999. Cleverer recursive iteration would only need to check the 1110 odd decimal palindromic numbers between 1 and 999999.

Then there’s the picky stuff. Log(1E6, 2) j
If Not (((n And j) > 0) = ((n And k) > 0)) Then Exit Function ‘return FALSE
j = j * 2
k = k / 2
Loop

binpal = True
End Function

which would be MUCH MORE efficient than text comparisons.

2. fzz says:

Missed a left angle bracket before, so here’s the last bit again.

Then there’s the picky stuff. Log(1E6, 2) is less than 20, so you only need 20 bits to represent 999999. You’re using 32. Unnecessarily wasteful and inefficient. Next, you’re using a While-Wend loop with a Mid call inside it to lop off leading zeros one at a time from Bits rather than using

Bits = Mid\$(Bits, InStr(1, Bits, “1?))

But that still misses the point that you could check binary palindromic numbers using a function like

Function binpal(n As Long) As Boolean
Dim j As Long, k As Long

j = 1
‘+ term below needed to avoid truncation error for some powers of 2, e.g., 8
k = 2 ^ Int(Log(n) / Log(2) + 0.000000000001)

Do While k &gt; j
If Not (((n And j) &gt; 0) = ((n And k) &gt; 0)) Then Exit Function ‘return FALSE
j = j * 2
k = k / 2
Loop

binpal = True
End Function

which would be MUCH MORE efficient than text comparisons.

3. DCardno says:

I also assembled palindromic numbers in the function DecPal() – I iterate from 0 to 999, with a number ‘ab’ returning ‘abXba,’ where X= 1 to 9 as well as ‘abba.’ I didn’t bother to check for odd palindromes only, but the whole routine runs in under 0.1 of a sec. I didn’t think to use the sort of BinPal test suggested by fzz, but I will give that a try

Option Explicit

Sub FindPals()

Dim i               As Long
Dim j               As Integer
Dim k               As Long
Dim iTest           As Long
Dim iSum            As Long
Dim sStart          As Single

sStart = Timer
k = 1
For i = 0 To 999
For j = 0 To 10
iTest = DecPal(i, j)
If iTest  9
Do
DecPal = DecPal * 10 + i Mod 10
i = (i – i Mod 10) / 10
j = j + 1
Loop Until i = 0
If iVal &gt; 0 Then
DecPal = DecPal + iVal * 10 ^ j
End If

Case Else
If iVal = 0 Then
Else
Do
DecPal = DecPal * 10 + i Mod 10
i = (i – i Mod 10) / 10
j = j + 1
Loop Until i = 0

DecPal = DecPal + iAdd * 10 ^ j + iVal * 10 ^ (j + 1)
End If

End Select

End Function

Function DecBin(iDec) As String

Dim i               As Long

i = iDec
Do
DecBin = i Mod 2 &amp; DecBin
i = (i – i Mod 2) / 2
Loop Until i = 0

End Function

Function IsPal(stIN As String) As Boolean

Dim i               As Integer
IsPal = True

For i = 1 To Len(stIN) / 2
If Mid(stIN, i, 1)  Mid(stIN, Len(stIN) + 1 – i, 1) Then
IsPal = False
Exit For
End If
Next i
End Function

4. Michael says:

Hi fzz –

Aggravated with myself that I was clever enough to get the leading zeros part, but not the leading ones part. That was myopic, and
my usual method of stripping zeros, and I just went with it. I made that change. Run time dropped from 0.171875 seconds to 0.15625 ;-) or about 20%.

Quoting, I think, our host “When brute force isn’t enough, it’s time to get a bigger brute.”

Thank you for your insights. I learn a lot.

…mrt

5. DCardno says:

“When brute force isn’t enough, it’s time to get a bigger brute.”

Now that’s a keeper!

Posting code? Use <pre> tags for VBA and <code> tags for inline.