Generate table of combinations
Can anyone point me to an algorithm or VBA code to produce a table of
combination of items. For example if the items are 1,2,3,4,5 then the code would generate: 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 |
Generate table of combinations
http://tinyurl.com/7jqeo
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" wrote in message ... Can anyone point me to an algorithm or VBA code to produce a table of combination of items. For example if the items are 1,2,3,4,5 then the code would generate: 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 |
Generate table of combinations
Hi,
Have a look at this: http://www.excelforum.com/archive/in.../t-258299.html Regards, KL "Gary's Student" wrote in message ... Can anyone point me to an algorithm or VBA code to produce a table of combination of items. For example if the items are 1,2,3,4,5 then the code would generate: 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 |
Generate table of combinations
Thank you both very much.
-- Gary's Student "Tom Ogilvy" wrote: http://tinyurl.com/7jqeo 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" wrote in message ... Can anyone point me to an algorithm or VBA code to produce a table of combination of items. For example if the items are 1,2,3,4,5 then the code would generate: 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 |
Generate table of combinations
Gary's Student wrote: Can anyone point me to an algorithm or VBA code to produce a table of combination of items. For example if the items are 1,2,3,4,5 then the code would generate: 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 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. |
Generate table of combinations
Thank you John.
I'll look for your reccomended book -- Gary's Student "John Coleman" wrote: Gary's Student wrote: Can anyone point me to an algorithm or VBA code to produce a table of combination of items. For example if the items are 1,2,3,4,5 then the code would generate: 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 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. |
All times are GMT +1. The time now is 12:53 PM. |
Powered by vBulletin® Copyright ©2000 - 2024, Jelsoft Enterprises Ltd.
ExcelBanter.com