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
   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

Posted in Uncategorized

10 thoughts on “Euler Problem 83

  1. 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 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

  2. 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

  3. 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

  4. 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

  5. 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.

  6. 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

  7. 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

  8. 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

  9. 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


Posting code? Use <pre> tags for VBA and <code> tags for inline.

Leave a Reply

Your email address will not be published.