Comments on: Euler Problem 83

By: JoshG

JoshG — Fri, 26 Jun 2009 15:53:00 +0000

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

By: Michael

Michael — Fri, 26 Jun 2009 02:50:00 +0000

Josh -

See this thread. 7th comment.

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

...mrt

By: JoshG

JoshG — Thu, 25 Jun 2009 22:38:00 +0000

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

By: JoshG

JoshG — Thu, 25 Jun 2009 22:20:00 +0000

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

By: Michael

Michael — Thu, 25 Jun 2009 00:51:00 +0000

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

By: Doug Jenkins

Doug Jenkins — Wed, 24 Jun 2009 23:37:00 +0000

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.

By: Michael

Michael — Wed, 24 Jun 2009 21:11:00 +0000

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

By: JoshG

JoshG — Wed, 24 Jun 2009 20:03:00 +0000

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

By: Michael

Michael — Wed, 24 Jun 2009 18:04:00 +0000

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

By: JoshG

JoshG — Wed, 24 Jun 2009 15:29:00 +0000

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 Const MatrixSize As Long = 80
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 6400x2 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