# Euler Problem 123

Euler Problem 123 asks:

Let p(n) be the nth prime: 2, 3, 5, 7, 11, …, and let r be the remainder when (p(n)-1)n + (p(n)+1)n is divided by p(n)2.

For example, when n = 3, p(3) = 5, and 43 + 63 = 280. 280 mod 25 = 5.

The least value of n for which the remainder first exceeds 109 is 7037.

Find the least value of n for which the remainder first exceeds 1010.

This is really the same problem as Euler 120 (posted last week) with p(n) taking the part of a. We are looking for 2*p(n)*n greater than 1010. I built a collection of the first 7037 primes, and then added primes one-by-one to the collection until the remainder was large enough, with the caveat that even n gives a remainder of 2, so we need an odd n.

All prime numbers beyond 3 lie left or right of an even multiple of six so a prime-checking routine need only check whether or not n mod 6 = 1 or 5 has even divisors, and even then, only up to the square root of n.

Here is the code that does that. The routine runs in about 2.5 seconds.

Sub Problem_123()
Dim Answer As Long, T As Single
Dim n As Long, i As Long, R As Double
Dim p       As New Collection

T = Timer

p.Add Item:=2, Key:=“2”   ‘1st Prime
n = 1
i = 3

Do
If IsPrime3(i) Then
n = n + 1
End If
i = i + 2
Loop Until n = 7037   ‘Primes in p

Do
If n Mod 2 = 0 Then
R = 2
Else
R = 2 * p.Item(n) * n
End If
If R GT 10 ^ 10 Then
Exit Do
End If
i = p.Item(n) + 2
Do Until IsPrime3(i)
i = i + 2
Loop
n = n + 1
Loop

Debug.Print Answer; ”  Time:”; Timer – T, p.Item(Answer), R
End Sub

Function IsPrime3(Num As Variant) As Boolean
Dim i       As Long

If Num  != Int(Num) Then
Exit Function                                      ‘IsPrime = False
Else
Num = CDec(Num)
End If
If Num LT 2 Then Exit Function                         ‘IsPrime = False
If Num = 2 Then
IsPrime3 = True
Exit Function
End If
If Num = 3 Then
IsPrime3 = True
Exit Function
End If

Select Case Num Mod 6
Case 1, 5
For i = 3 To Sqr(Num) Step 2
If Num Mod i = 0 Then Exit Function          ‘IsPrime = False
Next i
Case Else
Exit Function                                   ‘IsPrime = False
End Select

IsPrime3 = True
End Function

Dick has more on prime numbers here. The usual angle bracket corrections are in the above.

…mrt

# Euler Problem 120

Euler Problem 120 asks:

Let r be the remainder when (a-1)n + (a+1)n is divided by a2.

For example, if a = 7 and n = 3, then r = 42:

• 63 + 83 = 728
• 728 mod 49 = 42

And as n varies, so too will r, but for a = 7 it turns out that r_max = 42.

For 3 <= a <= 1000, find Sum(r_max).

All my brute force attempts to solve this problem overflowed whatever variable type I used, from longs through currency through decimal variants through doubles. Another approach was needed, and Isacc Newton had it figured out in his binomial theorem, which gives the expansion of (x+y)n.

Four examples:

Adding equations (1) and (2) together, which have n = 2, gives

This is true for all even n.

Adding equations (3) and (4) together, which have n = 3, gives

This is true for all odd n.

Within equations (5) and (7), 2an is evenly divisible by a2. The remainders are thus 2 for even n and 2an for odd n respectively. How big can n grow? Such that 2an stays less than a2, or 2n is less than a. Otherwise, a2 divides one more time.

Looping through a = 3 to a = 1000 and summing 2an provides the answer. This simple code does that. It runs in a blink.

Sub Problem_120()
Dim Answer As Long, T As Single
Dim a As Long, n As Long

T = Timer

For a = 3 To 1000
n = 2
While 2 * n LT a
n = n + 1
Wend
n = n – 1 ‘ went 1 too far
Answer = Answer + 2 * a * n
Next a

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

