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.

12345 <font color="red">131</font> 673 <font color="red">234 103 18</font><font color="red">201 96 342</font> 965 <font color="red">150</font>630 803 746 <font color="red">422 111</font>537 699 497 <font color="red">121</font> 956805 732 524 <font color="red">37 331</font>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:

1 2 3 4 5 6 7 |
1000000 1000000 1000000 1000000 1000000 1000000 1000000 1000000 131 673 234 103 18 1000000 1000000 201 96 342 965 150 1000000 1000000 630 803 746 422 111 1000000 1000000 537 699 497 121 956 1000000 1000000 805 732 524 37 331 1000000 1000000 1000000 1000000 1000000 1000000 1000000 1000000 |

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.

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

Const text As String = “D:DownloadsEulermatrix.txt”

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) & “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,” & Matrix(R) & “,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

That’s an interesting approach. I had to print out the matrix at each step to understand what was going on, but now I get it. As I had mentioned, I used Dijkstra’s algorithm which was new to me at the time. I’m not sure that my feeble attempt to explain it was adequate, but Wikipedia has a pretty good explanation. Each point in the matrix is a node (think road intersection) and the numeric values are the cost to get to each node (think distance along that road). Also new to me was a priority queue for keeping track of which node currently had the lowest cost, which I implemented with a binary heap.

I try not to use global variables much for the PE problems since I have one massive workbook with my solutions to all problems, but for whatever reason I used several here. Array:Matrix holds the original values from the text file, Array:NodeValues holds the current lowest cost to reach each node, Array:VisitedNodes keeps track of which nodes have been visited, Array:HeapPositions keeps track, for each node, of its position in the heap. Here’s the code, and I hope I made all of the bracket corrections correctly.

Public Matrix() As Integer

Public NodeValues() As Long, VisitedNodes() As Boolean, HeapPositions() As Long

Sub Euler83()

Dim a As Integer, b As Integer, C As Long, StartTime As Single

Dim FileNameToOpen As String, TextString As String, MatrixRow() As String

Dim BinHeap() As Long, HeapLen As Long ‘BinHeap keeps track of the row / column positions

‘ Corresponding values are stored in NodeValues

‘Starts out as a 6400×2 array

‘ Column 1 corresponds to the matrix row

‘ Column 2 corresponds to the matrix column

StartTime = Timer

ReDim NodeValues(1 To MatrixSize, 1 To MatrixSize) ‘sum of the distance to reach this point

ReDim VisitedNodes(1 To MatrixSize, 1 To MatrixSize)

ReDim Matrix(1 To MatrixSize, 1 To MatrixSize)

‘read in the file

FileNameToOpen = ThisWorkbook.Path & “matrix.txt”

If FileNameToOpen = vbNullString Then ’empty

Exit Sub

End If

Open FileNameToOpen For Input Access Read As #1

a = 0

Do While Not EOF(1)

a = a + 1

Line Input #1, TextString

MatrixRow = Split(TextString, “,”)

For b = 1 To MatrixSize

Matrix(a, b) = MatrixRow(b – 1)

Next b

Loop

Close #1

‘reset matrices

For a = 1 To MatrixSize

For b = 1 To MatrixSize

NodeValues(a, b) = 1000000 ‘more or less infinity

VisitedNodes(a, b) = False

Next b

Next a

NodeValues(1, 1) = Matrix(1, 1)

‘set up the heap

HeapLen = MatrixSize * MatrixSize – 1

ReDim BinHeap(0 To HeapLen, 0 To 1) ‘first dimension is row, second is column

ReDim HeapPositions(1 To MatrixSize, 1 To MatrixSize) ‘where each node is located in the heap

‘set up the heap with the upper-left element first

C = 0

For a = 1 To MatrixSize

For b = 1 To MatrixSize

HeapPositions(a, b) = C

BinHeap(C, 0) = a

BinHeap(C, 1) = b

C = C + 1

Next b

Next a

‘find the unvisited node with the lowest cost – in the case of the binary heap it’s the first element

‘the first element is at position zero

Do Until BinHeap(0, 0) = MatrixSize And BinHeap(0, 1) = MatrixSize ‘exit when you’re at the goal node

Call UpdateNode83(BinHeap(0, 0), BinHeap(0, 1), 0, 1, BinHeap, HeapLen) ‘move to the right

Call UpdateNode83(BinHeap(0, 0), BinHeap(0, 1), 0, -1, BinHeap, HeapLen) ‘move to the left

Call UpdateNode83(BinHeap(0, 0), BinHeap(0, 1), -1, 0, BinHeap, HeapLen) ‘move up

Call UpdateNode83(BinHeap(0, 0), BinHeap(0, 1), 1, 0, BinHeap, HeapLen) ‘move down

