# Euler Problem 52

Well, congratulate me. I’m now an official Euler blockhead. Technically, I’m a Euler Level 2 Cube, but blockhead seems more appropriate ;-) since a Cube is 50 problems below a Level 3 Novice octohedron.

Euler Problem 52 put me over the top, with 50+ problems solved. Problem 52 asks:

‘It can be seen that the number, 125874, and its double, 251748,
‘contain exactly the same digits, but in a different order.

‘Find the smallest positive integer, x, such that 2x, 3x, 4x, 5x,
and 6x, contain the same digits.

Absolute brute force. Little imagination. Going for that blockhead gusto. 4.9 seconds on my MacBook Pro running Parallels. I got tired of the Mac Excel VBE is a big way. It’s stuck at VBA5, and things like SmartIndenter don’t work there. Anyway, here’s my code:

Sub Problem_052()
Dim i       As Variant
Dim SAT     As Boolean
Dim Answer  As String
Dim T       As Single
Dim TEMP    As Variant

T = Timer
SAT = False
i = 1
Do
TEMP = SortString(i)
If TEMP = SortString(i * 2) Then
If TEMP = SortString(i * 3) Then
If TEMP = SortString(i * 4) Then
If TEMP = SortString(i * 5) Then
If TEMP = SortString(i * 6) Then
SAT = True
End If
End If
End If
End If
End If
i = i + 1
Loop Until SAT

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

End Sub

Here’s my SortString() function, which may show some imagination, and gets used again. It places alphanumerics in order. I use it as above to see if strings have the same content, but in a different order.

Function SortString(ByVal str) As String
Dim i       As Long
Dim j       As Long
Dim TEMP    As String * 1

j = 1
For i = Len(str) – 1 To 1 Step -1
str = Left(str, 2 * j – 1) &amp; Chr(32) &amp; Right(str, i)
j = j + 1
Next i

str = Split(str)

For i = LBound(str) To UBound(str) – 1
For j = i + 1 To UBound(str)
If str(i) &gt; str(j) Then
TEMP = str(j)
str(j) = str(i)
str(i) = TEMP
End If
Next j
Next i

For i = LBound(str) To UBound(str)
SortString = SortString &amp; str(i)
Next i

End Function

No grief about the bubble sort now ;-) . These strings are a dozen or so characters long…

…mrt

Posted in Uncategorized

## 17 thoughts on “Euler Problem 52”

1. Dick Kusleika says:

Change this line

i = 150000

and see what you get. There has to be a clue in there for a shortcut.

2. fzz says:

You don’t need to sort numerals within numbers. You only need to iterate through the numerals in the first number, deleting one matching numeral (if any found) in the second, then checking whether the second becomes “” upon completion.

Also, if x, 2x,…, 6x must all have the same number of places, then

(log(x) / log(10)) mod 1 .LT. log(1 + 1 / 3) / log(10)

so once x exceeds 133…33, you might as well increment directly as

x = 10 ^ Int(1 + log(x) / log(10)) + 1

3. fzz says:

Oops. Make that log(1 + 2 / 3) and 1.66…66.

4. Michael says:

Hi fzz –

That’s my IsPanDigital function. How’d you know? You must be looking over my shoulder ;-)

``` Function IsPanDigital(ByVal num As String, d As Long, Optional Start) As Boolean Dim i As Long If IsMissing(Start) Then Start = 1 If Len(num) GT d Then Exit Function For i = Start To d num = VBA.Replace(num, CStr(i), "", 1, 1) 'replacing 1st appearances Next i If Len(num) = 0 Then '1st appearance only of digits start->d have been replaced IsPanDigital = True Exit Function End If IsPanDigital = False End Function```

5. Michael says:

Opps –

Forgot to close out.

Also thanks for the quicksort routine. Playing with it while I checked in.

…mrt

6. Michael says:

Hi Dick –

1428570 Time: 57.9375

7. Michael says:

Well –

I found a problem with Parallels – copy and paste Mac->PC is fine. Copy and paste PC->Mac pastes in some additional garbage that mucks up WordPress. Half my reply to Dick went to some bit bucket. I hadn’t meant to be so abrupt. I closed before by saying this maybe where I’l put fzz’s routine.

…mrt

8. fzz says:

Me, I used awk.

BEGIN {
n = 101
s = log(1 + 2/3)/log(10)
while (check(n)) {
if (log(++n)/log(10) % 1 .GT. s) n = 10 ^ int(1 + log(n)/log(10)) + 1
}
}