The usual angle bracket adjustment is in the code. Next week, I’ll put up Problem 123, which uses this same approach, but with a as prime numbers.

…mrt

# Euler Problem 206

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:

Sub Problem_206A()

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 &amp; i &amp; Mid(TEMP, i, 1)   ‘ “1” &amp; “9” &amp; “2” &amp; “9” &amp; “3” …
Next i
Answer_Sqrd = Answer_Sqrd &amp; “0”   ‘ “192939495969798999” &amp; “0”
Debug.Print Answer; ”  Time:”; Timer – T
End
End If
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)

Sub Problem_206B()
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
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

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

# Euler Problem 100

Euler Problem 100 asks:

If a box contains twenty-one coloured discs, composed of fifteen blue discs and six red discs, and two discs were taken at random, it can be seen that the probability of taking two blue discs, P(BB) = (15/21)×(14/20) = 1/2.

The next such arrangement, for which there is exactly 50% chance of taking two blue discs at random, is a box containing eighty-five blue discs and thirty-five red discs.

By finding the first arrangement to contain over 10^12 = 1,000,000,000,000 discs in total, determine the number of blue discs that the box would contain.

Using R for #Red, B for #Blue and T for total (R+B), the basic equation here is:

Since they can neither equal each other nor both be the square root of 0.5 (or 0.707106781…) we want B/T to be a skosh over the square root of 0.5, and (B-1/T-1) a skosh under. In other words, the answer will be the first integer B greater than Sqr(0.5)*10^12.

If we rearrange the equation, we get

• 2B^2 – 2B = T^2 – T

A single double quadratic equation with two unknowns can be morphed into a Pell equation with either no solutions, or an infinite number of them. Again, Euler wants the first solution with total discs T greater than 10^12. The first hit on a Google search for probability and Pell (here) returns an article exactly on point, with the examples for P=0.5 worked out in the first 11 cases. Dr. Sasser must have written it in a hurry, because it can be confusing. He uses two variables y, and they mean different things. I’m going to try to sort that out. There are also a few typos, but you can figure them out from context. The above equation does morph, as Dr. Sasser shows how, into Pell-form x^2 – Dy^2 = C as

• x^2 – 2y^2 = -1

with y = 2B-1. B, the number of Blue discs, is then (y+1)/2. Once we have the y solutions, we have the B solutions. The solutions for this Pell equation are x + y*Sqr(2) = (1 + sqr(2))^n, for integer n.

Flashing back to algebra, the product of (aw + bz)(cw + dz) is:

• acw^2 + (ad + cb)wz + dbz^2

If c = 1, w = 1, d = 1, z = Sqr(2), and z^2 = 2 corresponding to solution 1*1 + 1*Sqr(2) then rearranging the above gives:

• a + 2b + (a+b)*Sqr(2)

This is of the form x + y*Sqr(2) with x = a + 2b and y = a + b. This gives us a method to take (1 + Sqr(2)) to any integer power n. Recall that we’re looking for the y = a + b that gives B = (y+1)/2 greater than Sqr(0.5)*10^12.

This is the code that does that. It runs in a blink.

Sub Problem_100()

Dim A As Double, B As Double
Dim TEMP    As Double
Dim Answer As Double, T As Single

T = Timer

A = 1
B = 1

Do Until Answer &gt; Sqr(0.5) * 10 ^ 12
TEMP = A
A = A + 2 * B
B = TEMP + B
Answer = (B + 1) / 2   ‘the number of Blue discs
Loop

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

End Sub

The first time I attempted this problem I incremented B or T as necessary to get just above Sqr(0.5)*10^12. Don’t go that way. Floating arithmetic errors give “false positives” for that approach.

There usual angle bracket corrections are in the code.

…mrt

# Euler Problem 80

Euler Problem 80 asks:

It is well known that if the square root of a natural number is not an integer, then it is irrational. The decimal expansion of such square roots is infinite without any repeating pattern at all.

