24
\$\begingroup\$

I've semi-often been frustrated at the lack of a proper Matrix data structure in VBA. A multi-dimensional array is obviously the right way to handle it, but there is so much missing... for example, you can't natively check to see if an array has been dimensioned, you can't resize the array while preserving values except on the last dimension, there is no convenient VBA syntax for loading immediate values into the array, etc.

So I created a Matrix class that supports:

  • Matrix operations - Add, Subtract, Multiply, ScalarMultiply, Augment, Transpose
  • Elementary Row Operations SwapRows, ScaleRow, AddScalarMultipleRow
  • A Parser for loading the Matrix from a String - LoadMatrixString
  • Utility functions - ToString, Clone
  • An implementation of Gaussian Elimination - RowReduce

The parser was made based on this tutorial on hand coding a recursive descent parser.

The Elementary Row Operations are destructive, because doing otherwise would degrade the performance too much.

The Matrix operations are non-destructive, in that they create a new Matrix with the results and return it. This allows method chaining, such as Set D = A.Multiply(B).Add(C).ScalarMultiply(5), and the intuitive behavior such that C = A x B and A and B themselves are not modified in the process. I'm tempted to make these methods destructive to improve performance (an object is created for every intermediate matrix operation), but I'm not sure how intuitive it would be that the result of A.Multiply(B) would be A.

I posted an earlier version of the class as an answer to a question here, but have since made some improvements. The test code there is still valid.

I'm particularly intersted to know whether I should split the parser off into a separate class to be used independently, or maybe be called by the Matrix class itself. I've tried to clean up the code naming conventions - PascalCase for the sub/functions and camelCase for the variable names and removing Hungarian - but please point out to me if I've missed something. I've been reading that unless you are specifically coding for performance, it's better from a code maintainability standpoint to call accessors when possible within the class instead of always modifying private members directly because if the implementation of the accessor ever changes, you wouldn't have to then go through the rest of the code and change the way it's done in the other functions - does that sound right?

Here is the very self-contained Matrix class:

Option Compare Database
Option Explicit
Private Declare Sub CopyMemory Lib "kernel32.dll" Alias "RtlMoveMemory" (ByVal Destination As Long, ByVal Source As Long, ByVal Length As Integer)
'----------------------------------
'This array holds the values of the Matrix
Private matrixArray() As Double
'----------------------------------
'Shared recursive descent parsing variables
Private tempMatrixString As String
Private look As String
Public Sub Class_Initialize()
End Sub
'************************************************
'* Accessors and Utility Functions *
'***********************************
Public Property Get Value(r As Long, c As Long) As Double
 CheckDimensions
 Value = matrixArray(r, c)
End Property
Public Property Let Value(r As Long, c As Long, val As Double)
 CheckDimensions
 matrixArray(r, c) = val
End Property
Public Property Get Rows() As Long
 If GetDims(matrixArray) = 0 Then
 Rows = 0
 Else
 Rows = UBound(matrixArray, 1) + 1
 End If
End Property
Public Property Get Cols() As Long
 If GetDims(matrixArray) = 0 Then
 Cols = 0
 Else
 Cols = UBound(matrixArray, 2) + 1
 End If
End Property
Public Sub LoadMatrixString(str As String)
 tempMatrixString = str
 ParseMatrix str
 tempMatrixString = ""
 look = ""
End Sub
Public Sub Resize(Rows As Long, Cols As Long, Optional blPreserve As Boolean = False)
 Dim tempMatrix As Matrix
 Dim r As Long
 Dim c As Long
 If blPreserve Then
 CheckDimensions
 Set tempMatrix = Me.Clone
 ReDim matrixArray(0 To Rows - 1, 0 To Cols - 1)
 For r = 0 To MinLongs(tempMatrix.Rows, Me.Rows) - 1
 For c = 0 To MinLongs(tempMatrix.Cols, Me.Cols) - 1
 Value(r, c) = tempMatrix.Value(r, c)
 Next
 Next
 Else
 ReDim matrixArray(0 To Rows - 1, 0 To Cols - 1)
 End If
End Sub
Public Function Clone() As Matrix
 Dim mresult As Matrix
 Dim r As Long
 Dim c As Long
 CheckDimensions
 Set mresult = New Matrix
 mresult.Resize Me.Rows, Me.Cols
 For r = 0 To Me.Rows - 1
 For c = 0 To Me.Cols - 1
 mresult.Value(r, c) = Me.Value(r, c)
 Next
 Next
 Set Clone = mresult
