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:
'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:
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
Answer = i
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.
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) & Chr(32) & 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) > 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 & str(i)
Next i
End Function
No grief about the bubble sort now . These strings are a dozen or so characters long…
…mrt
Change this line
i = 150000
and see what you get. There has to be a clue in there for a shortcut.
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
Oops. Make that log(1 + 2 / 3) and 1.66…66.
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
Opps -
Forgot to close out.
Also thanks for the quicksort routine. Playing with it while I checked in.
…mrt
Hi Dick -
1428570 Time: 57.9375
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
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
}
print “answer”, n
}
function check(n , i, j, k, t) { # also c as an array
k = length(n)
for (j = 1; j
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
}
print “answer”, n
}
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
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
)
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
Quicker if you start at the top factor(6) and work down to 1. Comes down to 1.1 seconds for me.
Why switch to strings to carry out various comparisons? It is probably so much faster to work with numbers. That’s what I did for this problem. The VBA code ran in under 0.2 seconds.
http://www.tushar-mehta.com/misc_tutorials/project_euler/euler052.html
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.
I used this one
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: " & i & " time: " & Timer - T
End Sub
For the length-test suffices
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]
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