# Array analysis problem

• 05-09-2005, 03:59 PM
brouse
Array analysis problem
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 -
• 05-10-2005, 02:19 PM
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...
Code:

```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```