Recursively Generate Combinations

bruderbell

Active Member
Joined
Aug 29, 2006
Messages
374
Folks,
I want to build a macro that will load up a VBA macro (permutations()) with all the combinations of x items from a list of y possible items. To start out, I'm trying for all combinations of 4 from a list of 10. I know that I can do nested for loops, but I want a dynamic macro.
I'm trying to learn about recursive programming. A bit of googling led me down that path. I'm not sure if it is the right way to get this done, but below is my attempt so far.

The code starts with 1, stores it, calls itself, adds a 2 (i'm delimiting with hyphens), calls itself, gets a 3, calls itself and gets a 4, then writes out the 4 digit combination. Then I want the code to go back and continue working on the other calls. So it should go back to 1-2-3- and try 5, then write out 1-2-3-5, but it seems that when I am passing the variable it isn't remaining in the old instances. So when the macro gets to 1-2-3-4 and writes out the value, then goes back to try 5 in the fourth element, it isn't starting with 1-2-3...it keeps 1-2-3-4 then tries 5, but then it has more elements than my limit.

Does this make any sense to anyone?

Code:
Sub test()
Dim x As Integer, quantity As Integer, a As String, permutations()
x = Range("A1:B10").Rows.Count
quantity = Range("E2").Value
ReDim permutations(1 To 2, 1 To (WorksheetFunction.Fact(x) / WorksheetFunction.Fact(x - quantity)))
q = perm("-", x, quantity, permutations, 1)

End Sub
Function perm(a As String, x As Integer, quantity As Integer, permutations, i As Integer)

For i = i To x - 1
    'First we check if the proposed value (i) is already in the proposed solution (a)
    If UBound(Split(a, i)) < 1 Then
        If UBound(Split(a, "-")) < quantity + 1 Then
        'find correct value
        a = a & i & "-"
        a = perm(a, x, quantity, permutations, i) 'may want to pass i+1
        Else
        n = 1
            'Next we figure out where in the array we will put the result
            Do While permutations(1, n) <> Empty
            n = n + 1
            Loop
        'write value out to array
        permutations(1, n) = a
        a = "-"
        Exit Function
        End If
    End If
Next i
End Function
 
Last edited:

Some videos you may like

Excel Facts

Excel Can Read to You
Customize Quick Access Toolbar. From All Commands, add Speak Cells or Speak Cells on Enter to QAT. Select cells. Press Speak Cells.

bruderbell

Active Member
Joined
Aug 29, 2006
Messages
374
Folks,
I want to build a macro that will load up a VBA macro (permutations()) with all the combinations of x items from a list of y possible items.

I meant to say, I want the macro to load up the VBA array (Permutations())...
 

JackBean

Active Member
Joined
Nov 1, 2007
Messages
403
bruderbell:

Since permutations and combinations are two different things your use of the terms interchangeably could be confusing to some.

Here are some combinations of 4 from from ABCDEFGHIJ.
ABCD
ABCE
ABCF

Here are all the permutations of ABC:
ABC
ACB
BAC
BCA
CAB
CBA


It appears that you want combinations of for example 4 from 10.
But you want a solution for the general case.

Here is an example of how this can be done without recursion:
Code:
Sub UniqueCombo()
Dim Kol As Long, Num As Long
Num = 10
Kol = 4
Dim J As Long, K As Long, Kombin As Long, Rw As Long
Dim vRw1 As Variant, vRw2 As Variant
ReDim vRw1(1 To Kol)
ReDim vRw2(1 To Kol)
Kombin = Application.WorksheetFunction.Combin(Num, Kol)
For J = 1 To Kol
    vRw1(J) = J
Next
Cells(1, 1).Resize(, Kol) = vRw1
For Rw = 2 To Kombin
    J = Kol
    Do While vRw1(J) = J + Num - Kol
        J = J - 1
    Loop
    vRw2 = vRw1
    vRw2(J) = vRw1(J) + 1
    For K = J + 1 To Kol
        vRw2(K) = vRw2(K - 1) + 1
    Next
    vRw1 = vRw2
    Cells(Rw, 1).Resize(, Kol) = vRw2
Next Rw
End Sub
You can convert the resulting numbers to letters afterwards,
or modify to generate letters.
This shows this can be done without using a number of loops specific to the example,
and without using recursion.
This may be difficult to convert directly to recursion,
by converting loop to recursion as in the simple example below.

You want to learn recursion.
A simple loop can be converted to recursion. A loop for example results in 55:
Code:
Sub test2()
Dim x As Long
For J = 1 To 10
    x = x + J
Next J
Debug.Print x
End Sub
And the corresponding recursion:
Code:
Sub test3()
Dim x As Long
test3a 0, 0
End Sub
Sub test3a(ByVal x As Long, ByVal J As Long)
If J < 11 Then
    test3a x + J, J + 1
Else
    Debug.Print x
End If
End Sub
The Sub test3a can just as well be a Function but there seems to be no advantage with a Function as you used.
Your example is not recursive.
Perm is not called from within Perm.

Your problem can be done with recursion.
You say you want to learn, which may mean you do not the answer given immediately.

Maybe you could learn from a similar problem recently posted in this forum,
involving using recursion to find all permutations of a string:

http://www.mrexcel.com/forum/excel-questions/687852-permutations.html

I see that you are using tab spacing to make the code more readable but you were not consistent. Your variable Q is not defined.
"Option Explicit" placed at the top of the code window makes this required.

A good way to learn recursion is to solve problems with it.
This will be a difficult one if you are not in the habit of using it.
 

bruderbell

Active Member
Joined
Aug 29, 2006
Messages
374
bruderbell:

Since permutations and combinations are two different things your use of the terms interchangeably could be confusing to some.

Here are some combinations of 4 from from ABCDEFGHIJ.
ABCD
ABCE
ABCF

Here are all the permutations of ABC:
ABC
ACB
BAC
BCA
CAB
CBA


It appears that you want combinations of for example 4 from 10.
But you want a solution for the general case.

Here is an example of how this can be done without recursion:
Code:
Sub UniqueCombo()
Dim Kol As Long, Num As Long
Num = 10
Kol = 4
Dim J As Long, K As Long, Kombin As Long, Rw As Long
Dim vRw1 As Variant, vRw2 As Variant
ReDim vRw1(1 To Kol)
ReDim vRw2(1 To Kol)
Kombin = Application.WorksheetFunction.Combin(Num, Kol)
For J = 1 To Kol
    vRw1(J) = J
Next
Cells(1, 1).Resize(, Kol) = vRw1
For Rw = 2 To Kombin
    J = Kol
    Do While vRw1(J) = J + Num - Kol
        J = J - 1
    Loop
    vRw2 = vRw1
    vRw2(J) = vRw1(J) + 1
    For K = J + 1 To Kol
        vRw2(K) = vRw2(K - 1) + 1
    Next
    vRw1 = vRw2
    Cells(Rw, 1).Resize(, Kol) = vRw2
Next Rw
End Sub
You can convert the resulting numbers to letters afterwards,
or modify to generate letters.
This shows this can be done without using a number of loops specific to the example,
and without using recursion.
This may be difficult to convert directly to recursion,
by converting loop to recursion as in the simple example below.

You want to learn recursion.
A simple loop can be converted to recursion. A loop for example results in 55:
Code:
Sub test2()
Dim x As Long
For J = 1 To 10
    x = x + J
Next J
Debug.Print x
End Sub
And the corresponding recursion:
Code:
Sub test3()
Dim x As Long
test3a 0, 0
End Sub
Sub test3a(ByVal x As Long, ByVal J As Long)
If J < 11 Then
    test3a x + J, J + 1
Else
    Debug.Print x
End If
End Sub
The Sub test3a can just as well be a Function but there seems to be no advantage with a Function as you used.
Your example is not recursive.
Perm is not called from within Perm.

Your problem can be done with recursion.
You say you want to learn, which may mean you do not the answer given immediately.

Maybe you could learn from a similar problem recently posted in this forum,
involving using recursion to find all permutations of a string:

http://www.mrexcel.com/forum/excel-questions/687852-permutations.html

I see that you are using tab spacing to make the code more readable but you were not consistent. Your variable Q is not defined.
"Option Explicit" placed at the top of the code window makes this required.

A good way to learn recursion is to solve problems with it.
This will be a difficult one if you are not in the habit of using it.

Thanks. I'll try to digest this
 

strooman

Active Member
Joined
Oct 29, 2013
Messages
314

Watch MrExcel Video

Forum statistics

Threads
1,127,613
Messages
5,625,848
Members
416,139
Latest member
MattBoard

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top