extract user-defined dimensions from multidimension array - arrays

Question

I need a function to extract 2 dimensions from a multidimesion array. which 2 dimensions to extract depending on the choise of the user. and the index in the discarded dimensions where those 2 dimensions are picked also depending on the user.
For example, i have a 3 dimension array v(1 to 100, 1 to 20, 1 to 10). i would like to extrat dimension 1 and dimension 3 from v. and the index in the discared dimension 2 is 11.
sub extract
dim i1 as integer 'for loop through dimension 1
dim i2 as integer 'for loop through dimension 3
dim d1 as integer 'index in dimension 2
d1=11
redim vn(1 to ubound(v,1),1 to ubound (v,3))
for i1 = 1 to ubound(v,1)
for i2= 1 to ubound(v,3)
vn(i1,i2)=v(i1,d1,i2)
next i2
next i1
end sub
I can extract dimensions from array, if i know which dimensions i need and the index (d1) in the discarded dimensions. however, i need to leave that to the users to decide. what i want is a function like that:
function extract(i1 as integer, i2 as intger, paramarray ov()) as variant
=extract(the_first_dimension_to_keep,the_second_dimension_to_keep,[index_in_the_first_discard_dimension,index_in_the_second_discard_dimension,...])
Keeping in mind that the origional array can have more than 3 dimensions, so list all the possibility in the code is not possible.
Any solution?

Answer 1

The quickest way would be to read the array with a pointer and increment the pointer value by an algorithmic value based on the number of dimensions and number of elements in each. This site has an excellent tutorial on managing pointers to arrays: http://bytecomb.com/vba-internals-getting-pointers. However, it'd be one mighty coding task - just dimensioning the rgabounds of your SAFEARRAY for the memory read would be a task - and if your array values were Strings, it'd be of an order of magnitude mightier.
An easier, though doubtless slower, option would be to exploit the For Each looping method, which can be applied to an array. Its looping sequence is like so:
arr(1,1)
arr(2,1)
arr(3,1)
arr(1,2)
arr(2,2)
arr(3,2)
etc.
So you'd only need a simple odometer-style index counter.
You could basically iterate every element in the array and if the combination of indexes matched what you wanted, you'd read the element into your extraction array. That would be a much easier task. The code below shows you how you could do this on a multi-dimensional array of unknown dimensions.
Option Explicit
Private Type ArrayBounds
Lower As Long
Upper As Long
Index As Long
WantedDimension As Boolean
DiscardIndex As Long
End Type
Public Sub RunMe()
Dim arr As Variant
Dim result As Variant
arr = CreateDummyArray
result = Extract(arr, 1, 3, 11)
End Sub
Private Function Extract(arr As Variant, i1 As Integer, i2 As Integer, ParamArray ov() As Variant) As Variant
Dim d As Long
Dim bounds() As ArrayBounds
Dim i As Long
Dim v As Variant
Dim ovIndex As Long
Dim doExtract As Boolean
Dim result() As Variant
'Dimension the output array
ReDim result(LBound(arr, i1) To UBound(arr, i1), LBound(arr, i2) To UBound(arr, i2))
'Get no. of dimensions in array
d = GetDimension(arr)
'Now we know the number of dimensions,
'we can check that the passed parameters are correct
If (i1 < 1 Or i1 > d) Or (i2 < 1 Or i2 > d) Then
MsgBox "i1/i2 - out of range"
Exit Function
End If
If UBound(ov) - LBound(ov) + 1 <> d - 2 Then
MsgBox "ov - wrong number of args"
Exit Function
End If
'Resise and populate the bounds type array
ReDim bounds(1 To d)
ovIndex = LBound(ov)
For i = 1 To d
With bounds(i)
.Lower = LBound(arr, i)
.Upper = UBound(arr, i)
.Index = .Lower
.WantedDimension = (i = i1) Or (i = i2)
If Not .WantedDimension Then
.DiscardIndex = ov(ovIndex)
ovIndex = ovIndex + 1
'Check index is in range
If .DiscardIndex < .Lower Or .DiscardIndex > .Upper Then
MsgBox "ov - out of range"
Exit Function
End If
End If
End With
Next
'Iterate each member of the multi-dimensional array with a For Each
For Each v In arr
'Check if this combination of indexes is wanted for extract
doExtract = True
For i = 1 To d
With bounds(i)
If Not .WantedDimension And .Index <> .DiscardIndex Then
doExtract = False
Exit For
End If
End With
Next
'Write value into output array
If doExtract Then
result(bounds(i1).Index, bounds(i2).Index) = v
End If
'Increment the dimension index
For i = 1 To d
With bounds(i)
.Index = .Index + 1
If .Index > .Upper Then .Index = .Lower Else Exit For
End With
Next
Next
Extract = result
End Function
Private Function GetDimension(arr As Variant) As Long
'Helper function to obtain number of dimensions
Dim i As Long
Dim test As Long
On Error GoTo GotIt
For i = 1 To 60000
test = LBound(arr, i)
Next
Exit Function
GotIt:
GetDimension = i - 1
End Function