VisitedNodes(BinHeap(0, 0), BinHeap(0, 1)) = True ‘mark node as visited

‘move the last element to the top of the heap

BinHeap(0, 0) = BinHeap(HeapLen, 0)

BinHeap(0, 1) = BinHeap(HeapLen, 1)

HeapPositions(BinHeap(0, 0), BinHeap(0, 1)) = 0

HeapLen = HeapLen – 1

‘move the element down as necessary

Call PercolateDown(0, BinHeap, HeapLen)

Loop

Debug.Print NodeValues(MatrixSize, MatrixSize), Timer – StartTime

End Sub

Sub UpdateNode83(CurRow As Long, CurCol As Long, RowOffset As Long, ColOffset As Long, BinHeap() As Long, _

HeapLen As Long)

‘Checks the updated cost of each neighbor and updates as necessary

Dim NewRow As Long, NewCol As Long

On Error GoTo ErrorTime

NewRow = CurRow + RowOffset

NewCol = CurCol + ColOffset

If VisitedNodes(NewRow, NewCol) = False Then ‘have not visited that node

On Error GoTo 0 ‘disable error handling since the only error I want to trap is if you’re off the edge

‘check the cost

If NodeValues(CurRow, CurCol) + Matrix(NewRow, NewCol) LT NodeValues(NewRow, NewCol) Then

‘new cost is less thn current cost

NodeValues(NewRow, NewCol) = NodeValues(CurRow, CurCol) + Matrix(NewRow, NewCol) ‘update cost

Call PercolateUp(HeapPositions(NewRow, NewCol), BinHeap, HeapLen) ‘update the heap

End If

End If

Exit Sub

ErrorTime:

If Err.Number = 9 Then ‘subscript out of range – off the edge of the matrix

Exit Sub

Else

MsgBox Err & Chr(13) & Error(Err)

End If

End Sub

Sub PercolateUp(HeapPos As Long, BinHeap() As Long, HeapLen As Long)

‘Element a(i) has children a(2i+1) and a(2i+2) and parent a(floor((i-1)/2))

Dim ParentPos As Long

Dim TempRow As Long, TempCol As Long, TempHeapPos As Long

ParentPos = Int((HeapPos – 1) / 2) ‘these are the positions in the BinHeap array

‘see if the child is smaller than the parent

If NodeValues(BinHeap(HeapPos, 0), BinHeap(HeapPos, 1)) LT _

NodeValues(BinHeap(ParentPos, 0), BinHeap(ParentPos, 1)) Then

‘swap values

TempRow = BinHeap(HeapPos, 0)

TempCol = BinHeap(HeapPos, 1)

TempHeapPos = HeapPositions(BinHeap(HeapPos, 0), BinHeap(HeapPos, 1))

BinHeap(HeapPos, 0) = BinHeap(ParentPos, 0)

BinHeap(HeapPos, 1) = BinHeap(ParentPos, 1)

HeapPositions(TempRow, TempCol) = HeapPositions(BinHeap(ParentPos, 0), BinHeap(ParentPos, 1))

HeapPositions(BinHeap(ParentPos, 0), BinHeap(ParentPos, 1)) = TempHeapPos

BinHeap(ParentPos, 0) = TempRow

BinHeap(ParentPos, 1) = TempCol

‘if you’re not at the top of the tree, recurse

If ParentPos != 0 Then

Call PercolateUp(ParentPos, BinHeap, HeapLen)

End If

End If

End Sub

Sub PercolateDown(HeapPos As Long, BinHeap() As Long, HeapLen As Long)

‘Element a(i) has children a(2i+1) and a(2i+2) and parent a(floor((i-1)/2))

Dim ChildPos As Long, a As Long

Dim TempRow As Long, TempCol As Long, TempHeapPos As Long

If 2 * HeapPos + 2 GT HeapLen Then Exit Sub ‘no children to check

If 2 * HeapPos + 1 = HeapLen Then ‘only one child

a = 1

Else

‘find the smaller child

If NodeValues(BinHeap(2 * HeapPos + 1, 0), BinHeap(2 * HeapPos + 1, 1)) LT _

NodeValues(BinHeap(2 * HeapPos + 2, 0), BinHeap(2 * HeapPos + 2, 1)) Then

a = 1

Else

a = 2

End If

ChildPos = 2 * HeapPos + a

End If

‘see if the child is smaller than the parent

If NodeValues(BinHeap(HeapPos, 0), BinHeap(HeapPos, 1)) GT _

NodeValues(BinHeap(ChildPos, 0), BinHeap(ChildPos, 1)) Then

‘swap values

TempRow = BinHeap(HeapPos, 0)

TempCol = BinHeap(HeapPos, 1)

TempHeapPos = HeapPositions(BinHeap(HeapPos, 0), BinHeap(HeapPos, 1))

