|
|
Title | Recursively generate permutations of a collection of objects |
Keywords | permutation, combination, recursive |
Categories | Algorithms |
|
|
Function GeneratePermutations takes a parameter a collection holding the objects it should permute. It returns a collection containing other collections that contain the permutations.
The function begins by checking its parameter to see if there is only one object to permute. If there is, its only permutation consists of the object itself. The function returns a new collection containing a single collection containing the object.
If there is more than one value, the function loops through each value. GeneratePermutations removes the selected value from the values collection and recursively calls itself to generate the permutations of the remaining items. It then adds those permutations to its results with the removed item stuck in front. It restores the removed value and repeats the process, removing the next value.
Example: Consider the values ABCD. The function starts by removing the value A and recursively generating the permutations of BCD. Those are BCD, BDC, CBD, CDB, DBC, and DCB. Next the function adds the removed value A at the beginning of these to get ABCD, ABDC, ACBD, ACDB, ADBC, and ADCB.
Now the function restores the value A to the collection and removes the next value, B. It recursively generates the permutations of the remaining values ACD: ACD, ADC, CAD, CDA, DAC, DCA. It adds the removed value B to the beginning of those permutations to get BACD, BADC, BCAD, BCDA, BDAC, BCA.
The process continues until the function has generated all of the permutations of the values it was passed.
|
|
' Generate permutations of the values in the
' values collection.
' Return the result through a collection of
' collections that each hold a permutation.
Private Function GeneratePermutations(ByVal values As _
Collection) As Collection
Dim num_values As Integer
Dim i As Integer
Dim j As Integer
Dim k As Integer
Dim first_value As Variant
Dim new_permutations As Collection
Dim results As Collection
Dim new_result As Collection
' See if there is only one value.
If values.Count = 1 Then
' Return a collection containing one
' permutation equal to the single value.
Set results = New Collection
results.Add New Collection
results.Item(1).Add values.Item(1)
Set GeneratePermutations = results
Exit Function
End If
' Build permutations starting with
' each possible first item.
Set results = New Collection
num_values = values.Count
For i = 1 To num_values
' Save this value.
first_value = values.Item(i)
' Remove the item.
values.Remove i
' Generate the permutations of the
' remaining values.
Set new_permutations = GeneratePermutations(values)
' Make permutations by adding first_value
' to the beginning of each of the new
' permutations.
For j = 1 To new_permutations.Count
' Add the first item.
Set new_result = New Collection
new_result.Add first_value
' Add the rest of the items in the jth
' new permutation.
For k = 1 To new_permutations(j).Count
new_result.Add new_permutations(j).Item(k)
Next k
' Add this new permutation to the results.
results.Add new_result
Next j
' Restore the removed value.
If i > values.Count Then
values.Add first_value
Else
values.Add first_value, , i
End If
Next i
' Return the results.
Set GeneratePermutations = results
End Function
|
|
For information on other algorithms, see my book Ready-to-Run Visual Algorithms.
|
|
 |
|
|