Euler Problem 36 asks:

‘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,

‘may not include leading zeros.)

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.

Dim i As Long

Dim Min As Long

Dim Max As Long

Dim IsTest As Boolean

Dim t As Single

Dim Answer As Long

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

Answer = Answer + i

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 &H80000000 Then

Mid$(LongToBit04, 1, 1) = “1”

lLong = lLong And Not &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

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.

…

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

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 > 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.

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

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 > 0 Then

DecPal = DecPal + iVal * 10 ^ j

End If

Case Else

If iVal = 0 Then

DecPal = iAdd

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 & 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

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

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

Now that’s a keeper!