The square root of two is 1.41421356237309504880…, and the digital sum of the first one hundred decimal digits is 475.

For the first one hundred natural numbers, find the total of the digital sums of the first one hundred decimal digits for all the irrational square roots.

The first thing I wanted to know to solve this problem was what the square root of 2 was to 100 places. I wasn’t getting the right sum. I found it here.

1.4142135623730950488016887242096980785696718753769480731766797379907324784621070388503875343276415727
which is
979291172255376750081652821559640563801792871084643
divided by
692463428657900307544320387485120303323686251920582

When I summed the decimal digits, I got 481, not 475. But if I drop the right-hand 7 and add the left-of-the-decimal 1, that’s a down-spot of 6. Euler wants the sum of the first 100 digits, not the first 100 after the decimal.

To make the calulation I wanted an algorithm that computed square roots as strings. I found that here. The author says of his Japanese method

It is an amusing exercise to program a computer to do this algorithm, at least if n is an integer, and because only integer additions and subtractions are used, there are no errors due to floating-point arithmetic. On the other hand, it is necessary to use more complicated storage techniques (strings or arrays) to store the values of a and b as they get larger and larger, and the algorithm will get slower and slower at producing successive digits.

Amusing? I’m not so sure. To implement the Japanese method in strings, it took me a while to find the equivalent of “a greater than or equal to b” where a and b are string representations of numbers. I ended up with:

• If the length of a is greater than the length of b, then a is greater than b
• If the length of a is less than the length of b, then a is less than b
• If the length of a equals the length of b then do a string-comparison

Don’t know why that took as long as it did.

I also needed an algorithm for subtracting strings. Rather than write a “borrowing” routine, I used the “method of nines’-complement” found here on Wikipedia.

When it was all done, the code runs in 11 seconds.

Sub Problem_080()
Dim i As Long, j As Long
Dim TEMP    As String
Dim Answer As Long, T As Single

T = Timer

For i = 2 To 99   ‘ Square Roots of 1, 100 not needed
If Sqr(i) != Int(Sqr(i)) Then
TEMP = JSqrRoot(i, 110, False) ‘a little padding for convergence
For j = 1 To 100
Answer = Answer + CLng(Mid(TEMP, j, 1))
Next j
End If
Next i

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

Function JSqrRoot(n As Long, NumDigits As Long, Optional Dec) As String
‘http://www.shef.ac.uk/~pm1afj/maths/jarvisspec02.pdf
‘Long Integer implementation only
‘Dec = True returns with decimal point

Dim strA As String, strB As String
Dim SAT As Boolean, i As Long, Num As Double

strA = CStr(5 * n)
strB = “5”
If IsMissing(Dec) Then Dec = True

Num = Sqr(n)
If Int(Num) = Num Then
JSqrRoot = CStr(Num)
Exit Function
End If

Do While Len(strB)  LT NumDigits
If Len(strA) GT Len(strB) then ‘a GT b
SAT = True
ElseIf Len(strA) LT Len(strB) Then ‘ b GT a
SAT = False
ElseIf strA GTE strB Then   ‘do string comparison for equal lengths
SAT = True
Else
SAT = False
End If

If SAT Then
strA = SubAsStrings(strA, strB)
strB = AddAsStrings(strB, “10”)
Else
strA = strA &amp; “00”
strB = Left(strB, Len(strB) – 1) &amp; “05”
End If
Loop

JSqrRoot = strB

If Dec Then
i = InStr(1, CStr(Num), “.”)
JSqrRoot = Left(JSqrRoot, i – 1) &amp; “.” &amp; Right(JSqrRoot, Len(JSqrRoot) – i + 1)
End If

End Function

Function SubAsStrings(ByVal Term1 As String, ByVal Term2 As String) As String
‘Uses “method of nines’-complement”
‘http://en.wikipedia.org/wiki/Method_of_complements
‘Term1 GT Term2 GT 0…ie. postive integers only

Dim Difference As String
Dim Complement As String
Dim Sum     As String
Dim c       As Long

