Home
 
What's New
Index
Books
Links
Q & A
Newsletter
Banners
 
Feedback
Tip Jar
 
 
 
Old Pages
 
Old Index
Site Map
What's New
 
Books
How To
Tips & Tricks
Tutorials
Stories
Performance
Essays
Links
Q & A
New in VB6
Free Stuff
Pictures
 
 
 
 
 
 
 
TitleRecursively generate permutations of a collection of objects
Keywordspermutation, combination, recursive
CategoriesAlgorithms
 
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.
 
 
Copyright © 1997-2001 Rocky Mountain Computer Consulting, Inc.   All rights reserved.
  Updated