extract user-defined dimensions from multidimension array

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