Files
demo_VBA/src/Matrix_Operations.bas
2025-01-14 09:02:53 +00:00

1475 lines
43 KiB
QBasic

' Author: Edward Middleton-Smith
' Precision And Research Technology Systems Limited
' MODULE INITIALISATION
' Set array start index to 1 to match spreadsheet indices
Option Base 1
' Forced Variable Declaration
Option Explicit
Sub ReDimPreserve_String(ByRef arr() As String, ByVal dimension As Long, ByVal newbound As Long, ByVal NDim As Long)
' FUNCTION
' Redimensionalise array without losing data (unless shrinking)
' ARGUMENTS
' String Array arr
' Long dimension - dimension of arr to change
' Long newbound - new size of dimension
' Long ndim - number of dimensions of arr
' VARIABLE DECLARATION
Dim x() As Long ' Iterables for each dimension
Dim N() As Long ' Size of each dimension
Dim i As Long
Dim j As Long
Dim iterate As Boolean
Dim Outs() As String
Dim Nold() As Long
Dim minbound As Long
' VARIABLE INSTANTIATION
ReDim x(NDim)
ReDim N(NDim)
iterate = True
' METHODS
' Populate N
For i = 1 To NDim
x(i) = 1
N(i) = SizeArrayDim_String(arr, i)
Next
Nold = N
N(dimension) = newbound
minbound = min_Long(newbound, Nold(dimension))
' Redimensionalise outputs
Select Case NDim
Case 1
ReDim Outs(N(1))
Case 2
ReDim Outs(N(1), N(2))
Case 3
ReDim Outs(N(1), N(2), N(3))
Case 4
ReDim Outs(N(1), N(2), N(3), N(4))
Case 5
ReDim Outs(N(1), N(2), N(3), N(4), N(5))
Case Else
MsgBox "Too many dimensions"
Exit Sub
End Select
' Fill values
Do While iterate
' Fill value
Select Case NDim
Case 1
Outs(x(1)) = arr(x(1))
Case 2
Outs(x(1), x(2)) = arr(x(1), x(2))
Case 3
Outs(x(1), x(2), x(3)) = arr(x(1), x(2), x(3))
Case 4
Outs(x(1), x(2), x(3), x(4)) = arr(x(1), x(2), x(3), x(4))
Case 5
Outs(x(1), x(2), x(3), x(4), x(5)) = arr(x(1), x(2), x(3), x(4), x(5))
Case Else
MsgBox "Too many dimensions"
Exit Sub
End Select
' Iterate position
For i = NDim To 1 Step -1
If (i = dimension) Then
If (x(dimension) < minbound) Then
x(dimension) = x(dimension) + 1
If (dimension < NDim) Then
For j = dimension + 1 To NDim
x(j) = 1
Next
End If
Exit For
End If
ElseIf (x(i) < N(i)) Then
x(i) = x(i) + 1
If (i < NDim) Then
For j = i + 1 To NDim
x(j) = 1
Next
End If
Exit For
End If
If (i = 1) Then
iterate = False
End If
Next
Loop
' RETURNS
arr = Outs
End Sub
Sub ReDimPreserve_Long(ByRef arr() As Long, ByVal dimension As Long, ByVal newbound As Long, ByVal NDim As Long)
' FUNCTION
' Redimensionalise array without losing data (unless shrinking)
' ARGUMENTS
' Long Array arr
' Long dimension - dimension of arr to change
' Long newbound - new size of dimension
' Long ndim - number of dimensions of arr
' VARIABLE DECLARATION
Dim x() As Long ' Iterables for each dimension
Dim N() As Long ' Size of each dimension
Dim i As Long
Dim j As Long
Dim iterate As Boolean
Dim Outs() As Long
Dim Nold() As Long
Dim minbound As Long
' VARIABLE INSTANTIATION
ReDim x(NDim)
ReDim N(NDim)
iterate = True
' METHODS
' Populate N
For i = 1 To NDim
x(i) = 1
N(i) = SizeArrayDim_Long(arr, i)
Next
Nold = N
N(dimension) = newbound
minbound = min_Long(newbound, Nold(dimension))
' Redimensionalise outputs
Select Case NDim
Case 1
ReDim Outs(N(1))
Case 2
ReDim Outs(N(1), N(2))
Case 3
ReDim Outs(N(1), N(2), N(3))
Case 4
ReDim Outs(N(1), N(2), N(3), N(4))
Case 5
ReDim Outs(N(1), N(2), N(3), N(4), N(5))
Case Else
MsgBox "Too many dimensions"
Exit Sub
End Select
' Fill values
Do While iterate
' Fill value
Select Case NDim
Case 1
Outs(x(1)) = arr(x(1))
Case 2
Outs(x(1), x(2)) = arr(x(1), x(2))
Case 3
Outs(x(1), x(2), x(3)) = arr(x(1), x(2), x(3))
Case 4
Outs(x(1), x(2), x(3), x(4)) = arr(x(1), x(2), x(3), x(4))
Case 5
Outs(x(1), x(2), x(3), x(4), x(5)) = arr(x(1), x(2), x(3), x(4), x(5))
Case Else
MsgBox "Too many dimensions"
Exit Sub
End Select
' Iterate position
For i = NDim To 1 Step -1
If (i = dimension) Then
If (x(dimension) < minbound) Then
x(dimension) = x(dimension) + 1
If (dimension < NDim) Then
For j = dimension + 1 To NDim
x(j) = 1
Next
End If
Exit For
End If
ElseIf (x(i) < N(i)) Then
x(i) = x(i) + 1
If (i < NDim) Then
For j = i + 1 To NDim
x(j) = 1
Next
End If
Exit For
End If
If (i = 1) Then
iterate = False
End If
Next
Loop
' RETURNS
arr = Outs
End Sub
Sub ReDimPreserve_Variant(ByRef arr() As Variant, ByVal dimension As Long, ByVal newbound As Long, ByVal NDim As Long)
' FUNCTION
' Redimensionalise array without losing data (unless shrinking)
' ARGUMENTS
' Variant Array arr
' Long dimension - dimension of arr to change
' Long newbound - new size of dimension
' Long ndim - number of dimensions of arr
' VARIABLE DECLARATION
Dim x() As Long ' Iterables for each dimension
Dim N() As Long ' Size of each dimension
Dim i As Long
Dim j As Long
Dim iterate As Boolean
Dim Outs() As Variant
Dim Nold() As Long
Dim minbound As Long
' VARIABLE INSTANTIATION
ReDim x(NDim)
ReDim N(NDim)
iterate = True
' METHODS
' Populate N
For i = 1 To NDim
x(i) = 1
N(i) = SizeArrayDim_Variant(arr, i)
Next
Nold = N
N(dimension) = newbound
minbound = min_Long(newbound, Nold(dimension))
' Redimensionalise outputs
Select Case NDim
Case 1
ReDim Outs(N(1))
Case 2
ReDim Outs(N(1), N(2))
Case 3
ReDim Outs(N(1), N(2), N(3))
Case 4
ReDim Outs(N(1), N(2), N(3), N(4))
Case 5
ReDim Outs(N(1), N(2), N(3), N(4), N(5))
Case Else
MsgBox "Too many dimensions"
Exit Sub
End Select
' Fill values
Do While iterate
' Fill value
Select Case NDim
Case 1
Outs(x(1)) = arr(x(1))
Case 2
Outs(x(1), x(2)) = arr(x(1), x(2))
Case 3
Outs(x(1), x(2), x(3)) = arr(x(1), x(2), x(3))
Case 4
Outs(x(1), x(2), x(3), x(4)) = arr(x(1), x(2), x(3), x(4))
Case 5
Outs(x(1), x(2), x(3), x(4), x(5)) = arr(x(1), x(2), x(3), x(4), x(5))
Case Else
MsgBox "Too many dimensions"
Exit Sub
End Select
' Iterate position
For i = NDim To 1 Step -1
If (i = dimension) Then
If (x(dimension) < minbound) Then
x(dimension) = x(dimension) + 1
If (dimension < NDim) Then
For j = dimension + 1 To NDim
x(j) = 1
Next
End If
Exit For
End If
ElseIf (x(i) < N(i)) Then
x(i) = x(i) + 1
If (i < NDim) Then
For j = i + 1 To NDim
x(j) = 1
Next
End If
Exit For
End If
If (i = 1) Then
iterate = False
End If
Next
Loop
' RETURNS
arr = Outs
End Sub
Function SizeArrayDim_String(ByRef arr() As String, Optional dimension As Long = 1) As Long
' FUNCTION
' Find size of dimension of arr
' VARIABLE INSTANTIATION
dimension = max_Long(1, dimension)
' METHODS
On Error GoTo errhand
If Not ((Not arr) = -1) Then
SizeArrayDim_String = UBound(arr, dimension) - LBound(arr, dimension) + 1
Else
SizeArrayDim_String = 0
End If
Exit Function
' ERROR HANDLING
errhand:
SizeArrayDim_String = 0
End Function
Function SizeArrayDim_Long(ByRef arr() As Long, Optional dimension As Long = 1) As Long
' FUNCTION
' Find size of dimension of arr
' VARIABLE INSTANTIATION
dimension = max_Long(1, dimension)
' METHODS
On Error GoTo errhand
If Not ((Not arr) = -1) Then
SizeArrayDim_Long = UBound(arr, dimension) - LBound(arr, dimension) + 1
Else
SizeArrayDim_Long = 0
End If
Exit Function
' ERROR HANDLING
errhand:
SizeArrayDim_Long = 0
End Function
Function SizeArrayDim_Variant(ByRef arr() As Variant, Optional dimension As Long = 1) As Long
' FUNCTION
' Find size of dimension of arr
' VARIABLE INSTANTIATION
dimension = max_Long(1, dimension)
' METHODS
On Error GoTo errhand
If Not ((Not arr) = -1) Then
SizeArrayDim_Variant = UBound(arr, dimension) - LBound(arr, dimension) + 1
Else
SizeArrayDim_Variant = 0
End If
Exit Function
' ERROR HANDLING
errhand:
SizeArrayDim_Variant = 0
End Function
Function SizeArrayDim_Variant_0(ByVal arr As Variant) As Long
' FUNCTION
' Find size of dimension of arr
' METHODS
On Error GoTo errhand
If Not IsEmpty(arr) Then ' ((Not arr) = -1) Then
SizeArrayDim_Variant_0 = UBound(arr) - LBound(arr) + 1
Else
SizeArrayDim_Variant_0 = 0
End If
Exit Function
' ERROR HANDLING
errhand:
SizeArrayDim_Variant_0 = 0
End Function
Function create_1D_mat_Boolean(Optional value As Boolean = False, Optional N As Long = 1) As Boolean()
' FUNCTION
' Create 1D matrix (array) of size N, type Boolean and value
' ARGUMENTS
' Boolean value - for each element of array
' Long N - number of elements in array
' PROCESSING ACCELERATION
' CONSTANTS
' VARIABLE DECLARATION
Dim Outs() As Boolean
Dim i As Long
' ARGUMENT VALIDATION
N = max_Long(1, N)
' VARIABLE INSTANTIATION
ReDim Outs(N)
' METHODS
For i = 1 To N
Outs(i) = value
Next
' RETURNS
create_1D_mat_Boolean = Outs
End Function
Function create_1D_mat_Long(Optional value As Long = 0, Optional N As Long = 1) As Long()
' FUNCTION
' Create 1D matrix (array) of size N, type Long and value
' ARGUMENTS
' Long value - for each element of array
' Long N - number of elements in array
' PROCESSING ACCELERATION
' CONSTANTS
' VARIABLE DECLARATION
Dim Outs() As Long
Dim i As Long
' ARGUMENT VALIDATION
N = max_Long(1, N)
' VARIABLE INSTANTIATION
ReDim Outs(N)
' METHODS
For i = 1 To N
Outs(i) = value
Next
' RETURNS
create_1D_mat_Long = Outs
End Function
Function create_1D_mat_String(Optional value As String = False, Optional N As Long = 1) As String()
' FUNCTION
' Create 1D matrix (array) of size N, type String and value
' ARGUMENTS
' String value - for each element of array
' Long N - number of elements in array
' PROCESSING ACCELERATION
' CONSTANTS
' VARIABLE DECLARATION
Dim Outs() As String
Dim i As Long
' ARGUMENT VALIDATION
N = max_Long(1, N)
' VARIABLE INSTANTIATION
ReDim Outs(N)
' METHODS
For i = 1 To N
Outs(i) = value
Next
' RETURNS
create_1D_mat_String = Outs
End Function
Sub copy_N_mat_String(ByRef data_in() As String, ByRef data_out() As String, ByVal N_in As Long, ByVal N_out As Long)
' FUNCTION
' Copy from one N-dimensional matrix into another all overlapping elements
' ARGUMENTS
' String Matrix data_in - matrix to copy from
' String Matrix data_out - matrix receiving data
' Long N_in - number of dimensions in data_in
' Long N_out - number of dimensions in N_out
' VARIABLE DECLARATION
Dim dims_in() As Long
Dim dims_out() As Long
Dim i As Long
Dim dim_min As Long
Dim x() As Long
Dim N() As Long
' ARGUMENT VALIDATION
If (N_in < 1 Or N_out <> N_in) Then Exit Sub
' VARIABLE INSTANTIATION
dim_min = min_Long(N_in, N_out)
ReDim dims_in(dim_min)
ReDim dims_out(dim_min)
ReDim x(dim_min)
ReDim N(dim_min)
For i = 1 To dim_min
dims_in(i) = SizeArrayDim_String(data_in, i)
dims_out(i) = SizeArrayDim_String(data_out, i)
x(i) = 1
N(i) = min_Long(dims_in(i), dims_out(i))
Next
' METHODS
Do While compare_all_iterators(x, N, dim_min)
set_index_N_mat_String data_out, x, dim_min, get_index_N_mat_String(data_in, x, N_out)
iterate_iterator x, N, dim_min
Loop
End Sub
Sub copy_N_mat_Long(ByRef data_in() As Long, ByRef data_out() As Long, ByVal N_in As Long, ByVal N_out As Long)
' FUNCTION
' Copy from one N-dimensional matrix into another all overlapping elements
' ARGUMENTS
' Long Matrix data_in - matrix to copy from
' Long Matrix data_out - matrix receiving data
' Long N_in - number of dimensions in data_in
' Long N_out - number of dimensions in N_out
' VARIABLE DECLARATION
Dim dims_in() As Long
Dim dims_out() As Long
Dim i As Long
Dim dim_min As Long
Dim x() As Long
Dim N() As Long
' ARGUMENT VALIDATION
If (N_in < 1 Or N_out <> N_in) Then Exit Sub
' VARIABLE INSTANTIATION
dim_min = min_Long(N_in, N_out)
ReDim dims_in(dim_min)
ReDim dims_out(dim_min)
ReDim x(dim_min)
ReDim N(dim_min)
For i = 1 To dim_min
dims_in(i) = SizeArrayDim_Long(data_in, i)
dims_out(i) = SizeArrayDim_Long(data_out, i)
x(i) = 1
N(i) = min_Long(dims_in(i), dims_out(i))
Next
' METHODS
Do While compare_all_iterators(x, N, dim_min)
set_index_N_mat_Long data_out, x, dim_min, get_index_N_mat_Long(data_in, x, N_out)
iterate_iterator x, N, dim_min
Loop
End Sub
Sub copy_N_mat_Variant(ByRef data_in() As Variant, ByRef data_out() As Variant, ByVal N_in As Long, ByVal N_out As Long)
' FUNCTION
' Copy from one N-dimensional matrix into another all overlapping elements
' ARGUMENTS
' Variant Matrix data_in - matrix to copy from
' Variant Matrix data_out - matrix receiving data
' Long N_in - number of dimensions in data_in
' Long N_out - number of dimensions in N_out
' VARIABLE DECLARATION
Dim dims_in() As Long
Dim dims_out() As Long
Dim i As Long
Dim dim_min As Long
Dim x() As Long
Dim N() As Long
' ARGUMENT VALIDATION
If (N_in < 1 Or N_out <> N_in) Then Exit Sub
' VARIABLE INSTANTIATION
dim_min = min_Long(N_in, N_out)
ReDim dims_in(dim_min)
ReDim dims_out(dim_min)
ReDim x(dim_min)
ReDim N(dim_min)
For i = 1 To dim_min
dims_in(i) = SizeArrayDim_Variant(data_in, i)
dims_out(i) = SizeArrayDim_Variant(data_out, i)
x(i) = 1
N(i) = min_Long(dims_in(i), dims_out(i))
Next
' METHODS
Do While compare_all_iterators(x, N, dim_min)
set_index_N_mat_Variant data_out, x, dim_min, get_index_N_mat_Variant(data_in, x, N_out)
iterate_iterator x, N, dim_min
Loop
End Sub
Sub iterate_iterator(ByRef x() As Long, ByRef N() As Long, ByVal NDim As Long)
' FUNCTION
' Increment iterator x under limits N
' ARGUMENTS
' Long Array x - iterator
' Long Array SzDim1 - iterator limits
' Long NDim
' VARIABLE DECLARATION
Dim i As Long
Dim j As Long
' METHODS
For i = NDim To 1 Step -1
If (x(i) < N(i)) Then
x(i) = x(i) + 1
If (i < NDim) Then
For j = i + 1 To NDim
x(j) = 1
Next
End If
Exit Sub
End If
Next
' RETURNS
x(1) = x(1) + 1 ' what is this
End Sub
Function compare_all_iterators(ByRef x() As Long, ByRef N() As Long, ByVal NDim As Long) As Boolean
' FUNCTION
' Are all x(i) <= N(i)
' ARGUMENTS
' Long Array x
' Long Array N
' Long ndim
' VARIABLE DECLARATION
Dim i As Long
' ARGUMENT VALIDATION
compare_all_iterators = False
If (NDim < 1) Then Exit Function
' VARIABLE INSTANTIATION
compare_all_iterators = True
' METHODS
For i = 1 To NDim
If Not (x(i) <= N(i)) Then
compare_all_iterators = False
Exit Function
End If
Next
End Function
Function create_N_mat_String(ByVal N As Long, ByRef dims() As Long) As String()
' FUNCTION
' Create N-dimensional String-type matrix
' ARGUMENTS
' Long N - number of dimensions
' Long Array dims - size of each dimension
' ARGUMENT VALIDATION
If Not N <= SizeArrayDim_Long(dims) Then Exit Function
' VARIABLE INSTANTIATION
Select Case N
Case 1
ReDim create_N_mat_String(max_Long(1, dims(1)))
Case 2
ReDim create_N_mat_String(max_Long(1, dims(1)), max_Long(1, dims(2)))
Case 3
ReDim create_N_mat_String(max_Long(1, dims(1)), max_Long(1, dims(2)), max_Long(1, dims(3)))
Case 4
ReDim create_N_mat_String(max_Long(1, dims(1)), max_Long(1, dims(2)), max_Long(1, dims(3)), max_Long(1, dims(4)))
Case 5
ReDim create_N_mat_String(max_Long(1, dims(1)), max_Long(1, dims(2)), max_Long(1, dims(3)), max_Long(1, dims(4)), max_Long(1, dims(5)))
Case Else:
Exit Function
End Select
End Function
Function create_N_mat_Long(ByVal N As Long, ByRef dims() As Long) As Long()
' FUNCTION
' Create N-dimensional Long-type matrix
' ARGUMENTS
' Long N - number of dimensions
' Long Array dims - size of each dimension
' ARGUMENT VALIDATION
If Not N <= SizeArrayDim_Long(dims) Then Exit Function
' VARIABLE INSTANTIATION
Select Case N
Case 1
ReDim create_N_mat_Long(max_Long(1, dims(1)))
Case 2
ReDim create_N_mat_Long(max_Long(1, dims(1)), max_Long(1, dims(2)))
Case 3
ReDim create_N_mat_Long(max_Long(1, dims(1)), max_Long(1, dims(2)), max_Long(1, dims(3)))
Case 4
ReDim create_N_mat_Long(max_Long(1, dims(1)), max_Long(1, dims(2)), max_Long(1, dims(3)), max_Long(1, dims(4)))
Case 5
ReDim create_N_mat_Long(max_Long(1, dims(1)), max_Long(1, dims(2)), max_Long(1, dims(3)), max_Long(1, dims(4)), max_Long(1, dims(5)))
Case Else:
Exit Function
End Select
End Function
Function create_N_mat_Variant(ByVal N As Long, ByRef dims() As Long) As Variant()
' FUNCTION
' Create N-dimensional Variant-type matrix
' ARGUMENTS
' Long N - number of dimensions
' Long Array dims - size of each dimension
' ARGUMENT VALIDATION
If Not N <= SizeArrayDim_Long(dims) Then Exit Function
' VARIABLE INSTANTIATION
Select Case N
Case 1
ReDim create_N_mat_Variant(max_Long(1, dims(1)))
Case 2
ReDim create_N_mat_Variant(max_Long(1, dims(1)), max_Long(1, dims(2)))
Case 3
ReDim create_N_mat_Variant(max_Long(1, dims(1)), max_Long(1, dims(2)), max_Long(1, dims(3)))
Case 4
ReDim create_N_mat_Variant(max_Long(1, dims(1)), max_Long(1, dims(2)), max_Long(1, dims(3)), max_Long(1, dims(4)))
Case 5
ReDim create_N_mat_Variant(max_Long(1, dims(1)), max_Long(1, dims(2)), max_Long(1, dims(3)), max_Long(1, dims(4)), max_Long(1, dims(5)))
Case Else:
Exit Function
End Select
End Function
Function get_index_N_mat_String(ByRef nd_matrix() As String, ByRef position() As Long, ByVal NDim As Long) As String
' FUNCTION
' Get value from indexed cell of N-dimensional String-type matrix
' ARGUMENTS
' String Matrix nd_matrix
' Long Array position
' Long ndim - number of dimensions in matrix
' VARIABLE DECLARATION
Dim x As Long
' ARGUMENT VALIDATION
get_index_N_mat_String = "Error"
If NDim < 1 Then Exit Function
If Not SizeArrayDim_Long(position) = NDim Then Exit Function
If Not SizeArrayDim_String(nd_matrix, NDim) >= 1 Then Exit Function
For x = 1 To NDim
If Not SizeArrayDim_String(nd_matrix, x) >= position(x) Then Exit Function
If Not position(x) >= 1 Then Exit Function
Next
' METHODS
Select Case NDim
Case 1:
get_index_N_mat_String = nd_matrix(position(1))
Case 2:
get_index_N_mat_String = nd_matrix(position(1), position(2))
Case 3:
get_index_N_mat_String = nd_matrix(position(1), position(2), position(3))
Case 4:
get_index_N_mat_String = nd_matrix(position(1), position(2), position(3), position(4))
Case 5:
get_index_N_mat_String = nd_matrix(position(1), position(2), position(3), position(4), position(5))
Case Else:
Exit Function
End Select
End Function
Function get_index_N_mat_Long(ByRef nd_matrix() As Long, ByRef position() As Long, ByVal NDim As Long) As Long
' FUNCTION
' Get value from indexed cell of N-dimensional Long-type matrix
' ARGUMENTS
' Long Matrix nd_matrix
' Long Array position
' Long ndim - number of dimensions in matrix
' VARIABLE DECLARATION
Dim x As Long
' ARGUMENT VALIDATION
get_index_N_mat_Long = "Error"
If NDim < 1 Then Exit Function
If Not SizeArrayDim_Long(position) = NDim Then Exit Function
If Not SizeArrayDim_Long(nd_matrix, NDim) >= 1 Then Exit Function
For x = 1 To NDim
If Not SizeArrayDim_Long(nd_matrix, x) >= position(x) Then Exit Function
If Not position(x) >= 1 Then Exit Function
Next
' METHODS
Select Case NDim
Case 1:
get_index_N_mat_Long = nd_matrix(position(1))
Case 2:
get_index_N_mat_Long = nd_matrix(position(1), position(2))
Case 3:
get_index_N_mat_Long = nd_matrix(position(1), position(2), position(3))
Case 4:
get_index_N_mat_Long = nd_matrix(position(1), position(2), position(3), position(4))
Case 5:
get_index_N_mat_Long = nd_matrix(position(1), position(2), position(3), position(4), position(5))
Case Else:
Exit Function
End Select
End Function
Function get_index_N_mat_Variant(ByRef nd_matrix() As Variant, ByRef position() As Long, ByVal NDim As Long) As Variant
' FUNCTION
' Get value from indexed cell of N-dimensional Variant-type matrix
' ARGUMENTS
' Variant Matrix nd_matrix
' Long Array position
' Long ndim - number of dimensions in matrix
' VARIABLE DECLARATION
Dim x As Long
' ARGUMENT VALIDATION
get_index_N_mat_Variant = "Error"
If NDim < 1 Then Exit Function
If Not SizeArrayDim_Long(position) = NDim Then Exit Function
If Not SizeArrayDim_Variant(nd_matrix, NDim) >= 1 Then Exit Function
For x = 1 To NDim
If Not SizeArrayDim_Variant(nd_matrix, x) >= position(x) Then Exit Function
If Not position(x) >= 1 Then Exit Function
Next
' METHODS
Select Case NDim
Case 1:
get_index_N_mat_Variant = nd_matrix(position(1))
Case 2:
get_index_N_mat_Variant = nd_matrix(position(1), position(2))
Case 3:
get_index_N_mat_Variant = nd_matrix(position(1), position(2), position(3))
Case 4:
get_index_N_mat_Variant = nd_matrix(position(1), position(2), position(3), position(4))
Case 5:
get_index_N_mat_Variant = nd_matrix(position(1), position(2), position(3), position(4), position(5))
Case Else:
Exit Function
End Select
End Function
Sub set_index_N_mat_String(ByRef nd_matrix() As String, ByRef position() As Long, ByVal NDim As Long, ByVal vNew As String)
' FUNCTION
' Get value from indexed cell of N-dimensional String-type matrix
' ARGUMENTS
' String Matrix nd_matrix
' Long Array position
' Long ndim - number of dimensions in matrix
' VARIABLE DECLARATION
Dim x As Long
' ARGUMENT VALIDATION
' get_index_N_mat_String = "Error"
If NDim < 1 Then Exit Sub
If Not SizeArrayDim_Long(position) = NDim Then GoTo exitsub
If Not SizeArrayDim_String(nd_matrix, NDim) >= 1 Then GoTo exitsub
For x = 1 To NDim
If Not SizeArrayDim_String(nd_matrix, x) >= position(x) Then GoTo exitsub
If Not position(x) >= 1 Then GoTo exitsub
Next
' METHODS
Select Case NDim
Case 1:
nd_matrix(position(1)) = vNew
Case 2:
nd_matrix(position(1), position(2)) = vNew
Case 3:
nd_matrix(position(1), position(2), position(3)) = vNew
Case 4:
nd_matrix(position(1), position(2), position(3), position(4)) = vNew
Case 5:
nd_matrix(position(1), position(2), position(3), position(4), position(5)) = vNew
Case Else:
Exit Sub
End Select
Exit Sub
exitsub:
MsgBox "Error"
End Sub
Sub set_index_N_mat_Long(ByRef nd_matrix() As Long, ByRef position() As Long, ByVal NDim As Long, ByVal vNew As Long)
' FUNCTION
' Get value from indexed cell of N-dimensional String-type matrix
' ARGUMENTS
' Long Matrix nd_matrix
' Long Array position
' Long ndim - number of dimensions in matrix
' VARIABLE DECLARATION
Dim x As Long
' ARGUMENT VALIDATION
' get_index_N_mat_String = "Error"
If NDim < 1 Then Exit Sub
If Not SizeArrayDim_Long(position) = NDim Then GoTo exitsub
If Not SizeArrayDim_Long(nd_matrix, NDim) >= 1 Then GoTo exitsub
For x = 1 To NDim
If Not SizeArrayDim_Long(nd_matrix, x) >= position(x) Then GoTo exitsub
If Not position(x) >= 1 Then GoTo exitsub
Next
' METHODS
Select Case NDim
Case 1:
nd_matrix(position(1)) = vNew
Case 2:
nd_matrix(position(1), position(2)) = vNew
Case 3:
nd_matrix(position(1), position(2), position(3)) = vNew
Case 4:
nd_matrix(position(1), position(2), position(3), position(4)) = vNew
Case 5:
nd_matrix(position(1), position(2), position(3), position(4), position(5)) = vNew
Case Else:
Exit Sub
End Select
Exit Sub
exitsub:
MsgBox "Error"
End Sub
Sub set_index_N_mat_Variant(ByRef nd_matrix() As Variant, ByRef position() As Long, ByVal NDim As Long, ByVal vNew As Variant)
' FUNCTION
' Get value from indexed cell of N-dimensional String-type matrix
' ARGUMENTS
' Variant Matrix nd_matrix
' Long Array position
' Long ndim - number of dimensions in matrix
' VARIABLE DECLARATION
Dim x As Long
' ARGUMENT VALIDATION
' get_index_N_mat_String = "Error"
If NDim < 1 Then GoTo exitsub
If Not SizeArrayDim_Long(position) = NDim Then GoTo exitsub
If Not SizeArrayDim_Variant(nd_matrix, NDim) >= 1 Then GoTo exitsub
For x = 1 To NDim
If Not SizeArrayDim_Variant(nd_matrix, x) >= position(x) Then GoTo exitsub
If Not position(x) >= 1 Then GoTo exitsub
Next
' METHODS
Select Case NDim
Case 1:
nd_matrix(position(1)) = vNew
Case 2:
nd_matrix(position(1), position(2)) = vNew
Case 3:
nd_matrix(position(1), position(2), position(3)) = vNew
Case 4:
nd_matrix(position(1), position(2), position(3), position(4)) = vNew
Case 5:
nd_matrix(position(1), position(2), position(3), position(4), position(5)) = vNew
Case Else:
Exit Sub
End Select
Exit Sub
exitsub:
MsgBox "Error"
End Sub
Sub convert_1D_Variant_2_String(ByRef input_array() As Variant, ByRef return_array() As String)
' FUNCTION
' Convert 1D Variant array to 1D String array
' ARGUMENTS
' Variant Array input_array
' String Array return_array
' VARIABLE DECLARATION
Dim N As Long
Dim i As Long
' ARGUMENT VALIDATION
If ((Not input_array) = -1) Then
ReDim return_array(1)
return_array(1) = "Error"
Exit Sub
End If
' VARIABLE INSTANTIATION
N = SizeArrayDim_Variant(input_array)
ReDim return_array(N)
' METHODS
For i = 1 To N
return_array(i) = CStr(input_array(i))
Next
End Sub
Sub convert_1D_Variant_2_Long(ByRef input_array() As Variant, ByRef return_array() As Long)
' FUNCTION
' Convert 1D Variant array to 1D Long array
' ARGUMENTS
' Variant Array input_array
' Long Array return_array
' VARIABLE DECLARATION
Dim N As Long
Dim i As Long
' ARGUMENT VALIDATION
If ((Not input_array) = -1) Then
ReDim return_array(1)
return_array(1) = "Error"
Exit Sub
End If
' VARIABLE INSTANTIATION
N = SizeArrayDim_Variant(input_array)
ReDim return_array(N)
' METHODS
For i = 1 To N
return_array(i) = CStr(input_array(i))
Next
End Sub
Sub convert_2D_Variant_2_String(ByRef input_array() As Variant, ByRef return_array() As String)
' FUNCTION
' Convert 2D matrix from Variant to String
' ARGUMENTS
' Variant Array input_array
' String Array return_array
' VARIABLE DECLARATION
Dim N(2) As Long
Dim i As Long
Dim j As Long
' ARGUMENT VALIDATION
If ((Not input_array) = -1) Then
ReDim return_array(1)
return_array(1) = "Error"
Exit Sub
End If
' VARIABLE INSTANTIATION
' ReDim N(2)
N(1) = SizeArrayDim_Variant(input_array, 1)
N(2) = SizeArrayDim_Variant(input_array, 2)
ReDim return_array(N(1), N(2))
' METHODS
For i = 1 To N(1)
For j = 1 To N(2)
return_array(i, j) = CStr(input_array(i, j))
Next
Next
End Sub
Sub convert_2D_Variant_2_Long(ByRef input_array() As Variant, ByRef return_array() As Long)
' FUNCTION
' Convert 2D matrix from Variant to Long
' ARGUMENTS
' Variant Array input_array
' Long Array return_array
' VARIABLE DECLARATION
Dim N() As Long
Dim i As Long
Dim j As Long
' ARGUMENT VALIDATION
If ((Not input_array) = -1) Then
ReDim return_array(1)
return_array(1) = "Error"
Exit Sub
End If
' VARIABLE INSTANTIATION
ReDim N(2)
N(1) = SizeArrayDim_Variant(input_array, 1)
N(2) = SizeArrayDim_Variant(input_array, 2)
ReDim return_array(N(1), N(2))
' METHODS
For i = 1 To N(1)
For j = 1 To N(2)
return_array(i, j) = CLng(input_array(i, j))
Next
Next
End Sub
Function last_filled_cell(ByVal array1D As Variant, Optional start As Long = 1, Optional max_i As Long = -1, Optional gap_max As Long = 1, Optional dir_move As dir_traverse = dir_traverse.FORWARDS) As Long
' FUNCTION
' Find last populated cell in 1D array from start to max_i with maximum number of consecutive empty cells gap_max
' ARGUMENTS
' Variant Array array1D
' Long start
' Long max_i
' Long gap_max
' dir_traverse dir_move
' VARIABLE DECLARATION
Dim found_last As Boolean
Dim temp As Variant
Dim gap_count As Long
Dim i As Long
' ARGUMENT VALIDATION
If max_i < 1 Then
max_i = SizeArrayDim_Variant_0(array1D)
End If
If (start < 0 Or start > max_i) Then Exit Function
' VARIABLE INSTANTIATION
If dir_move = FORWARDS Then
i = start - 1
Else
i = max_i
max_i = start
start = i
i = max_i + 1
End If
' METHODS
Do While Not found_last
i = i + 1
If i = max_i Then
found_last = True
ElseIf IsEmpty(array1D(i)) Or array1D(i) = "" Then
gap_count = gap_count + 1
Else
gap_count = 0
End If
If gap_count > gap_max Then
found_last = True
End If
Loop
' RETURNS
last_filled_cell = i - gap_count
End Function
Function max_n_Long(ByRef array1D() As Long, Optional N As Long = 0, Optional start As Long = 1, Optional dir_move As dir_traverse = dir_traverse.FORWARDS) As Long
' FUNCTION
' Maximum Long value in array1D from start up to start + N - 1
' ARGUMENTS
' Long Array array1D
' Long N - number of elements to check
' Long start - first element to check
' VARIABLE DECLARATION
Dim i As Long
Dim max_i As Long
Dim grand_max As Long
' ARGUMENT VALIDATION
start = max_Long(1, start)
max_i = SizeArrayDim_Long(array1D)
If N > 0 Then
If start + N - 1 > max_i Then
MsgBox "Invalid search indices for array of size " & CStr(max_i)
End If
End If
' METHODS
If dir_move = FORWARDS Then
For i = start To max_i
grand_max = max_Long(grand_max, array1D(i))
Next
Else
For i = start To 1 Step -1
grand_max = max_Long(grand_max, array1D(i))
Next
End If
' RETURNS
max_n_Long = grand_max
End Function
Function min_n_Long(ByRef array1D() As Long, Optional N As Long = 0, Optional start As Long = 1, Optional dir_move As dir_traverse = dir_traverse.FORWARDS) As Long
' FUNCTION
' Minimum Long value in array1D from start up to start + N - 1
' ARGUMENTS
' Long Array array1D
' Long N - number of elements to check
' Long start - first element to check
' VARIABLE DECLARATION
Dim i As Long
Dim max_i As Long
Dim grand_min As Long
' ARGUMENT VALIDATION
start = max_Long(1, start)
max_i = SizeArrayDim_Long(array1D)
If N > 0 Then
If start + N - 1 > max_i Then
MsgBox "Invalid search indices for array of size " & CStr(max_i)
End If
End If
' METHODS
If dir_move = FORWARDS Then
For i = start To max_i
grand_min = min_Long(grand_min, array1D(i))
Next
Else
For i = start To 1 Step -1
grand_min = min_Long(grand_min, array1D(i))
Next
End If
' RETURNS
min_n_Long = grand_min
End Function
Function match_Long(ByVal key As Long, ByRef array1D() As Long, Optional start As Long = 1, Optional max_i As Long = 0, Optional dir_move As dir_traverse = dir_traverse.FORWARDS) As Long
' FUNCTION
' Find first or last instance of key in array1D
' ARGUMENTS
' Long key
' Long Array array1D
' Long start
' Long max_i
' dir_traverse dir_move
' VARIABLE DECLARATION
Dim i As Long
' ARGUMENT VALIDATION
If max_i < 1 Then
max_i = SizeArrayDim_Long(array1D)
End If
If (start < 0 Or start > max_i) Then Exit Function
' METHODS
If dir_move = FORWARDS Then
For i = start To max_i
If array1D(i) = key Then
match_Long = i
Exit Function
End If
Next
Else
For i = start To 1 Step -1
If array1D(i) = key Then
match_Long = i
Exit Function
End If
Next
End If
End Function
Function match_String(ByVal key As String, ByRef array1D() As String, Optional start As Long = 1, Optional max_i As Long = 0, Optional dir_move As dir_traverse = dir_traverse.FORWARDS) As Long
' FUNCTION
' Find first or last instance of key in array1D
' ARGUMENTS
' String key
' String Array array1D
' Long start
' Long max_i
' dir_traverse dir_move
' VARIABLE DECLARATION
Dim i As Long
' ARGUMENT VALIDATION
If max_i < 1 Then
max_i = SizeArrayDim_String(array1D)
End If
If (start < 0 Or start > max_i) Then Exit Function
' METHODS
If dir_move = FORWARDS Then
For i = start To max_i
If array1D(i) = key Then
match_String = i
Exit Function
End If
Next
Else
For i = start To 1 Step -1
If array1D(i) = key Then
match_String = i
Exit Function
End If
Next
End If
End Function
Function match_Variant(ByVal key As Variant, ByRef array1D() As Variant, Optional start As Long = 1, Optional max_i As Long = 0, Optional dir_move As dir_traverse = dir_traverse.FORWARDS) As Long
' FUNCTION
' Find first or last instance of key in array1D
' ARGUMENTS
' Variant key
' Variant Array array1D
' Long start
' Long max_i
' dir_traverse dir_move
' VARIABLE DECLARATION
Dim i As Long
' ARGUMENT VALIDATION
If max_i < 1 Then
max_i = SizeArrayDim_Variant(array1D, 2)
End If
If (start < 0 Or start > max_i) Then Exit Function
' METHODS
If dir_move = FORWARDS Then
For i = start To max_i
If array1D(i) = key Then
match_Variant = i
Exit Function
End If
Next
Else
For i = start To 1 Step -1
If array1D(i) = key Then
match_Variant = i
Exit Function
End If
Next
End If
End Function
Function change_array_base_String(ByRef array1D() As String, Optional base_new As Long = 1) As String()
' FUNCTION
' Change base of array1D to new_base, if necessary
' ARGUMENTS
' String Array array1D
' Long base_new
' VARIABLE DECLARATION
Dim base_old As Long
Dim i As Long
Dim N As Long
Dim array_out() As String
' ARGUMENT VALIDATION
N = SizeArrayDim_String(array1D)
If N < 1 Then Exit Function
' VARIABLE INSTANTIATION
base_old = LBound(array1D)
ReDim array_out(N)
' METHODS
If base_old = base_new Then
change_array_base_String = array1D
Exit Function
End If
For i = 1 To N
array_out(base_new + i - 1) = array1D(base_old + i - 1)
Next
' RETURNS
change_array_base_String = array_out
End Function
Function get_1D_strip_N_mat_String(ByRef N_mat() As String, ByVal dimension As Long, ByRef position() As Long) As String()
' FUNCTION
' Get 1D array of String-type N-dimensional matrix with all but one dimension fixed
' ARGUMENTS
' String Array N_mat
' Long dimension - dimension of N-mat to vary
' Long Array position - fixed coordinates
' VARIABLE DECLARATION
Dim Outs() As String
Dim x() As Long
Dim i As Long
Dim N As Long
Dim x_max As Long
Dim p_max As Long
' ARGUMENT VALIDATION
If dimension < 1 Then
MsgBox "Error: Dimension out of range."
Exit Function
End If
p_max = SizeArrayDim_Long(position)
If p_max = 0 Then
MsgBox "Error: Position is nothing."
Exit Function
End If
If (p_max < dimension - 1) Then
MsgBox "Error: Insufficient quantity of dimensions in position for dimension " & CStr(dimension) & "."
Exit Function
End If
x_max = SizeArrayDim_String(N_mat, N)
If x_max = 0 Then
MsgBox "Error: N-dimensional Matrix of insufficient quantity of dimensions."
Exit Function
End If
x_max = SizeArrayDim_String(N_mat, N + 1)
If x_max > 0 Then
MsgBox "Error: N-dimensional Matrix of too many dimensions."
Exit Function
End If
' VARIABLE INSTANTIATION
x_max = SizeArrayDim_String(N_mat, dimension)
ReDim Outs(x_max)
ReDim x(N)
For i = 1 To p_max
x(i) = position(i)
Next
' METHODS
For i = 1 To x_max
x(dimension) = i
Outs(i) = get_index_N_mat_String(N_mat, x, N)
Next
' RETURNS
get_1D_strip_N_mat_String = Outs
End Function
Function get_1D_strip_N_mat_Long(ByRef N_mat() As Long, ByVal dimension As Long, ByRef position() As Long) As Long()
' FUNCTION
' Get 1D array of Long-type N-dimensional matrix with all but one dimension fixed
' ARGUMENTS
' String Array N_mat
' Long dimension - dimension of N-mat to vary
' Long Array position - fixed coordinates
' VARIABLE DECLARATION
Dim Outs() As Long
Dim x() As Long
Dim i As Long
Dim N As Long
Dim x_max As Long
Dim p_max As Long
' ARGUMENT VALIDATION
If dimension < 1 Then
MsgBox "Error: Dimension out of range."
Exit Function
End If
p_max = SizeArrayDim_Long(position)
If p_max = 0 Then
MsgBox "Error: Position is nothing."
Exit Function
End If
If (p_max < dimension - 1) Then
MsgBox "Error: Insufficient quantity of dimensions in position for dimension " & CStr(dimension) & "."
Exit Function
End If
N = max_Long(dimension, p_max)
x_max = SizeArrayDim_Long(N_mat, N)
If x_max = 0 Then
MsgBox "Error: N-dimensional Matrix of insufficient quantity of dimensions."
Exit Function
End If
x_max = SizeArrayDim_Long(N_mat, N + 1)
If x_max > 0 Then
MsgBox "Error: N-dimensional Matrix of too many dimensions."
Exit Function
End If
' VARIABLE INSTANTIATION
x_max = SizeArrayDim_Long(N_mat, dimension)
ReDim Outs(x_max)
ReDim x(N)
For i = 1 To p_max
x(i) = position(i)
Next
' METHODS
For i = 1 To x_max
x(dimension) = i
Outs(i) = get_index_N_mat_Long(N_mat, x, N)
Next
' RETURNS
get_1D_strip_N_mat_Long = Outs
End Function
Function get_1D_strip_N_mat_Variant(ByRef N_mat() As Variant, ByVal dimension As Long, ByRef position() As Long) As Variant()
' FUNCTION
' Get 1D array of Variant-type N-dimensional matrix with all but one dimension fixed
' ARGUMENTS
' String Array N_mat
' Long dimension - dimension of N-mat to vary
' Long Array position - fixed coordinates
' VARIABLE DECLARATION
Dim Outs() As Variant
Dim x() As Long
Dim i As Long
Dim N As Long
Dim x_max As Long
Dim p_max As Long
' ARGUMENT VALIDATION
If dimension < 1 Then
MsgBox "Error: Dimension out of range."
Exit Function
End If
p_max = SizeArrayDim_Long(position)
If p_max = 0 Then
MsgBox "Error: Position is nothing."
Exit Function
End If
If (p_max < dimension - 1) Then
MsgBox "Error: Insufficient quantity of dimensions in position for dimension " & CStr(dimension) & "."
Exit Function
End If
x_max = SizeArrayDim_Variant(N_mat, N)
If x_max = 0 Then
MsgBox "Error: N-dimensional Matrix of insufficient quantity of dimensions."
Exit Function
End If
x_max = SizeArrayDim_Variant(N_mat, N + 1)
If x_max > 0 Then
MsgBox "Error: N-dimensional Matrix of too many dimensions."
Exit Function
End If
' VARIABLE INSTANTIATION
x_max = SizeArrayDim_Variant(N_mat, dimension)
ReDim Outs(x_max)
ReDim x(N)
For i = 1 To p_max
x(i) = position(i)
Next
' METHODS
For i = 1 To x_max
x(dimension) = i
Outs(i) = get_index_N_mat_Variant(N_mat, x, N)
Next
' RETURNS
get_1D_strip_N_mat_Variant = Outs
End Function
Function Mod_Double(ByVal numerator As Double, ByVal denominator As Double) As Double
' FUNCTION
' Modulo method for doubles
' ARGUMENTS
' Double numerator
' Double denominator
' METHODS
Do While numerator > denominator
numerator = numerator - denominator
Loop
Do While numerator < 0
numerator = numerator + denominator
Loop
' RETURNS
Mod_Double = numerator
End Function
Function Div_Double(ByVal numerator As Double, ByVal denominator As Double) As Long
' FUNCTION
' Modular division method for doubles
' ARGUMENTS
' Double numerator
' Double denominator
' VARIABLE DECLARATION
Dim count As Long
' VARIABLE DECLARATION
count = 0
' METHODS
Do While numerator > denominator
count = count + 1
numerator = numerator - denominator
Loop
Do While numerator < 0
count = count - 1
numerator = numerator + denominator
Loop
' RETURNS
Div_Double = count
End Function