Array analysis problem

[brouse]

I have an interesting challenge for you all. I have a problem whereby I need to find all possible combinations of the contents of an array, and create a new array with these values. For example, with an array of 3 elements:

["A", "B", "C"]

You would get:

A
B
C
AB
BC
AC
ABC
(and of course, none)

Final count: 2 raised to the power of 3, or an array with 8 elements (different orders of the same combinations don't matter, so we don't differentiate between AC and CA).

So - I could probably figure out a brute-force method to solve this, but can anyone come up with an elegant solution, assuming that the size and contents of the array is unknown at design time? I was thinking there must be some way to do this recursively, but I haven't quite determined the best approach...

BTW - no, this is not a classroom assignment...

Thanks -

[brouse]

Okay, I found a solution, using a recursive function. It's not as clean as I would have liked, but it will suit my purposes. I'm posting it here in case anyone else can benefit from it...

NOTE: Requires a form with one "Command1" button on it...

Private Sub Command1_Click()

    Dim aSource() As String
    Dim aPositions() As String
    Dim aDest() As String
    Dim X As Integer
    Dim strMsg As String
    
    ' Size source array
    ReDim aSource(3)
    
    ' fill with values
    aSource(0) = "A"
    aSource(1) = "B"
    aSource(2) = "C"
    aSource(3) = "D"
    
    ' Call function to get position array
    ReDim aPositions(0)
    ExpandArray 0, UBound(aSource), aPositions()
    
    ' Build destination array based on source and position arrays
    ReDim aDest(UBound(aPositions))
    For X = 0 To UBound(aDest)
    
        ' Fill destination array
        aDest(X) = ArrayPlusPositionToValue(aPositions(X), aSource())
        
        ' just for visual test
        strMsg = strMsg & aDest(X) & vbCrLf
    Next
    
    ' just for visual test
    MsgBox strMsg
    
End Sub

Public Sub ExpandArray(ByVal intStart As Integer, ByVal intEnd As Integer, ByRef aPositions() As String)

    ' Adds entries to array aPositions(), adding value of intStart as a new value,
    ' and adding new entries which are duplicates of existing entries with intStart
    ' added to them
    
    On Error GoTo ErrHandler
    
    Dim X As Integer
    Dim Y As Integer
    Dim intSize As Integer
    Dim intTotal As Integer
    
    ' Get current total entries in the array
    intTotal = UBound(aPositions)
    
    ' Loop through current entries
    For X = 0 To intTotal
    
        ' add array element
        intSize = UBound(aPositions) + 1
        ReDim Preserve aPositions(intSize)
        
        ' add current position
        aPositions(intSize) = aPositions(X) & CStr(intStart)
    Next
    
    ' Move to next position
    intStart = intStart + 1
    
    ' If not past the end, call recursively
    If intStart <= intEnd Then
        ExpandArray intStart, intEnd, aPositions()
    End If
        
    Exit Sub
    
ErrHandler:
    MsgBox "ERROR in ExpandArray() - " & Err.Description, vbOKOnly + vbCritical, "ERROR"
    
End Sub

Public Function ArrayPlusPositionToValue(ByVal strPosString As String, ByRef aSource() As String) As String

    ' Base on strPosString, where each char is an element position within aSource(),
    ' returns a string which is made up of those elements appended together
    
    On Error GoTo ErrHandler
    
    Dim X As Integer
    Dim strOutString As String
    
    ' Loop through string containing positions
    For X = 1 To Len(strPosString)
    
        ' Add array element to output string
        strOutString = strOutString & aSource(Val(Mid$(strPosString, X, 1)))
        
    Next
    
    ' return the string
    ArrayPlusPositionToValue = strOutString
    
    Exit Function
    
ErrHandler:
    MsgBox "ERROR in ArrayPlusPositionToValue() - " & Err.Description, vbOKOnly + vbCritical, "ERROR"
    
End Function