End Function
Public Function ToString() As String
 Dim str As String
 Dim r As Long
 Dim c As Long
 Dim tempRow() As String
 Dim tempRows() As String
 ReDim tempRow(0 To Me.Cols - 1)
 ReDim tempRows(0 To Me.Rows - 1)
 If Not GetDims(matrixArray) = 0 Then 'Need to check if array is empty
 For r = 0 To Me.Rows - 1
 For c = 0 To Me.Cols - 1
 tempRow(c) = Me.Value(r, c)
 Next
 tempRows(r) = "[" & Join(tempRow, ", ") & "]"
 Next
 ToString = "[" & Join(tempRows, vbCrLf) & "]"
 Else
 ToString = ""
 End If
End Function
'***********************************************************
'* Matrix Operations *
'*********************
Public Function Add(m As Matrix) As Matrix
 Dim mresult As Matrix
 Dim r As Long
 Dim c As Long
 CheckDimensions
 If m.Rows = Me.Rows And m.Cols = Me.Cols Then
 Set mresult = New Matrix
 mresult.Resize Me.Rows, Me.Cols
 For r = 0 To Me.Rows - 1
 For c = 0 To Me.Cols - 1
 mresult.Value(r, c) = Me.Value(r, c) + m.Value(r, c)
 Next
 Next
 Else
 Err.Raise vbObjectError + 1, "Matrix.Add", "Could not Add matrices: the Rows and Columns must be the same. The left matrix is (" & Me.Rows & ", " & Me.Cols & ") and the right matrix is (" & m.Rows & ", " & m.Cols & ")."
 End If
 Set Add = mresult
End Function
Public Function Subtract(m As Matrix) As Matrix
 Dim mresult As Matrix
 Dim r As Long
 Dim c As Long
 CheckDimensions
 If m.Rows = Me.Rows And m.Cols = Me.Cols Then
 Set mresult = New Matrix
 mresult.Resize Me.Rows, Me.Cols
 For r = 0 To Me.Rows - 1
 For c = 0 To Me.Cols - 1
 mresult.Value(r, c) = Me.Value(r, c) - m.Value(r, c)
 Next
 Next
 Else
 Err.Raise vbObjectError + 2, "Matrix.Subtract", "Could not Subtract matrices: the Rows and Columns must be the same. The left matrix is (" & Me.Rows & ", " & Me.Cols & ") and the right matrix is (" & m.Rows & ", " & m.Cols & ")."
 End If
 Set Subtract = mresult
End Function
Public Function Multiply(m As Matrix) As Matrix
 Dim mresult As Matrix
 Dim i As Long
 Dim j As Long
 Dim n As Long
 CheckDimensions
 If Me.Cols = m.Rows Then
 Set mresult = New Matrix
 mresult.Resize Me.Rows, m.Cols
 For i = 0 To Me.Rows - 1
 For j = 0 To m.Cols - 1
 For n = 0 To Me.Cols - 1
 mresult.Value(i, j) = mresult.Value(i, j) + (Me.Value(i, n) * m.Value(n, j))
 Next
 Next
 Next
 Else
 Err.Raise vbObjectError + 3, "Matrix.Multiply", "Could not Subtract matrices: the Columns of the left matrix and Rows of the right must be the same. The left matrix has " & Me.Cols & " Columns and the right matrix has " & m.Rows & " Rows."
 End If
 Set Multiply = mresult
End Function
Public Function ScalarMultiply(scalar As Double) As Matrix
 Dim mresult As Matrix
 Dim r As Long
 Dim c As Long
 CheckDimensions
 Set mresult = New Matrix
 mresult.Resize Me.Rows, Me.Cols
 For r = 0 To Me.Rows - 1
 For c = 0 To Me.Cols - 1
 mresult.Value(r, c) = Me.Value(r, c) * scalar
 Next
 Next
 Set ScalarMultiply = mresult
