# Euler Problem 119

Euler Problem 119 asks:

The number 512 is interesting because it is equal to the Base of its digits raised to some power: 5 + 1 + 2 = 8, and 83 = 512. Another example of a number with this property is 614656 = 284.

We shall define a(n) to be the nth term of this sequence and insist that a number must contain at least two digits to have a Base.

You are given that a(2) = 512 and a(10) = 614656.

Find a(30).

83 = 512 is the same as log8(512) = 3, and 284 = 614656 is the same as log28(614656) = 4. If we find numbers that have integral logs in a base equal to the sum of their digits then we have found elements of a(). We only need the first 30.

The VBA Log() function uses natural logs. For those with an engineering bent, it’s like the worksheet LN() function. To get Logs in a different base, the VBA help file reminds us that Logn(x) = Log(x) / Log(n). With the caution that if the n = 1, then log(n) = 0, and we have a division by zero to guard against.

Here is the code that does this:

Sub Problem_119()
Dim n As Variant
Dim TEMPlog As Single
Dim i As Long, Base As Long, a As Long
Dim T As Single

T = Timer
n = 10
Do
n = n + 1
Base = 0
For i = 1 To Len(n)
Base = Base + Val(Mid(n, i, 1))
Next i
If Base != 1 Then TEMPlog = Log(n) / Log(Base) ‘ protect against div0
If TEMPlog = Int(TEMPlog) Then
a = a + 1
Debug.Print a, n
End If
Loop Until a = 12

Debug.Print Timer – T

End Sub

Note that I stopped at a(12). That determination takes 20 seconds, and a(n) and a(n+1) are getting farther and farther apart. The method is sound, but the approach isn’t timely.

An alternative is to find lots of numbers to powers, and check to see if they have the requisite base. Doing it that way, the a(n) elements do not arrive in n order, and a sort will be required to pull out a(30). Since I don’t know how many there are in the span of numbers, we’ll add the proper results to a collection, and then sort the collection. (Dick has an article on sorting a collection here. I shamelessly ripped him off.) This is the new code. It runs in a 1/100th of a second..

Sub Problem_119A()
Dim n As Variant
Dim Sum As Double
Dim Base As Long
Dim Pwr As Long, i As Long, j As Long
Dim a As New Collection
Dim Item As Double, Key As String
Dim T As Single

T = Timer

For Base = 2 To 100
For Pwr = 2 To 10
n = Base ^ Pwr
Sum = 0
For i = 1 To Len(n)
Sum = Sum + Val(Mid(n, i, 1))
Next i
If Sum = Base Then ‘ an element of a()
Item = n
Key = CStr(Item)
End If
Next Pwr
Next Base

For i = 1 To a.Count – 1
For j = i + 1 To a.Count
If a(i) &gt; a(j) Then
Item = a(j)
Key = CStr(Item)
a.Remove j
a.Add Item:=Item, Key:=Key, Before:=i
End If
Next j
Next i

Debug.Print a(30); ”  Time:”; Timer – T

End Sub

The usual angle bracket substitutions are in the above. When you see the answer, you’ll see how bad that first approach really was. At least the answer fits in a variant without loss of precision.

Happy Labor Day!

…mrt

# Euler Problem 109

Euler Problem 109 asks:

In the game of darts a player throws three darts at a target board which is split into twenty equal sized sections numbered one to twenty.

The score of a dart is determined by the number of the region that the dart lands in. A dart landing outside the red/green outer ring scores zero. The black and cream regions inside this ring represent single Darts. However, the red/green outer ring and middle ring score double and treble scores respectively.

At the centre of the board are two concentric circles called the bull region, or bulls-eye. The outer bull is worth 25 points and the inner bull is a double, worth 50 points.

There are many variations of rules but in the most popular game the players will begin with a score 301 or 501 and the first player to reduce their running total to zero is a winner. However, it is normal to play a “doubles out” system, which means that the player must land a double (including the double bulls-eye at the centre of the board) on their final dart to win; any other dart that would reduce their running total to one or lower means the score for that set of three darts is “bust”.

