Euler Problem 206 asks:
Find the unique positive integer whose square has the form 1_2_3_4_5_6_7_8_9_0,
where each “_” is a single digit.
First thing to note is that Euler wants the integer, not the square that conforms to the pattern. That failure to RTFQ costs me a couple of hours as I kept trying to check in a 19-digit number when the answer is a 10-digit number. I saw immediately how to build the numbers that fit the pattern, and wrote this code:
Dim Answer As Double, T As Single
Dim Answer_Sqrd As String
Dim i As Long, j As Long
Dim TEMP As String
T = Timer
For j = 999999999 To 0 Step -1
TEMP = Format(j, “000000000”)
For i = 1 To 9
Answer_Sqrd = Answer_Sqrd & i & Mid(TEMP, i, 1) ‘ “1” & “9” & “2” & “9” & “3” …
Next i
Answer_Sqrd = Answer_Sqrd & “0” ‘ “192939495969798999” & “0”
Answer = Sqr(CDbl(Answer_Sqrd))
If Answer = Int(Answer) Then
Debug.Print Answer; ” Time:”; Timer – T
End
End If
Answer_Sqrd = “”
Next j
End Sub
It runs in a very uncool 21+ seconds on my home machine. It builds the number squared by successively concatenating a counter with the digit that lies at that counter within a string variable that counts down from 999,999,999; and then it looks for integer square roots. I counted down instead of up from Euler experience–Euler’s answers tend to be at the high end of anticipated values. Neat idea, not so neat for performance, and I was surprised that doubles were accurate enough to solve a problem requiring 19 significant figures. Euler often asks for computations beyond their accuracy. The answer is the sole integer square root. End when that number is found.
So I rewrote the code from the square root point of view. The largest possible number is when the underscores are all nines, and the smallest when the underscores are all zeros. Compute those square roots, again as doubles, and check from the top down for the sole square between those numbers squared that conforms to the pattern. Doing it as a decimal variant provides all the precision required.
One thing I learned from that is that CDec() is not commutative. There is a difference between Cdec(A*A) and CDec(A)*CDec(A)
Dim Answer As Double, T As Single
Dim Answer_Sqrd As Variant, SAT As Boolean
Dim Min As Double, Max As Double
Dim i As Long, j As Long
T = Timer
Min = Int(Sqr(CDbl(“1020304050607080900”))) ‘smallest acceptable number
Max = Int(Sqr(CDbl(“1929394959697989990”))) ‘largest acceptable number
For Answer = Max To Min Step -1
Answer_Sqrd = CDec(Answer) * CDec(Answer) ‘Cdec(Answer*Answer) doesn’t work
j = 1
For i = 1 To 19 Step 2 ‘checking every other digit
If i = 19 Then j = 0
If Mid(Answer_Sqrd, i, 1) = CStr(j) Then ‘pattern matches
SAT = True
j = j + 1
Else ‘pattern broken
SAT = False
Exit For
End If
Next i
If SAT Then ‘every other digit is right wrt 1 to 9, 9 to 0
Debug.Print Answer; ” Time:”; Timer – T; Answer_Sqrd
End
End If
Next Answer
End Sub
This code ran in .04 seconds. Now that was cool. I should have thought harder back at the beginning. The first was way checks about 2.77 billion numbers for every one the second way checks.
…mrt
I hadn’t noticed this one; I’ve been busy getting stuck on some around the 100 point. Nice one.
Ever the optimiser of other peoples’ code, however, I did notice the following: the answer has to be a multiple of 10 to give a square that ends in zero, so your step size can be -10 providing you adjust start and end values accordingly. That also means you don’t need the i=19/j=0 test, which will always be true. Also, I wonder if the CStr(j) is slower than creating a string constant and applying Mid() to that. It would reduce the size of the code somewhat:
SAT = True
For i = 1 To 19 Step 2
SAT = ( Mid(Answer_Sqrd, i, 1) = Mid(TEST_STRING, i, 1) )
If Not SAT Then Exit For
Next i
…but it’s a bit nit-picky for a 0.04 second runtime!
I think there’s probably some more mathemtical work that can be done: my solution took 0.015 sec counting down, but 444 sec counting up.
Hi Mike –
Please optimize away. I asked Dick if I could do this just as much to learn as maybe to teach. I’m a systems engineer. Even with a CS grad degree, all my code is for my personal use. This makes me not too much more than a hobbyist conversing with pro’s.
Reading the Euler fine print, I saw that you could sort the problems by increasing difficulty, which in practice I think is a descending sort on number of solvers. Problem 206 was right near where my checkmarks ran out.
I added to the Problem 73 thread how I saw the recursive function working. Didn’t help doing problem 72. I’m stalled too. No more snowy weekends for a while to stay inside ;-) Chores aplenty await.
…mrt
Hi Mike –
I added one line of code below the MAX = Int(Sqr(Cdbl(…))) line:
Max = Max + 10 – (Max Mod 10)
And then I changed “Step -1? to “Step -10?
And now Timer – t is 0 seconds! Maximum cool! Thanks.
…mrt
Not sure if you’ve factored this in (I’m not a VB expert by any stretch), but the square root must end in a zero, given that its square ends in a zero.
Does this reduce your possible answers by a factor of ten?
Hi Dan –
Exactly so…that’s why the step can go from -1 to -10. I didn’t see it, but Mike W pointed the same out above. Thinking about it, it goes the other way too…if the square root ends in zero, the square must end in 00.
…mrt
No squared integer can end with 0 without ending with 00. So the max is actually 1929394959697989900. The answer is 10 N with N^2 satisfying 1_2_3_4_5_6_7_8_9, and if N^2 ends in 9, then N must end in either 3 or 7. So N = 10 M + {3|7} for some other integer M, so N^2 = 100 M^2 + {60|140} M + {9|49}. No need to check for the final 9, so M^2 + {.6|1.4} M + {0|.4} must be of the form 1_2_3_4_5_6_7_8.#, so it’s sufficient to find such M.
The reason for the speed of your second macro is searching backwards from max to min. The answer is close to max.
Here’s an alternative.
Const p As String = “1?2?3?4?5?6?7?8”
Dim m As Double, dt As Double
dt = Timer
m = CLng(Sqr(CDec(“192939495969798”))) ‘start at the max
Do
If Int(m * (m + 0.6)) Like p Then
m = 100 * m + 30
Exit Do
End If
If Int(m * (m + 1.4) + 0.4) Like p Then
m = 100 * m + 70
Exit Do
End If
m = m – 1# ‘and decrement
Loop
Debug.Print m, CDec(m) * CDec(m), Timer – dt
End Sub