If Len(Term1) GT Len(Term2) Then
Term2 = String(Len(Term1) – Len(Term2), “0”) &amp; Term2
End If

For c = 1 To Len(Term2)
Complement = Complement &amp; (9 – CLng(Mid(Term2, c, 1)))
Next c

Sum = AddAsStrings(Term1, Complement)
Sum = AddAsStrings(Sum, “1”)
Difference = Right(Sum, Len(Sum) – 1)

While Left(Difference, 1) = “0”
Difference = Right(Difference, Len(Difference) – 1)
Wend

SubAsStrings = Difference

End Function

The usual angle bracket adjustments have been made above. The AddAsStrings function has been put up before. Dr Jervis’ Japanese method requires you to independently place the decimal point in the square root. I made that optional, and set it to false to accomodate Euler’s way of counting.

…mrt

# Euler Problem 104

Euler Problem 104 asks:

The Fibonacci sequence is defined by the recurrence relation:

F(n) = F(n-1) + F(n-2), where F(1) = 1 and F(2) = 1.

It turns out that F(541), which contains 113 digits, is the first Fibonacci number for which the last nine digits are 1-9 pandigital (contain all the digits 1 to 9, but not necessarily in order). And F(2749), which contains 575 digits, is the first Fibonacci number for which the first nine digits are 1-9 pandigital.

Given that F(k) is the first Fibonacci number for which the first nine digits AND the last nine digits are 1-9 pandigital, find k.

The title really deserves an exclamation point. As discussed in Large Number Arithmetic I’ve been trying to solve this problem since before January. This problem breaks my little AddAsStrings function, and for reasons you’ll see, overflows Tushar’s LargeAdd function. We’re looking for a big number, longer in length then Excel can handle as a string. And I was stuck. Doug, in Large Number Arithmetic, showed how to keep track of the back end of a variable. How to keep track of the front end had me stumped until it came to me last Sunday morning when I woke up (any one else code in their sleep?): Separate variables. Use a long to track the backend and a double to track the front end. An immediate trouble with that is that doubles only work to E+308, and one of the test cases, Fib(2749) is E+575. Solution there was to knock the Fibonacci values down by 10^2 when ever they get over 10^9, and keep track of the exponent in a separate variable. Here is my code, with a helper function Ends() that tests the ends for “pan-digitality.” It’s a little faster than most I’ve seen, since it breaks as soon as there is a failure, rather that testing on, and I only test the left side when the right side is pandigital. The code runs in six-tenths of a second:

Sub Problem_104()
Dim i_lng As Long, j_lng As Long, k_lng As Long
Dim i_dbl As Double, j_dbl As Double, k_dbl As Double
Dim k_str   As String
Dim LeftSAT As Boolean
Dim RightSAT As Boolean
Dim Answer As Long, T As Single
Dim exp     As Long
Dim Fib_ans As String
Dim PlusMark As Long

T = Timer

i_lng = 1
j_lng = 1
i_dbl = 1
j_dbl = 1

Do

k_lng = i_lng + j_lng
k_str = Right(k_lng, 9)
i_lng = j_lng
j_lng = CLng(k_str)

k_dbl = i_dbl + j_dbl
i_dbl = j_dbl
j_dbl = k_dbl

If k_dbl GT 1000000000 Then ‘ knock it down by 10^2
i_dbl = i_dbl / 100
j_dbl = j_dbl / 100
exp = exp + 2 ‘ tracking the exponent
End If

LeftSAT = False
RightSAT = False
RightSAT = Ends(k_str)
If RightSAT Then
LeftSAT = Ends(CStr(k_dbl))
End If
Loop Until LeftSAT = True And RightSAT = True

Fib_ans = Format(k_dbl, “0.00000000000000E+”)
PlusMark = InStr(1, Fib_ans, “+”)
Fib_ans = Left(Fib_ans, PlusMark) &amp; (CLng(Right(Fib_ans, Len(Fib_ans) – PlusMark)) + exp)