When a player is able to finish on their current score it is called a “checkout” and the highest checkout is 170: T20 T20 D25 (two treble 20s and double bull).

There are exactly eleven distinct ways to checkout on a score of 6:

D3
D1 D2
S2 D2
D2 D1
S4 D1
S1 S1 D2
S1 T1 D1
S1 S3 D1
D1 D1 D1
D1 S2 D1
S2 S2 D1

Note that D1 D2 is considered different to D2 D1 as they finish on different doubles. However, the combination S1 T1 D1 is considered the same as T1 S1 D1.

In addition we shall not include misses in considering combinations; for example, D3 is the same as 0 D3 and 0 0 D3.

Incredibly there are 42336 distinct ways of checking out in total.

How many distinct ways can a player checkout with a score less than 100?

If you’ve never “done darts,” this is the hard way to learn the rules. I did darts often in a Scot pub (I was “pretty good for a Yank”damning with faint praise) so I had a good understanding of the game. A dart board has 20 spokes, worth from 1 to 20 points, an inner hub worth 50 points (the bull’s eye), an outer hub worth 25 points, a midway ring worth triple the spoke score, and an outer rim worth double the spoke score. Very good players countdown from 501, but the pub matches started down from 301. To win, your last dart had to land in the double ring and take you exactly to zero. Too high a value, or a reduction to one, and your turn was wasted.

A good picture of a dart board and the 3-dart “double-outs” is here.

The one tricky thing about this problem was the requirement that “S1 T1 D1 is considered the same as T1 S1 D1.” I couldn’t figure out how to handle that until I decided to not let it happen at all. This is why the middle loop of the 3-dart solutions starts at the same counter as the outer loop.

Here is the code that does the counting. It runs in a blink:

Sub Problem_109()
Dim DartScore(1 To 62) As Long, i As Long
Dim Dart_1 As Long
Dim Dart_2 As Long
Dim Dart_Last As Long
Dim Answer As Long, T As Single
Dim SetScore As Long

T = Timer

For i = 1 To 20
DartScore(i) = i   ‘ Singles
DartScore(i + 21) = i * 2   ‘ Doubles
DartScore(i + 42) = i * 3   ‘ Trebels
Next i
DartScore(21) = 25   ‘ Single Bull
DartScore(42) = 50   ‘ Double Bull

‘One-dart set
Answer = 21   ’21 ways to double out with one dart

‘Two-dart set
For Dart_1 = 1 To 62   ‘ 1st Dart – All possible scores
For Dart_Last = 22 To 42   ‘ 2nd Dart – doubles out
SetScore = DartScore(Dart_1) + DartScore(Dart_Last)
If SetScore &lt; 100 Then
Answer = Answer + 1   ‘ Doubled out
Else
Exit For
End If
Next Dart_Last
Next Dart_1

‘Three-dart set
For Dart_1 = 1 To 62   ‘ 1st Dart – All possible scores
For Dart_2 = Dart_1 To 62   ‘ 2nd Dart – All possible scores
For Dart_Last = 22 To 42   ‘ Last Dart – Doubles out
SetScore = DartScore(Dart_1) + DartScore(Dart_2) + DartScore(Dart_Last)
If SetScore < 100 Then
Answer = Answer + 1   ‘ Doubled out
Else
Exit For
End If
Next Dart_Last
Next Dart_2
Next Dart_1

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

End Sub

The reason you “go bust” on one is because you can’t double out from there. The usual angle bracket substitutions are in the above.

…mrt

# Euler Problem 205

Euler Problem 205 asks:

Peter has nine four-sided (pyramidal) dice, each with faces numbered 1, 2, 3, 4. Colin has six six-sided (cubic) dice, each with faces numbered 1, 2, 3, 4, 5, 6.