BinHeap(HeapPos, 0) = BinHeap(ChildPos, 0)

BinHeap(HeapPos, 1) = BinHeap(ChildPos, 1)

HeapPositions(TempRow, TempCol) = HeapPositions(BinHeap(ChildPos, 0), BinHeap(ChildPos, 1))

HeapPositions(BinHeap(ChildPos, 0), BinHeap(ChildPos, 1)) = TempHeapPos

BinHeap(ChildPos, 0) = TempRow

BinHeap(ChildPos, 1) = TempCol

Call PercolateDown(ChildPos, BinHeap, HeapLen)

End If

End Sub

The chief advantage of this method is that each node is checked at most once. Th chief disadvantage is that it is needlessly complicated. It runs in about a tenth of a second on my machine.

-Josh

Hi Josh –

Neat. I don’t understand most of it yet. I’ll put it next to the Wiki article and walk through it. I pasted it into the VBE, changed your substitutions and corrected the path, and it worked fine. You have a fast machine!

Your code ran in 0.328125 seconds, mine slightly slower in 0.375 on my office PC. The good news for me is that I get a “tech refresh” next week. Hopefully I’ll catch up ;-)

Nice to have a VBA Dijkstra model. Thank you. I like your way of reading the file in much better than my several loop method. Germane to a discussion elsewhere here on DDoE, I too would have thought MatrixRow had to be a variant before this week.

Thank you for contributing.

…mrt

Michael,

It’s interesting you should mention timings. I’ve found that the first time I run this program, it takes anywhere from 0.2-0.4 seconds. All subsequent runs in the same session settle down to 0.1 seconds. I’m not sure if it has to do with reading the text file, or what. Your program settled in at 0.4 seconds for me.

I recently got a “tech refresh” in January when I spilled water on my old laptop and blew out the motherboard. I swore to my wife that it was an accident, but I’m not sure she believed me.

I’d recommend reading the Wikipedia article on the binary heap first. It’s not too long or technical, which meant I could understand it without much trouble. I don’t know about you, but I have trouble visualizing abstract algorithms like Dijkstra. I didn’t understand it until I found a nice applet online that had a step-by-step demonstration. I don’t know the rules for posting links, but the third Google search result for “Dijkstra Applet” is a good one.

I think that this was the first time that I had used the Split function, which I’m pretty sure I learned about from this site. Previously, I had used an unholy combination of Len / Mid /counters to look for commas and pick out the text of interest. What a mess – Split is much better.

-Josh

Hi Josh –

One thing I learned about Split() is that it ignores Option Base 1. It’s always zero-based. There are probably other functions like that, but it bit me back on #67. It’s counterpart is Join(). I learned about that here, too.

I’m going to walk down your code learning and looking for the lines to change to do #82.

WordPress is actually very nice outside the VB tags. If you copy the http://URL from your browser and paste it in, it makes it into a link. Playing with fire here, but I’d bet it tries to turn that into a link ;-)

I’m check here so often the DDoE ought to be the HDoE. I’m impressed with what Dick puts into it and dismayed that some call it “crappy.”

…mrt

Michael, I don’t have time tp read the thread in detail now, but I’ll just pass on a tip that I picked up at the Project Euler forum: there is no need to surround the matrix with large numbers, blank cells will do just as well because blanks are ignored by the MIN() function. As long as there is at least one blank column or row on each side of the matrix you can use the same formula everywhere.

Hi Doug –

True in a spreadsheet…not true in VBA for application.worksheetfunction.min. If you haven’t dimensioned beyond the area of interest, you get subscript errors. And since it’s min, you have to initialize those at a high value. Using max, not a problem.

…mrt

Michael,

Yeah, I have to pause for a minute whenever I use Split() because I tend to use one-based arrays, though I don’t use Option Base 1 (what’s a few extra bytes of wasted memory?). I had not known about Join() though. I can immediately think of a half dozen places in previous projects where that would have come in handy…

Good luck with #82. Let me know if you have any questions / problems. I just adapted the code for #82 and it took a ridiculous 15 seconds. Surely I can do better than that. At least it gave me the right answer though.

Ha, link for sure. I just wasn’t sure if posting links was allowed or not, but it seems to be.

Who calls it crappy? The articles, tips and discussions here are always top-notch.

-Josh

I hate replying to my own posts, but I am apparently brain dead. I should try reading the whole problem. 0.1 seconds for #82.

-Josh

Josh –

See this thread. 7th comment.

http://www.dailydoseofexcel.com/archives/2009/06/16/reading-xml-files-in-vba/#comments

…mrt

Michael,

So let me get this straight: Dick learns something completely new, goes through general steps that would be helpful in understanding it, and comes up with a workable solution. Several people with more experience offer helpful suggestions, and some idiot calls it crappy? Sheesh.

-Josh