Debug.Print Answer, Left(k_dbl, 9), k_str
Debug.Print “Fib(“ &amp; Answer &amp; “) = “; Fib_ans; ”  Time:”; Timer – T;

End Sub

Function Ends(k_str As String) As Boolean
Dim E       As Long
Dim E_str   As String
E_str = Left(k_str, 9)
For E = 1 To 9
If InStr(1, E_str, CStr(E)) Then
Ends = True
Else
Ends = False
Exit For
End If
Next E
End Function

Compared to the multi-precision answer given by the Foxes Team addin mentioned in Large Number Arithemtic, this answer drifts off in the 13 decimal place. The xnumbers add-in has been helpful. It did the Euler totient problems, for instance. It’s been a useful addition to the toolbox, and since any improvement has stopped, I’d recommend grabbing before it disappears.

…mrt

# Graphics I Grok

As a big-time college basketball junkie (Villanova ’96 grad schoolKerry Kittles et al), I thought the NY Times had two excellent NCAA basketball tourney graphics. No pie charts! I needed a tech assist from Dick to learn how to do this, so I’m not as timely as I should have been, and that probably cost you money…:-)

The first shows you how you should have picked…

and the second shows you where you should have picked…

to fill out your bracket.

This year it’s Louisville’s to lose. Go Big East!

…mrt

# Euler Problem 62

Euler Problem 62 asks:

The cube, 41063625 (345^3), can be permuted to produce two other cubes: 56623104 (384^3) and 66430125 (405^3). In fact, 41063625 is the smallest cube which has exactly three permutations of its digits which are also cube.

Find the smallest cube for which exactly five permutations of its digits are cube.

Having discovered how to find out if an item is in, or not in, a collection, I have been using collections more and more in the Euler problems. I do this in preference over an array, which requires a loop to find if you have membership, and presents size issues if you really don’t know how many elements you will have. Collections are open ended. All that said, in this problem, I used both. I used a collection of cubes with a key of the sorted string of item (i-cubed), and in the parallel array I kept a counter. Every time the sorted string came around again, indicating a permutation, I retrieved the first occurrence by using that key, and incremented the array counter (at item^(1/3)) associated with that first occurrence. In the end, I just looped through the array, looking for a count of 5. The cube of that index is the answer. I used two functions, IsIn() and SortString(), and guessed at the bounds for the cubes of interest as being between 1000 and 10000. I used currency to be able to hold (10^4)^3)).

Sub Problem_062()
Dim i       As Long
Dim Answer As Currency, T As Single
Dim Cubes   As New Collection
Dim Cube(1000 To 10000) As Long
Dim Item As Currency, Key As String

T = Timer
For i = 1000 To 10000 ‘ a guess
Key = SortString(CStr(i ^ 3), False)
If Not IsIn(Cubes, Key) Then ‘ add it
Item = i ^ 3
Cube(i) = 1 ‘ add counter
Else ‘ retrieve it
Item = Cubes.Item(Key)
Cube(Item ^ (1 / 3)) = Cube(Item ^ (1 / 3)) + 1 ‘ increment counter
End If
Next i

For i = 1000 To 10000
If Cube(i) = 5 Then
Answer = i ^ 3
Exit For
End If
Next i

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

Function IsIn(Col As Collection, Key As String) As Boolean
Dim errNum As Long, TEMP As Variant
errNum = 0
Err.Clear
On Error Resume Next
TEMP = Col.Item(Key)
errNum = CLng(Err.Number)
On Error GoTo 0
If errNum = 5 Then   ‘IsIn = False
Exit Function
End If
IsIn = True   ‘errNums 0 , 438
End Function

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

If IsMissing(Up) Then Up = True
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)

If Up Then ‘Ascending
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
Else ‘Descending
For i = LBound(str) To UBound(str) – 1
For j = i + 1 To UBound(str)
If str(i) &lt; str(j) Then
TEMP = str(j)
str(j) = str(i)
str(i) = TEMP
End If
Next j
Next i
End If

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

End Function

The code runs in under .6 seconds. There are the usual angle bracket substitutions above.

…mrt