End Function
Public Function Augment(m As Matrix) As Matrix
 Dim mresult As Matrix
 Dim r As Long
 Dim c As Long
 CheckDimensions
 If Me.Rows = m.Rows Then
 Set mresult = New Matrix
 mresult.Resize Me.Rows, Me.Cols + m.Cols
 For r = 0 To Me.Rows - 1
 For c = 0 To Me.Cols - 1
 mresult.Value(r, c) = Me.Value(r, c)
 Next
 Next
 For r = 0 To Me.Rows - 1
 For c = 0 To m.Cols - 1
 mresult.Value(r, Me.Cols + c) = m.Value(r, c)
 Next
 Next
 Else
 Err.Raise vbObjectError + 4, "Matrix.Augment", "Could not Augment matrices: the matrices must have the same number of Rows. The left matrix has " & Me.Rows & " Rows and the right matrix has " & m.Rows & " Rows."
 End If
 Set Augment = mresult
End Function
Public Function Transpose() As Matrix
 Dim mresult As Matrix
 Dim r As Long
 Dim c As Long
 CheckDimensions
 If Me.Rows = Me.Cols Then
 Set mresult = New Matrix
 mresult.Resize Me.Cols, Me.Rows
 For r = 0 To Me.Rows - 1
 For c = 0 To Me.Cols - 1
 Me.Value(r, c) = mresult(c, r)
 Next
 Next
 Else
 Err.Raise vbObjectError + 5, "Matrix.Augment", "Could not Transpose matrix: the matrix must have the same number of Rows and Cols. The matrix is (" & Me.Rows & ", " & Me.Cols & ")."
 End If
 Set Transpose = mresult
End Function
Public Function RowReduce() As Matrix
 Dim i As Long
 Dim j As Long
 CheckDimensions
 'Row Echelon
 Dim mresult As Matrix
 Set mresult = Me.Clone
 For i = 0 To mresult.Rows - 1
 If Not mresult.Value(i, i) <> 0 Then
 For j = i + 1 To mresult.Rows - 1
 If mresult.Value(j, i) > 0 Then
 mresult.SwapRows i, j
 Exit For
 End If
 Next
 End If
 If mresult.Value(i, i) = 0 Then
 Exit For
 End If
 mresult.ScaleRow i, 1 / mresult.Value(i, i)
 For j = i + 1 To mresult.Rows - 1
 mresult.AddScalarMultipleRow i, j, -mresult.Value(j, i)
 Next
 Next
 'Backwards substitution
 For i = IIf(mresult.Rows < mresult.Cols, mresult.Rows, mresult.Cols) - 1 To 1 Step -1
 If mresult.Value(i, i) > 0 Then
 For j = i - 1 To 0 Step -1
 mresult.AddScalarMultipleRow i, j, -mresult.Value(j, i)
 Next
 End If
 Next
 Set RowReduce = mresult
End Function
'*************************************************************
'* Elementary Row Operaions *
'****************************
Public Sub SwapRows(r1 As Long, r2 As Long)
 Dim temp As Double
 Dim c As Long
 CheckDimensions
 For c = 0 To Me.Cols - 1
 temp = Me.Value(r1, c)
 Me.Value(r1, c) = Me.Value(r2, c)
 Me.Value(r2, c) = temp
 Next
End Sub
Public Sub ScaleRow(row As Long, scalar As Double)
 Dim c As Long
 CheckDimensions
 For c = 0 To Me.Cols - 1
 Me.Value(row, c) = Me.Value(row, c) * scalar
 Next
End Sub
Public Sub AddScalarMultipleRow(srcrow As Long, destrow As Long, scalar As Double)
 Dim c As Long
 CheckDimensions
 For c = 0 To Me.Cols - 1
 Me.Value(destrow, c) = Me.Value(destrow, c) + (Me.Value(srcrow, c) * scalar)
 Next
