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