1
1, 2
1, 2, 3
1, 2, 3, 4
1, 2, 3, 5
1, 2, 3, 4, 5
1, 2, 4
1, 2, 4, 5
1, 2, 5
1, 3
1, 3, 4
1, 3, 4, 5
1, 3, 5
1, 4
1, 4, 5
1, 5
2
2, 3
2, 3, 4
2, 3, 4, 5
2, 3, 5
2, 4
2, 4, 5
2, 5
3
3, 4
3, 4, 5
3, 5
4
4, 5
5
Similar for dog, cat, house
--
Gary's Student
Code previously posted by Myrna Larson. Not a complete solution, but you
could run it multiple times with different number of values in the subsets.
--
Regards,
Tom Ogilvy
"Gary's Student" <GarysS...@discussions.microsoft.com> wrote in message
news:1FD10426-1802-47E1...@microsoft.com...
Have a look at this:
http://www.excelforum.com/archive/index.php/t-258299.html
Regards,
KL
"Gary's Student" <GarysS...@discussions.microsoft.com> wrote in message
news:1FD10426-1802-47E1...@microsoft.com...
You could use a Gray code - which is what your example seems to be
trying to do:
Option Explicit
Function ListSubsets(Items As Variant) As String
Dim CodeVector() As Integer
Dim i As Integer
Dim lower As Integer, upper As Integer
Dim SubList As String
Dim NewSub As String
Dim done As Boolean
Dim OddStep As Boolean
OddStep = True
lower = LBound(Items)
upper = UBound(Items)
ReDim CodeVector(lower To upper) 'it starts all 0
Do Until done
'Add a new subset according to current contents
'of CodeVector
NewSub = ""
For i = lower To upper
If CodeVector(i) = 1 Then
If NewSub = "" Then
NewSub = Items(i)
Else
NewSub = NewSub & ", " & Items(i)
End If
End If
Next i
If NewSub = "" Then NewSub = "{}" 'empty set
SubList = SubList & vbCrLf & NewSub
'now update code vector
If OddStep Then
'just flip first bit
CodeVector(lower) = 1 - CodeVector(lower)
Else
'first locate first 1
i = lower
Do While CodeVector(i) <> 1
i = i + 1
Loop
'done if i = upper:
If i = upper Then
done = True
Else
'if not done then flip the *next* bit:
i = i + 1
CodeVector(i) = 1 - CodeVector(i)
End If
End If
OddStep = Not OddStep 'toggles between even and odd steps
Loop
ListSubsets = SubList
End Function
Sub TestThis()
Dim i As Integer
Dim A(3 To 7) As Integer
Dim B As Variant
For i = 3 To 7
A(i) = i
Next i
B = Array("dog", "cat", "mouse", "zebra")
MsgBox ListSubsets(A)
MsgBox ListSubsets(B)
End Sub
If you run TestThis, then for example the second message box returns
{}
dog
dog, cat
cat
cat, mouse
dog, cat, mouse
dog, mouse
mouse
mouse, zebra
dog, mouse, zebra
dog, cat, mouse, zebra
cat, mouse, zebra
cat, zebra
dog, cat, zebra
dog, zebra
zebra
Hope this helps,
John Coleman
p.s. The algorithm used to generate the Gray code comes from the
excellent book "Combinatorial Algorithms: Generation, Enumeration and
Search" by Kreher and Stinson.
I'll look for your reccomended book
--
Gary's Student