End Sub
'************************************************************
'* Parsing Functions *
'*********************
Private Sub ParseMatrix(strMatrix As String)
 Dim arr() As Double
 Dim c As Long
 GetChar 1
 Match "["
 SkipWhite
 If look = "[" Then
 arr = ParseRow
 Me.Resize 1, UBound(arr) + 1
 'ReDim matrixArray(0 To UBound(arr), 0 To 0)
 For c = 0 To Me.Cols - 1
 Me.Value(0, c) = arr(c)
 Next
 SkipWhite
 While look = ","
 Match ","
 SkipWhite
 arr = ParseRow
 Me.Resize Me.Rows + 1, Me.Cols, True
 If UBound(arr) <> (Me.Cols - 1) Then
 'Error jagged array
 Err.Raise vbObjectError + 6, "Matrix.LoadMatrixString", "Parser Error - Jagged arrays are not supported: Row 0 has " & Me.Cols & " Cols, but Row " & Me.Rows - 1 & " has " & UBound(arr) + 1 & " Cols."
 End If
 For c = 0 To Me.Cols - 1
 Me.Value(Me.Rows - 1, c) = arr(c)
 Next
 SkipWhite
 Wend
 Match "]"
 ElseIf look = "]" Then
 Match "]"
 Else
 MsgBox "Error"
 End If
 SkipWhite
 If look <> "" Then
 Err.Raise vbObjectError + 7, "Matrix.LoadMatrixString", "Parser Error - Unexpected Character: """ & look & """."
 End If
End Sub
Private Function ParseRow() As Variant
 Dim arr() As Double
 Match "["
 SkipWhite
 ReDim arr(0 To 0)
 arr(0) = ParseNumber
 SkipWhite
 While look = ","
 Match ","
 ReDim Preserve arr(0 To UBound(arr) + 1)
 arr(UBound(arr)) = ParseNumber
 SkipWhite
 Wend
 Match "]"
 ParseRow = arr
End Function
Private Function ParseNumber() As Double
 Dim strToken As String
 If look = "-" Then
 strToken = strToken & look
 GetChar
 End If
 While IsDigit(look)
 strToken = strToken & look
 GetChar
 Wend
 If look = "." Then
 strToken = strToken & look
 GetChar
 While IsDigit(look)
 strToken = strToken & look
 GetChar
 Wend
 End If
 ParseNumber = CDbl(strToken)
End Function
'****************************************************************
Private Sub GetChar(Optional InitValue)
 Static i As Long
 If Not IsMissing(InitValue) Then
 i = InitValue
 End If
 If i <= Len(tempMatrixString) Then
 look = Mid(tempMatrixString, i, 1)
 i = i + 1
 Else
 look = ""
 End If
End Sub
'****************************************************************
'* Skip Functions (Parser) *
'***************************
Private Sub SkipWhite()
 While IsWhite(look) Or IsEOL(look)
 GetChar
 Wend
End Sub
'****************************************************************
'* Match/Expect Functions (Parser) *
'***********************************
Private Sub Match(char As String)
 If look <> char Then
 Expected """" & char & """"
 Else
 GetChar
 SkipWhite
 End If
 Exit Sub
End Sub
Private Sub Expected(str As String)
 'MsgBox "Expected: " & str
 Err.Raise vbObjectError + 8, "Matrix.LoadMatrixString", "Parser Error - Expected: " & str
End Sub
'****************************************************************
'* Character Class Functions (Parser) *
'**************************************
Private Function IsDigit(char As String) As Boolean
 Dim charval As Integer
 If char <> "" Then
 charval = Asc(char)
 If 48 <= charval And charval <= 57 Then
 IsDigit = True
 Else
 IsDigit = False
 End If
 Else
 IsDigit = False
 End If
End Function
Private Function IsWhite(char As String) As Boolean
 Dim charval As Integer
 If char <> "" Then
 charval = Asc(char)
 If charval = 9 Or charval = 11 Or charval = 12 Or charval = 32 Or charval = 160 Then '160 because MS Exchange sucks
 IsWhite = True
 Else
 IsWhite = False
 End If
 Else
 IsWhite = False
 End If
End Function
Private Function IsEOL(char As String) As Boolean
 If char = Chr(13) Or char = Chr(10) Then
 IsEOL = True
 Else
 IsEOL = False
 End If
End Function
'*****************************************************************
'* Helper Functions *
'********************
Private Sub CheckDimensions()
 If GetDims(matrixArray) = 0 Then
 'Error, uninitialized array
 Err.Raise vbObjectError + 1, "Matrix", "Array has not been initialized"
 End If
End Sub
Private Function GetDims(VarSafeArray As Variant) As Integer
 Dim lpSAFEARRAY As Long
 Dim lppSAFEARRAY As Long
 Dim arrayDims As Integer
 'This check ensures that the value inside the Variant is actually an array of some type
 If (VarType(VarSafeArray) And vbArray) > 0 Then
 'If the Variant contains an array, the pointer to the pointer to the array is located at VarPtr(VarSafeArray) + 8...
 CopyMemory VarPtr(lppSAFEARRAY), VarPtr(VarSafeArray) + 8, 4&
 '...and now dereference the pointer to pointer to get the actual pointer to the array...
 CopyMemory VarPtr(lpSAFEARRAY), lppSAFEARRAY, 4&
 '...which will be 0 if the array hasn't been initialized
 If Not lpSAFEARRAY = 0 Then
 'If it HAS been initialized, we can pull the number of dimensions directly from the pointer, since it's the first member in the SAFEARRAY struct
 CopyMemory VarPtr(arrayDims), lpSAFEARRAY, 2&
 GetDims = arrayDims
 Else
 GetDims = 0 'Array not initialized
 End If
 Else
 GetDims = 0 'It's not an array... Type mismatch maybe?
 End If
End Function
Private Function MinLongs(a As Long, b As Long) As Long
 If a < b Then
 MinLongs = a
 Else
 MinLongs = b
 End If
End Function

And here are a couple examples of use:

Option Compare Database
Public Sub TestMatrix()
 Dim m1 As Matrix
 Set m1 = New Matrix
 m1.LoadMatrixString ("[[ 0, 1, 4, 9, 16]," & _
 " [16, 15, 12, 7, 0]," & _
 " [ 1, 1, 1, 1, 1]]")
 Dim m2 As Matrix
 Set m2 = New Matrix
 m2.LoadMatrixString ("[[190]," & _
 " [190]," & _
 " [ 20]]")
 MsgBox m1.Augment(m2).RowReduce.ToString
End Sub
Public Sub TestMatrix2()
 'This is an example iteration of a matrix Petri Net as described here:
 'http://www.techfak.uni-bielefeld.de/~mchen/BioPNML/Intro/MRPN.html
 Dim D_Minus As Matrix
 Dim D_Plus As Matrix
 Dim D As Matrix
 Set D_Minus = New Matrix
 D_Minus.LoadMatrixString "[[0, 0, 0, 0, 1]," & _
 " [1, 0, 0, 0, 0]," & _
 " [0, 1, 0, 0, 0]," & _
 " [0, 0, 1, 1, 0]]"
 Set D_Plus = New Matrix
 D_Plus.LoadMatrixString "[[1, 1, 0, 0, 0]," & _
 " [0, 0, 1, 1, 0]," & _
 " [0, 0, 0, 1, 0]," & _
 " [0, 0, 0, 0, 1]]"
 Set D = D_Plus.Subtract(D_Minus)
 MsgBox D.ToString
 Dim Transition_Matrix As Matrix
 Dim Marking_Matrix As Matrix
 Dim Next_Marking As Matrix
 Set Transition_Matrix = New Matrix
 Transition_Matrix.LoadMatrixString "[[0, 1, 1, 0]]"
 Set Marking_Matrix = New Matrix
 Marking_Matrix.LoadMatrixString "[[2, 1, 0, 0, 0]]"
 Set Next_Marking = Transition_Matrix.Multiply(D).Add(Marking_Matrix)
 MsgBox Next_Marking.ToString
End Sub
asked Oct 24, 2014 at 21:56
\$\endgroup\$
3
  • \$\begingroup\$ I will be keeping an eye on this for sure! \$\endgroup\$ Commented Oct 24, 2014 at 22:34
  • 1
    \$\begingroup\$ I think there's a bug in this code; I believe Value is designed to be a default attribute meaning it requires the Attribute Value.VB_UserMemId = 0 tag. I say this because methods like Transpose call things like Me.Value(r, c) = mresult(c, r) which won't work currently, and need to be replaced with Me.Value(r, c) = mresult.Value(c, r) if the tag isn't added. Incidentally that method should actually be mresult.Value(c, r) = Me.Value(r, c) I think, and it doesn't need to check for matching dimensions (Me.Rows = Me.Cols) as it's fine to transpose a non-square matrix \$\endgroup\$ Commented Sep 16, 2018 at 12:08
  • \$\begingroup\$ You could replace Option compara database by Option compare Text to allow the code to be used in Excel as well. \$\endgroup\$ Commented Sep 24, 2018 at 9:16

4 Answers 4

11
\$\begingroup\$
Public Sub Class_Initialize()
End Sub

Avoid empty members; this initializer serves no purpose, remove it.

Although I could infer r and c are meant for row and column, these single-letter parameters should probably be called row and column, for clarity. Likewise, Cols should probably be called Columns.

This is unfortunate:

Public Property Let Value(r As Long, c As Long, val As Double)

I'd consider calling the property ValueAt, and the val parameter could then be called value - and since parameters are passed ByRef by default, I'd be explicit about them being passed ByVal - there's no need to pass them by reference:

Public Property Let ValueAt(ByVal rowIndex As Long, ByVal columnIndex As Long, ByVal value As Double)

In the case of LoadMatrixString, I'd consider changing the signature from this:

Public Sub LoadMatrixString(str As String)

To that:

Public Sub LoadMatrixString(ByVal values As String)

And for the members that take a m As Matrix parameter, I'd go with ByVal value As Matrix and avoid single-letter identifiers. I find "value" remains the most descriptive name in these contexts.

There's an inconsistency in the way you're naming "Dimensions": you have CheckDimensions, but then you also have GetDims - I'd rename the latter GetDimensions.


I like how the class is self-contained, but then it seems to me like the ToString implementation would be a perfect excuse to use your wonderful StringBuilder class, and I bet you'd get the string output much, much faster ;)

As for this:

I'm particularly intersted to know whether I should split the parser off into a separate class to be used independently, or maybe be called by the Matrix class itself.

I think you could simply move the parsing code to a MatrixParser class, and be done with it! ...Actually, I'd copy the LoadMatrixString procedure there, and rename it Parse, make it a Function and have it return a Matrix. Then LoadMatrixString could be modified to call this new function.

answered Oct 25, 2014 at 1:10
\$\endgroup\$
2
  • \$\begingroup\$ Does using Row and Column cause any problems where they are keywords in VBA? \$\endgroup\$ Commented Oct 25, 2014 at 15:07
  • \$\begingroup\$ @enderland they're not keywords - they're just members of Worksheet and Range classes - that doesn't stop you from having your own ;) \$\endgroup\$ Commented Oct 25, 2014 at 16:02
13
\$\begingroup\$

This is by no means a full review, but I did notice something. The way you raise errors could use a little work if you're striving for maintainable code.

 Err.Raise vbObjectError + 1, "Matrix.Add", "Could not Add matrices: the Rows and Columns must be the same. The left matrix is (" & Me.Rows & ", " & Me.Cols & ") and the right matrix is (" & m.Rows & ", " & m.Cols & ")."

So, first off, I like that you're correctly adding vbObjectError to the error number. What I don't like is if I want to add a new error, I have to manually look at the whole file to see if I'm reusing one. This is a great use of an Enum.

Public Enum MatrixError
 AdditionError = vbObjectError + 1
 SomeOtherError
 ' ...
End Enum

The benefits are two fold.

  1. It becomes easier to add and use the error number.
  2. The error numbers get exposed to the client code, so if an error gets raised, I can check the Err.Number and handle it appropriately.

Something like this:

ErrHandler:
 If Err.Number = AdditionError Then
 ' do something to handle the matrix error
 Else
 ' throw it upstream
 Err.Raise Err.Number
 End If
End Sub
answered Oct 24, 2014 at 23:20
\$\endgroup\$
0
9
\$\begingroup\$

Just a few things to think about, more about the design and usage of the Matrix class than just the code.

In my particular and peculiar corner of the universe, we often have need for empty matrices, that is, a matrix where one or more dimensions are zero. The idea would be that a matrix would be built up or destroyed during the course of program execution and at one or another point in time, having zero rows would be quite natural. Granted VBA does not support empty arrays, one nasty (or just silly) way I had dealt with this is to pad with one extra row or column element. Sure, it's some extra space, but this is after all 2015.

More down to earth, I would use a parser-free analogue and companion to LoadMatrixString, something like

Public Sub LoadMatrixVector(rows as Long, columns as Long, values() as Double)

possibly used in conjunction with a helper function like

Public Function Vector(ParamArray values() As Variant) As Double()
 Dim result() As Double
 ReDim result(UBound(values))
 Dim i As Long
 Dim item As Variant
 i = 0
 For Each item In values
 result(i) = CDbl(values(i))
 i = i + 1
 Next item
 Vector = result
End Function

where I could write

Set mat = LoadMatrixVector(3, 3, Vector(1, 2, 3))

and get a matrix with three rows of 1, 2, and 3. LoadMatrixVector could wrap the values as needed until the result is filled. Also, I could see something like this as an acceptable compromise to do operations in place (you called this "destructive").

Set D = A.ShallowCopy().Multiply(B).Add(C).ScalarMultiply(5)

And there's more. My suggestions may contravene established coding practices. I try to go for a combination of brevity and clarity.

First, I prefer to dispose of easy cases early in a program, to reduce (cyclometric?) complexity later. For instance, instead of

Public Function Add(m As Matrix) As Matrix
 Dim mresult As Matrix
 Dim r As Long
 Dim c As Long
 CheckDimensions
 If m.Rows = Me.Rows And m.Cols = Me.Cols Then
 Set mresult = New Matrix
 mresult.Resize Me.Rows, Me.Cols
 For r = 0 To Me.Rows - 1
 For c = 0 To Me.Cols - 1
 mresult.Value(r, c) = Me.Value(r, c) + m.Value(r, c)
 Next
 Next
 Else
 Err.Raise vbObjectError + 1, "Matrix.Add", "Could not Add matrices: the Rows and Columns must be the same. The left matrix is (" & Me.Rows & ", " & Me.Cols & ") and the right matrix is (" & m.Rows & ", " & m.Cols & ")."
 End If
 Set Add = mresult
End Function

I would move the conformability check up a bit earlier and possibly exit early. Not really shorter, but the actual business part of the function is simpler and has less indentation.

Public Function Add(m As Matrix) As Matrix
 Dim mresult As Matrix
 Dim r As Long
 Dim c As Long
 CheckDimensions
 If m.Rows <> Me.Rows Or m.Cols <> Me.Cols Then
 Err.Raise vbObjectError + 1, "Matrix.Add", "Could not Add matrices: the Rows and Columns must be the same. The left matrix is (" & Me.Rows & ", " & Me.Cols & ") and the right matrix is (" & m.Rows & ", " & m.Cols & ")."
 End If
 Set mresult = New Matrix
 mresult.Resize Me.Rows, Me.Cols
 For r = 0 To Me.Rows - 1
 For c = 0 To Me.Cols - 1
 mresult.Value(r, c) = Me.Value(r, c) + m.Value(r, c)
 Next
 Next
 Set Add = mresult
End Function

Next, functions which return boolean results like

Private Function IsEOL(char As String) As Boolean
 If char = Chr(13) Or char = Chr(10) Then
 IsEOL = True
 Else
 IsEOL = False
 End If
End Function

can be written like this

Private Function IsEOL(char As String) As Boolean
 IsEOL = char = Chr(13) Or char = Chr(10)
End Function

though VBA's design decision of using = for both assignment and equality is irritating here. This also works in Java etc.

Combining the two ideas, isDigit can get much smaller

Private Function IsDigit(char As String) As Boolean
 Dim charval As Integer
 IsDigit = False
 If char = "" Then Exit Function
 charval = Asc(char)
 IsDigit = 48 <= charval And charval <= 57
End Function

I feel you did a lot if things right, you did the best with what you had.

Comments are there when needed to explain what you're doing, but you otherwise assume a reasonable language literacy level.

The MultiplyScalar function is a good example of not doing too much. Instead of mucking about with VBA's lack of function overloading and trying to separate scalar and matrix cases in a Multiply function, the burden of type checking stays with VBA, where it belongs.

Good stuff.

answered Jun 23, 2015 at 12:01
\$\endgroup\$
4
\$\begingroup\$

isDigit can be made twice as fast (and shorter) using Like:

Private Function IsDigit(char As String) As Boolean
 IsDigit = char Like "[0-9]"
End Function
answered Aug 29, 2018 at 15:29
\$\endgroup\$

Your Answer

Draft saved
Draft discarded

Sign up or log in

Sign up using Google
Sign up using Email and Password

Post as a guest

Required, but never shown

Post as a guest

Required, but never shown

By clicking "Post Your Answer", you agree to our terms of service and acknowledge you have read our privacy policy.

Start asking to get answers

Find the answer to your question by asking.

Ask question

Explore related questions

See similar questions with these tags.