Peter and Colin roll their dice and compare totals: the highest total wins. The result is a draw if the totals are equal.

What is the probability that Pyramidal Pete beats Cubic Colin? Give your answer rounded to seven decimal places in the form 0.abcdefg

As a quick review, if we roll 2 of Colin’s dice, we expect 62 different outcomes. Rolling 6 dice will have 66 outcomes, or 46,656 different rolls.

Peter has 49 different outcomes, or 262,144 different rolls. Peter’s least roll (nine 1’s) will best the one way Colin can roll a 6 (six 1’s), the six ways he can roll a 7 (five 1’s and a 2 six times) and the twenty-one ways he can roll an 8 (a 3 and five 1’s six times, or two 2’s and four 1’s fifteen times). Peter’s meager 9 wins over 28 of Colin’s possible rolls. Peter’s 10, which he can roll 9 ways, bests 84 of Colin’s rolls.

VBA does not have a CEILING function, and I needed one for this problem. We could use Application.Worksheetfunction.Ceiling, but there is a quicker way execution-wise by a factor of 5. The INT function always rounds down. When the argument to INT is negative, INT rounds down or away from zero. INT(-3.14159) is -4, and -INT(-3.14159) is 4, rounding pi() up! Very useful when you need more area in your circles. It works this way in both the VBA and the spreadsheet implementations.

Easier than developing the usage for Problem 205, I’ll show it and explain how it works. The code we want to use for Colin is “-INT(-N/6^C) Mod 6” for C from zero to five, where N is the number of the roll (1 to 66), and when Mod 6 = zero, substitute 6. In a spreadsheet, this would be =IF(MOD(-INT(-N/6^C),6), MOD(-INT(-N/6^C),6), 6)

Remembering that 60 is 1, and 61 is 6, this is how the first four of Colin’s dice (C=0,1,2,3) look on Roll 66, N = 66, -N = -66.

1. C = 0, Die 1:
• INT(-66/6^0) = INT(-66/1) = -66
• 66 = 66
• 66 Mod 6 = 0, Return 6
2. C = 1, Die 2:
• INT(-66/6^1) = INT(-66/6) = -11
• 11 = 11
• 11 Mod 6 = 5, Return 5
3. C = 2, Die 3:
• INT(-66/6^2) = INT(-66/36) = INT(-1.83333) = -2
• 2 = 2
• 2 Mod 6 = 2, Return 2
4. C = 3, Die 4:
• INT(-66/6^3) = INT(-66/216) = INT(-0.30555) = -1
• 1 = 1
• 1 Mod 6 = 1, Return 1