function check(n , i, j, k, t) { # also c as an array
k = length(n)
for (j = 1; j

9. fzz says:

Me, I used awk. With FORTRAN-like comparison operators.

BEGIN {
n = 101
s = log(1 + 2/3)/log(10)
while (check(n)) {
if (log(++n)/log(10) % 1 .GT. s) n = 10 ^ int(1 + log(n)/log(10)) + 1
}
}

function check(n , i, j, k, t) { # also c as an array
k = length(n)
for (j = 1; j .LE. k; ++j) c[j] = substr(n, j, 1)
for (i = 2; i .LE. 6; ++i) {
t = i * n
for (j = 1; j .LE. k; ++j) sub(c[j], “”, t)
if (t != “”) return i
}
return 0
}

answer 142857 in 6.234 seconds

10. Michael says:

Hi fzz –

The answer makes sense…it can’t be over 166666 or i*6 will roll over to more decimal places. I’ve been impressed with the Parallels emulation. Code runs faster than my on my stock PC at work (and that’s a moderately fast HP). I named that tune in 4.96875 notes errr seconds on my Mac with Parallels and XL2002 on the PC side. I’ve just got to figure out how to cleanse my cut and pastes.

The first time I wrote IsPanDigital I didn’t specify the first occurrence only, so all digits got swapped out, and everything was TRUE.

Live and learn…
Thanks for your help and insights. I know that’s what Dick wanted to come from this.

…mrt (that answer’s out there now…interesting that Dick’s challenge was answered by a number 10x higher. Euler forgive us ;-) )

11. Doug Jenkins says:

I did it as a function that will check for any number of factors (but it didn’t find a solution going up to 7). Rather than sorting I fed the digits into an array, then formed the array into a string and compared those. You could probably save a millisecond or two there.

1.9 seconds on my machine:

Function p_52(level As Long) As Variant
Dim i As Long, j As Long, Same As Boolean, IntA() As Long, NumDig As Long
Dim Fact As Long, k As Long, l As Long, CheckDig1 As String, CheckDig2 As String
Dim Time As Double

Time = Timer
i = 100
On Error GoTo Err
Do
i = i + 1
CheckDig1 = “”
ReDim IntA(0 To 9, 1 To level)
NumDig = Len(Trim(i))
For Fact = 1 To level
j = i * Fact
If Len(Trim(j)) .GT. NumDig Then
i = 10 ^ NumDig
Exit For
End If
For k = 1 To NumDig
l = Mid(j, k, 1)
IntA(l, Fact) = IntA(l, Fact) + 1
Next k
For k = 0 To 9
If Fact = 1 Then
CheckDig1 = CheckDig1 & IntA(k, Fact)
Else
CheckDig2 = CheckDig2 & IntA(k, Fact)
End If
Next k
If Fact .GT. 1 Then
If CheckDig2 .NE. CheckDig1 Then
CheckDig2 = “”
Exit For
End If
CheckDig1 = CheckDig2
CheckDig2 = “”
End If
Next Fact
If Fact = level + 1 Then
p_52 = Array(i, Timer – Time)
Exit Function
End If
Loop
Err:
p_52 = “stopped at i = ” & i

End Function

12. Doug Jenkins says:

Quicker if you start at the top factor(6) and work down to 1. Comes down to 1.1 seconds for me.

13. Doug Jenkins says:

Tushar – I used strings because when I used longs I went over the maximum size. I could have just switched to doubles, or with a little more thought have changed my approach so I didn’t get such big numbers, but comparing strings just seemed the obvious way to do it. Also I wasn’t aware that it would be much slow than comparing numbers.

14. Hans Schraven says:

I used this one

Sub Euler52()
T = Timer
i = 0
Do
i = i + 1
If Len(i) = Len(2 * i) And Len(i) = Len(3 * i) And Len(i) = Len(4 * i) And Len(i) = Len(5 * i) And Len(i) = Len(6 * i) Then
For j = 1 To Len(i)
If InStr(i, Mid(i * 2, j, 1)) * InStr(i * 2, Mid(i, j, 1)) * InStr(i, Mid(i * 3, j, 1)) * InStr(i * 3, Mid(i, j, 1)) * InStr(i, Mid(i * 4, j, 1)) * InStr(i * 4, Mid(i, j, 1)) * InStr(i, Mid(i * 5, j, 1)) * InStr(i * 5, Mid(i, j, 1)) * InStr(i, Mid(i * 6, j, 1)) * InStr(i * 6, Mid(i, j, 1)) = 0 Then Exit For
Next
If j .gt. Len(i) Then Exit Do
End If
Loop
Debug.Print “answer:  “ &amp; i &amp; ”  time:  “ &amp; Timer – T
End Sub
15. Hans Schraven says:

For the length-test suffices

If Len(i) = Len(6 * i) Then
16. fzz says:

Actually, using VBA with numbers converted to strings is pretty efficient (for VBA). The following took less than a second runtime.

[FORTRAN-like comparison operators]

Sub euler52()
Dim i As Long, j As Long, k As Long, n As Long, p As Long
Dim s As Double, ns As String, ts As String, dt As Double

dt = Timer
s = Log(1# + 2# / 3#) / Log(10#)
n = 100
k = 3

Do
n = n + 1
If Log(n) / Log(10#) Mod 1# .GT. s Then
k = k + 1
n = 10 ^ k + 1
End If
ns = CStr(n)
For i = 2 To 6
ts = CStr(i * n)
For j = 1 To k
p = InStr(1, ts, Mid\$(ns, j, 1))
If p .GT. 0 Then Mid\$(ts, p, 1) = ” “ Else Exit For
Next j
If Trim(ts) .NE. “” Then Exit For
Next i
If i .GT. 6 Then
Debug.Print n, Timer – dt
Exit Do
End If
Loop
End Sub

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