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