Dice 5 and 6 (with C of 4 and 5) also return 1. Colin’s 66th roll is {6,5,2,1,1,1}. We do the same thing for Peter, where the code is “-INT(-N/4^P) Mod 4” for P from zero to eight, returning 4 when Mod 4 is zero. Peter’s 66th roll is {2,1,1,2,1,1,1,1,1}, summing 11. Peter gets 11 forty-five ways, on which he beats the 210 of Colin’s rolls (but not Colin’s #66) that sum 10 or below.

If we aggregate the number of times Colin sums from 6 to 36 in his 46,656 possible rolls, and the number of times Peter gets a particular sum from 9 to 36 in his 262,144 different rolls, we can then loop through Peter’s aggregation and see how many of Colin’s rolls lose to that number. If we then multiply that discovery by the number of ways Peter achives that aggregation, keep a grand sum of winners, and then divide by the product of (66)*(49),we will have our percentage of Peter’s winning. Format the answer to 7 decimals to the right. Format() will take care of the necessary rounding.

This is the code that does this. It runs in about 6ths of a second.

Sub Problem_205()
Dim N As Long, TEMP As Long, Sum As Long
Dim Answer As Double, T As Single, Count As Double
Dim PP(1 To 36) As Long, P As Long  ‘Pyramidal Pete
Dim CC(1 To 36) As Long, C As Long ‘Cubic Colin
Dim LosersToPete As Long

T = Timer

For N = 1 To 6 ^ 6 ‘Cubic Colin
Sum = 0
For C = 0 To 5
TEMP = -Int(-N / 6 ^ C) Mod 6
If TEMP = 0 Then TEMP = 6
Sum = Sum + TEMP
Next C
CC(Sum) = CC(Sum) + 1  ‘Incrementing Colin’s ways this value can happen
Next N

For N = 1 To 4 ^ 9 ‘Pyramidal Pete
Sum = 0
For P = 0 To 8
TEMP = -Int(-N / 4 ^ P) Mod 4
If TEMP = 0 Then TEMP = 4
Sum = Sum + TEMP
Next P
PP(Sum) = PP(Sum) + 1 ‘Incrementing Pete’s ways this value can happen
Next N

For P = 9 To 36 ‘ Pete’s rolls
LosersToPete = 0
For C = 6 To P – 1
LosersToPete = LosersToPete + CC(C) ‘ Num Colin’s rolls (all losses) below Pete’s roll
Next C
Count = Count + (LosersToPete * PP(P))
‘Incrementing the winning Count by the # of ways Colin’s roll can lose to Pete
Next P

Answer = Count / (CDbl(4 ^ 9) * CDbl(6 ^ 6))

Debug.Print Format(Answer, “0.0000000”);”  Time:”; Timer – T; Count
End Sub

If, instead of -INT, I use Application.Worksheetfunction.Ceiling as:

• TEMP = Application.WorksheetFunction.Ceiling(N / 6 ^ C, 1) Mod 6 and
• TEMP = Application.WorksheetFunction.Ceiling(N / 4 ^ P, 1) Mod 4

the runtime is 3.5 seconds! Using ROUNDUP() is even slower. The really wrong way to do this problem is to match each of Peter’s rolls with each of Colin’s, or something like this, where larger PP() and CC() now hold each roll and not the occurrances of each sum.

For P = 1 to 4^9
For C = 1 to 6^6
If PP(P) &gt; CC(C) then Count = Count + 1
Next C
Next P

That’s 12,230,590,464 loops. Been there, did that. Takes 6 and a half minutes. No tee shirt.

…mrt

# Euler Problem 76

Euler Problem 76 asks:

It is possible to write five as a sum in exactly six different ways:

4 + 1
3 + 2
3 + 1 + 1
2 + 2 + 1
2 + 1 + 1 + 1
1 + 1 + 1 + 1 + 1

How many different ways can one hundred be written as a sum of at least two positive integers?

This is a Euler Partition problem, one of at least 4 in the problem set (Nos. 31, 77, and 78 are also.) I didn’t now that when I solved #31. I came across Euler partitions as a hint to solving problem #76.

Two things I’ve learned about Project Euler:

1. If Leonhard Euler was involved with it, Project Euler is involved with it, and
2. There’s probably a PhD in a mathematics department somewhere that has a monograph on the topic

Problem 76 is right out of that playbook. The paper Playing with Partitions on the Computer from the mathematics server of Temple University is exactly on point. In fact, if you catch the hint in the document, the answer is right there in the back. No computer required. The authors provide a Section 4, A Basic Program to Generate Partitions.

This is my VBA translation of the authors’ algorithms. The number of partitions for zero, P(0), is defined as 1, there being only one way to take zero, and the number of partitions for any negative number is zero, so when the indexing reaches for a negative partition, we can stop the loop. The partitions for later numbers grow from the partitions of earlier numbers by pentagonal numbers (as F below). That’s what Euler discovered. It’s covered in the reference.

The code names that tune in “zero” notes, err seconds, per the timer.

Sub Problem_076()

Dim P(0 To 100) As Long
Dim N As Long
Dim K As Long, F As Long
Dim Sign As Long
Dim Answer As Long, T As Single

T = Timer

P(0) = 1 ‘ defined
For N = 1 To 100
Sign = 1
P(N) = 0
For K = 1 To 100
F = K * (3 * K – 1) / 2
If F &gt; N Then Exit For ‘ P(N-F) = 0
P(N) = P(N) + Sign * P(N – F)
F = K * (3 * K + 1) / 2
If F &gt; N Then Exit For ‘ P(N-F) = 0
P(N) = P(N) + Sign * P(N – F)
Sign = -Sign
Next K
Next N

Answer = P(100) – 1

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

The usual angle brackets substitutions are in the above. This code, slightly modified, will directly solve #78. You’ll need to make the partition reachback (K) bigger, and look for a different kind of endpoint. The number of partitions corresponding to the answer of #78 is a 257 digit number.

Euler partitions occasionally make the news. They’ll explain them better than I can, for sure.

Now, what I can’t figure out is what to change when the increments are prime numbers (as in #77), rather than unitary. I’d think it should be N, or the Loop step, but I haven’t got it yet.

…mrt

# Euler Problem 124

Euler Problem 124 asks:

The radical of n, rad(n), is the product of distinct prime factors of n. For example, 504 = 23× 32 × 7, so rad(504) = 2 × 3 × 7 = 42.

If we calculate rad(n) for 1 <= n <= 10, then sort them on rad(n), and sorting on n if the radical values are equal, we get:

Let E(k) be the kth element in the sorted n column; for example, E(4) = 8 and E(6) = 9.

If rad(n) is sorted for 1 <= n <= 100000, find E(10000).

This is my 100th solution. Harumpf. All that, and I am yet but a Euler novice!

Here is the code that does it.

Sub Problem_124()
Dim E(1 To 100000, 1 To 2) As Long, Line As String
Dim TEMP(1 To 1, 1 To 2) As Long, i As Long, j As Long

Dim LBnd As Long, UBnd As Long
Dim Answer As Long, T As Single

T = Timer

i = 1
Open Text For Input As #1
Do While Not EOF(1)
Line Input #1, Line
j = InStr(1, Line, Chr(32)) ‘ space delimited
E(i, 1) = CLng(Left(Line, j – 1))
E(i, 2) = CLng(Right(Line, Len(Line) – j))
i = i + 1
Loop
Close #1

SortV SortRange:=E, SortBy:=2 ‘ Doug Jenkins’ function

i = 0
Do
i = i + 1 ‘ find the start of region of interest
Loop Until E(i, 2) = E(10000, 2)
LBnd = i ‘  lower bound

Do
i = i + 1 ‘ find the end of region of interest
Loop Until E(i, 2)  != E(10000, 2)
UBnd = i – 1 ‘ upper bound 1 earlier

For i = LBnd To UBnd – 1 ‘ Bubble sort
For j = i + 1 To UBnd
If E(i, 1) &gt; E(j, 1) Then
TEMP(1, 1) = E(j, 1)
E(j, 1) = E(i, 1)
E(i, 1) = TEMP(1, 1)
End If
Next j
Next i
Answer = E(10000, 1)

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

End Sub

E(10000,2) turns out to be a pretty good year…one year after I was born. The usual angle bracket adjustments are used above.

I didn’t want to “cheat” quite that way. What I wanted to do was write code that went out on the web and pulled in the results. I’m row-challenged at 65536, and a Web-query seems to demand a range, not an array. I also couldn’t noodle out how to get past the row limit. I thought Excel might do the query via the clipboard (it does!) but even the clipboard object was truncated at 65,536 lines. I couldn’t come up with a way to populate 100,000×2 elements of an array via the internet, even though VBA doesn’t care. Is there one?

…mrt

# Euler Problem 112

Euler Problem 112 asks:

Working from left-to-right if no digit is exceeded by the digit to its left it is called an increasing number; for example, 134468.

Similarly if no digit is exceeded by the digit to its right it is called a decreasing number; for example, 66420.

We shall call a positive integer that is neither increasing nor decreasing a “bouncy” number; for example, 155349.

Clearly there cannot be any bouncy numbers below one-hundred, but just over half of the numbers below one-thousand (525) are bouncy. In fact, the least number for which the proportion of bouncy numbers first reaches 50% is 538.

Surprisingly, bouncy numbers become more and more common and by the time we reach 21780 the proportion of bouncy numbers is equal to 90%.

Find the least number for which the proportion of bouncy numbers is exactly 99%.

Looking at the three examples, adjacent digits can be equal and not disqualifying in any of the cases. This means that a number such as 222222 is both increasing and decreasing. Semantically, while this is nonsense, it’s clear that 222222 cannot be bouncy. Using this observation does give us a way of breaking out of a loop without having to check every digit. If the count of the increasing digits (I) equals the counter, or the count of decreasing digits (D) equals the counter, than the number cannot be bouncy. Similarly, if they are ever both less than the counter, the number must be bouncy, and break the loop.

We’ll start with the Answer as 21780, bouncy number B as 0.9*Answer and keep going until B/Answer is 0.99.

Here is the code that does that. It runs in 3.5 seconds on my new hot rod, a 3Ghz dual core tech refresh. My fastest machine is now the office PC.

Sub Problem_112()
Dim Num As String, j As Long
Dim I As Long, D As Long, B As Long
Dim Answer As Long, T As Single

T = Timer

B = 0.9 * Answer

Do
I = 0
D = 0
For j = 1 To Len(Num) – 1
If Mid(Num, j, 1) LTE Mid(Num, j + 1, 1) Then   ‘Increasing
I = I + 1
End If
If Mid(Num, j, 1) GTE Mid(Num, j + 1, 1) Then   ‘Decreasing
D = D + 1
End If
If I != j And D != j Then Exit For
Next j
If I LT Len(Num) – 1 And D LT Len(Num) – 1 Then   ‘Bouncy
B = B + 1
End If
Loop Until (B / Answer) = 0.99

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

End Sub

The usual angle bracket substitutions are in the above. This is me solving a number problem by strings once again. There must be a better insight. Problem 113 wants the number of non-bouncy numbers below a Googol (10100). Going this way, working with strings, my hot rod might be calculating for a week.

…mrt (thinking Googol looks funny spelled that way)

# Euler Problem 83

Euler Problem 83 asks:

NOTE: This problem is a significantly more challenging version of Problem 81.

In the 5 by 5 matrix below, the minimal path sum from the top left to the bottom right, by moving left, right, up, and down, is indicated in red and is equal to 2297.

Find the minimal path sum, in matrix.txt (right click and ‘Save Link/Target As…’), a 31K text file containing a 80 by 80 matrix, from the top left to the bottom right by moving left, right, up, and down.

In the Problem 123 thread Doug Jenkins provided a spreadsheet solution for Problem 83, as well as suggesting an alternate method to solve the problem by padding the matrix. He thereby relieved a huge mental block of mine, but it’s in the wrong thread. So I started this one.

Padding the matrix has its advantage. It allows you to use a common relationship in the area of interest without having to worry about variable subscripts being out of range because you’d otherwise reference a row or column that you haven’t dimensioned (akin to trying to reference Row(0) on a spreadsheet.) There’s some overhead to do this, but it saves special cases at the corners and borders. Doug recommended using 1000000, and that’s as good a choice as any. With that in mind, the above matrix comes to look like this:

Since a picture = 1 kiloword, you can see how we have slop all the way around for subscripts, with the added advantage that if you make the matrix zero-based, the action starts at Row(1), Column(1). My mind likes it better that way. I used this same padding trick for Problem 67, where you can turn a triangle into a square. It really simplifies the code. With all that for background, here is my code that turns Doug’s spreadsheet solution into VBA. It runs in about 3/10’s of a second.

Sub Problem_083()
Dim Matrix(0 To 81) As Variant
Dim Cell(0 To 81, 0 To 81) As Long
Dim R As Long, C As Long
Dim Min     As Long
Dim Answer As Long, T As Single
Dim TEMP1 As Long, TEMP2 As Long
Dim NumRows As Long, NumCols As Long
Dim IsTest As Boolean, i As Long

T = Timer

R = 1
Open text For Input As #1   ’80 lines, comma delimited
Do While Not EOF(1)
Line Input #1, Matrix(R)   ‘fills rows 1 to 80; 0 and 81 come later
R = R + 1
Loop
Close #1

IsTest = False
If IsTest Then
NumRows = 6
NumCols = 6
Matrix(1) = “131,673,234,103,18”
Matrix(2) = “201,96,342,965,150”
Matrix(3) = “630,803,746,422,111”
Matrix(4) = “537,699,497,121,956”
Matrix(5) = “805,732,524,37,331”
Else
NumRows = 81
NumCols = 81
End If

For C = 1 To NumCols – 1
Matrix(0) = Matrix(0) &amp; “1000000 “
‘adds top padding @(0), sets up TRIM()
Next C
Matrix(0) = Replace(Trim(Matrix(0)), ” “, “,”)   ‘makes it comma-delimited
Matrix(NumRows) = Matrix(0)   ‘ adds bottom padding @(NumRows)

For R = 0 To NumRows
Matrix(R) = “1000000,” &amp; Matrix(R) &amp; “,1000000”
‘ pads all rows left and right
Matrix(R) = Split(Matrix(R), “,”)
‘makes a zero-based NumRows X NumCols matrix
Next R

For R = 0 To NumRows
For C = 0 To NumCols
Cell(R, C) = CLng(Matrix(R)(C))
If C GT 0 Then Cell(R, C) = Cell(R, C) + Cell(R, C – 1)
‘ seeds the Cell array
Next C
Next R

Do
TEMP1 = Cell(NumRows – 1, NumCols – 1)
‘start value of unpadded LR corner
i = i + 1   ‘counts iterations
For R = 1 To NumRows – 1   ‘inside the padding
For C = 1 To NumCols – 1   ‘inside the padding
If R = 1 And C = 1 Then   ‘reset Cell(1,1) from above
Cell(R, C) = CLng(Matrix(R)(C))
Else   ‘do the hard work
Min = Application.WorksheetFunction.Min(Cell(R + 1, C), Cell(R – 1, C), _
Cell(R, C + 1), Cell(R, C – 1))
Cell(R, C) = CLng(Matrix(R)(C)) + Min
End If
Next C
Next R
TEMP2 = Cell(NumRows – 1, NumCols – 1)
‘finish value of unpadded LR corner
If i GT NumRows * NumCols Then Exit Do   ‘escape clause
Loop Until TEMP1 = TEMP2   ‘stable when start = finish

Answer = Cell(NumRows – 1, NumCols – 1)

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

End Sub

Doug mentions seeding the Cell array. This makes a huge difference. It goes through the Do-Loop only 5 times. The answer is known after 4 loops, but it takes 5 for the starting TEMP1 to know it. I couldn’t figure out how to avoid that without apriori knowledge of the Answer, which is in the bottom right cell before the padding.

Playing with the spreadsheet solution, I made a third matrix of the array by “pasting special” a copy when all is stable. Then with conditional formatting comparing the two, I could see how the data flows and settles as I stepped through it. It starts from the upper left in kind of a maple-leaf pattern: Strong down the middle, with a spike above and below, and then a weak spike down the left side and the top edge. It takes 11 reps for everything to stabilize.

So, all in all, this is my VBA for Doug’s concept. Stephen B and Josh G have other approaches, and hopefully, they’ll share. This code is the combination of two half-good ideas I had. Maybe Doug will chime in, too. He’s the one who gave me the clue about the whole approach.

The usual angle bracket corrections are in the code. It’s interesting that it’s Cell(R,C) but Matrix (R)(C) for the syntax.

…mrt

# Euler Problem 81

Euler Problem 81 asks:

In the 5 by 5 matrix below, the minimal path Min from the top left to the bottom right,
by only moving to the right and down, is indicated in red and is equal to 2427.

Find the minimal path Min, in matrix.txt (right click and ‘Save Link/Target As…’),
a 31K text file containing a 80 by 80 matrix, from the top left to the bottom right
by only moving right and down.

This is very similar to problems 18 and 67, except that they ask for the maximum path to the bottom, not the minimum path to the lower right corner. #81 can absolutely be done in a spreadsheet, as Tushar shows here for numbers 18 and 67. I like to solve them in VBA. The difference between this problem and #67 is that we have to get to a specific matrix cell, and by the rules, if we end up at the right edge, we can only go down, and if we end up at the bottom, we can only go right. In other words, on the right, progressively sum upwards from the lower right corner, and on the bottom, progressively sum leftwards from that same corner. The goal is to abstract the problem so the choice at matrix cell(0)(0) is the minimum of all paths to cell(0)(0). The answer will be the sum of cell(0)(0) and that minimum. Here is my code that does this. It runs in a blink (less that a tenth of a second.)

Sub Problem_081()
Dim Cell(0 To 79) As Variant
Dim R As Long, C As Long
Dim NumRows As Long, NumCols As Long
Dim Min As Long, IsTest As Boolean
Dim Answer As Long, T As Single

T = Timer

R = 0
Open text For Input As #1   ’80 lines, comma delimited
Do While Not EOF(1)
Line Input #1, Cell(R)
R = R + 1
Loop
Close #1

IsTest = False
If IsTest Then
NumRows = 4
NumCols = 4
Cell(0) = “131,673,234,103,18”
Cell(1) = “201,96,342,965,150”
Cell(2) = “630,803,746,422,111”
Cell(3) = “537,699,497,121,956”
Cell(4) = “805,732,524,37,331”
Else
NumRows = 79
NumCols = 79
End If

For R = 0 To NumRows
Cell(R) = Split(Cell(R), “,”) ‘ making a NumRows X NumCols matrix
Next R

For C = NumCols – 1 To 0 Step -1 ‘rolling up right and bottom edges
R = C
Cell(NumRows)(C) = CLng(Cell(NumRows)(C)) + CLng(Cell(NumRows)(C + 1))
Cell(R)(NumCols) = CLng(Cell(R)(NumCols)) + CLng(Cell(R + 1)(NumCols))
Next C

For R = NumRows – 1 To 0 Step -1 ‘rolling up the minimums
For C = NumCols – 1 To 0 Step -1
Min = Application.WorksheetFunction.Min(CLng(Cell(R + 1)(C)), CLng(Cell(R)(C + 1)))
Cell(R)(C) = CLng(Cell(R)(C)) + Min
Next C
Next R

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

End Sub

Having done #67, this was very straight forward. Problem #83, which uses the same matrix, is similar but harder. It’s having its way with me. Here is #83:

NOTE: This problem is a significantly more challenging version of Problem 81.

In the 5 by 5 matrix below, the minimal path sum from the top left to the bottom right, by moving left, right, up, and down, is indicated in red and is equal to 2297.

Find the minimal path sum, in matrix.txt (right click and ‘Save Link/Target As…’), a 31K text file containing a 80 by 80 matrix, from the top left to the bottom right by moving left, right, up, and down.

Note the NOTE, the rules change, and the snaking path. It takes 12 moves, whereas #81 only takes 8. The minimum on the left depends on the minimum on the right. As Doug J has said, ’tis circular, and I’ve not grasped it yet. The various code I’ve written does the example, but either takes more than 6400 moves (visiting every cell several times) or ends up in an endless loop in the lower right corner of matrix.txt.

…mrt