<< Computer AlgorithmsUse  Ctrl +  or    to enlarge or reduce text size.

How to List All Permutations of a Set and Multiset

Here we describe three ways to generate permutations. The first two are applicable to sets (all elements unique), the third to multisets (repeated elements allowed) as well as sets.

The number of permutations (different orders or arrangements) of N unique items is N factorial:
N!  =  N (N – 1) (N – 2) (N – 3) ... 1

The number of permutations of N items where  r1, r2, r3 ... equal the number of each repeated item is
N! / (r1! r2! r3! ...)

The programs below can be modified for Visual Basic, FORTRAN and any other BASIC-like compiler.

Heap

The Heap algorithm generates all permutations of a set by interchanging two items from one permutation to the next. The list thus generated alternates between “even” and “odd” permutations.

We describe the recursive version of the algorithm. Assume we know how to find all permutations of sets of size  N – 1  and use that to find all permutations of sets of size  N.

Suppose we have N items. We will generate the complete sequence of permutations divided into N groups with each group having the same last item.

Go through the permutations of the first N – 1 items, tacking on the last item each time. Then swap the last item with one of the others according a rule which we give in a moment. Then again go through the permutations of the first N – 1 items, etc. Here is the aforementioned rule for the swap: If N is odd always swap the last item with the first item. If N is even, after the 1st run of permuting the N – 1 items swap it with the 1st item, the 2nd time with the 2nd, etc., until you swap it with the next to last item. After N sets of permutations (only N – 1 swaps), you are done.

Global N As Long                              'constant
Global Item() As String                       'constant
Global count As Long
'------------------------------------------------------------

Sub HeapPermute(index() As Long, s As Long)   'called recursively
 Local i As Long
 If s = 1 Then
  '------------------------------ print out permutation
  For i = 0 To N - 1
   Print " " + Format$(index(i));
  Next
  Print "    ";
  For i = 0 To N - 1
   Print Item(index(i));
  Next
  Print
  '------------------------------
  Incr count
 Else
  If (s \ 2) * 2 = s Then        's is even (s mod 2 = 0)
   For i = 0 To s - 2
    HeapPermute index(), s - 1
    Swap index(s - 1), index(i)
   Next
  Else                           's is odd (s mod 2 = 1)
   For i = 0 To s - 2
    HeapPermute index(), s - 1
    Swap index(s - 1), index(0)
   Next
  End If
  HeapPermute index(), s - 1
 End If
 'in effect i = 0 to s - 1 but exit before last Swap
End Sub
'------------------------------------------------------------

Function Main
 Local i As Long
 N = 4                           '<-- change to suit
 Dim index(N) As Long            'indices pointing into Item()
 Dim Item(N) As String           'constant

 For i = 0 To N - 1              'set up indices
  index(i) = i
 Next

 For i = 0 To N - 1
  Item(i) =  " " + Chr$(i + 65)  '<-- change to suit
 Next

 HeapPermute index(), N
 Print :Print " Count ="; count
 Print " press any key"
 WaitKey$
End Function

Johnson-Trotter

The Johnson-Trotter algorithm generates all permutations of a set by interchanging adjacent elements. It is interesting that this is even possible. As with Heap, the list thus generated alternates between “even” and “odd” permutations. Another feature of the algorithm is that it is cyclical in that the first permutation can be obtained from the last by one more swap.

The algorithm was first discovered in England by 17th century church bell ringers, or at any rate someone who worked with them. They called the method “plain changes” to distinguish it from other, more musical, change ringing methods.

To understand the algorithm first number the N items 1 to N. You can think of these numbers as pointers to the items: 1st, 2nd, 3rd, etc. Any arrangement of the numbers indicates an arrangement of the original items, which might be letters of the alphabet or whatever.

In any given permutation we think of a number as looking either to its left or to its right. We allow a number to swap with another if one of them is both larger than and looking at the other. Call the larger number of the pair “major mobile.”

Set up the first permutation
1  2  3 ... N
with each number looking left, which we indicate by arrows attached to the numbers:
◂1  ◂2  ◂3 ... ◂N
The Johnson-Trotter method uses the arrows to help determine the next permutation in the sequence. Which way the numbers face will change as they proceed from permutation to permutation.

We illustrate how to get from a given permutation and arrows to the next with a particular example. Suppose our sequence has reached
3▸  ◂2  ◂1  4▸
Here’s how to find the next swap and set up the arrows so we can proceed further. Find the largest major mobile number (if there is none we are at the last permutation) then

(1)  swap it with the number it’s facing (along with their arrows),
(2)  for numbers larger than it, reverse the way they face.

In our example
3▸  ◂2  ◂1  4▸
3 and 4 face right, 2 and 1 face left. The largest major mobile number is 3 because it faces right at 2 and is larger than it, while 2 faces 3 but is not larger than it, 1 faces 2 but is not larger than it, and 4 faces right at nothing. Swap the 3 with 2, along with which way they face:
◂2  3▸  ◂1  4▸
then reverse the way all numbers greater than 3 are facing, in this case just 4:
◂2  3▸  ◂1  ◂4
That is the next permutation, or rather it is if we ignore the arrows.

Starting with
◂1  ◂2  ◂3  ◂4
and doing the above repeatedly, eventually you reach
◂2  ◂1  3▸  4▸
and must stop. Disregarding the arrows, the sequence goes through each permutation of  1  2  3  4  exactly once.

Steps (1) and (2) above, the swap and the increments, can be done in either order.

In the program below, instead of having a separate array for the arrows we attach a sign to each number, plus for looking right, minus for left, and when comparing numbers consider only their absolute values. Note that the program performs what we have called above step (2) first because step (1) moves v(k) and it would require extra code to keep track of it.

Function Main
 Local i As Long, k As Long
 Local N As Long, count As Long

 N = 4
 Dim Item(N) As String           'here single letters as an example
 Dim v(N) As Long                'its absolute value is an index into Item()

 For i = 1 To N
  v(i) = -i
  Item(i) = " " + Chr$(i + 64)   '<-- change to suit just so each item is unique
 Next

 Do

  For i = 1 To N                 'print out indices with arrows
   Print v(i);
  Next
  Print "     ";
  For i = 1 To N                 'print out indices
   Print " " + Format$(Abs(v(i)));
  Next
  Print "      ";
  For i = 1 To N                 'print out permutation
   Print Item(Abs(v(i)));
  Next
  Print
  Incr count

  k = 0                          'find largest major mobile
  For i = 2 To N                 'scan numbers looking left
   If v(i) < 0 And Abs(v(i)) > Abs(v(i - 1)) And Abs(v(i)) > Abs(v(k)) Then
    k = i
   End If
  Next
  For i = 1 To N - 1             'scan numbers looking right
   If v(i) > 0 And Abs(v(i)) > Abs(v(i + 1)) And Abs(v(i)) > Abs(v(k)) Then
    k = i
   End If
  Next

  If k Then                      'k <> 0
   For i = 1 To N
    If Abs(v(i)) > Abs(v(k)) Then
     v(i) = -v(i)                'reverse direction if magnitude greater than v(k)
    End If
   Next
   Swap v(k), v(k + Sgn(v(k)))   'swap v(k) with the one it's looking at
  Else
   Exit Do
  End If

 Loop

 Print :Print " Count ="; count
 Print " press any key"
 WaitKey$
End Function

Fischer & Krause

The Fischer & Krause algorithm is more general than the two algorithms described above because it works on multisets which can have duplicate items. Another advantage is that it generates the permutations in lexicographical order.

Start with the items in order, then do the following repeatedly:
(1)  Find the rightmost number smaller than the one to its right. (If none we are done.)
(2)  Find the smallest number to its right larger than it.
(3)  Swap them.
(4)  Reverse the part of the permutation to the right of the number found in the first step above.
In other words:
(1)  Scan from right to left searching for the first i whereitem(i ) < item(i + 1). (If no such i the items are in reverse order and we are done.)
(2)  Scan  item(i + 1)  item(i + 2) ... item(N)  from left to right for the first j where item(j) > item(i).
(3)  Swap item(i) with item(j).
(4)  Reverse the order of  item(i + 1)  item(i + 2) ... item(N).

In order to deal with any items besides numbers, instead of permuting the item array permute an index array pointing to the item array. Compare the  Item(index())  but rearrange only the index(), then  Item(index())  will list the permuted items.

Function Main
 Local i, j, k As Long
 Local N As Long
 Local count As Long

 N = 6                          '<-- change to suit
 Dim Item(N) As String          'Items to permute, here letters
 Dim index(N) As Long

' Specify Items.                 <-- change to suit.
' Must start with them in order to obtain all permutations
 For i = 1 To N
'  Item(i) = " " + Chr$(i + 64)             'A B C D E F
'  Item(i) = " " + Chr$((i + 1) \ 3 + 64)   'A A B B C C
  Item(i) = " " + Chr$((i + 2) \ 3 + 64)   'A A A B B B
 Next

 For j = 1 To N               'initialize pointers into Item()
  index(j) = j
 Next

 count = 0
 GoSub PrintPermutation

 If N = 1 Then                'there is only one permutation
  GoSub PrintCount
  Exit Function
 End If

 Do

  j = N - 1

  Do While Item(index(j)) >= Item(index(j + 1))   'find rightmost decreasing Item
   Decr j
   If j = 0 Then              'there are no more permutations
    GoSub PrintCount
    Exit Function
   End If
  Loop

  i = N
  Do While Item(index(i)) <= Item(index(j))
   Decr i
  Loop

  Swap index(i), index(j)     'swap so increasing

  k = j + 1
  i = N
  Do While k < i              'reverse Items to right of j
   Swap index(k), index(i)
   Incr k
   Decr i
  Loop

  GoSub PrintPermutation
 Loop

PrintPermutation:
  Incr count
  For i = 1 To N
   Print " " + Format$(index(i));
  Next
  Print "    ";
  For i = 1 To N
   Print Item(index(i));
  Next
  Print
  Return

PrintCount:
  Print: Print " Count = "; count
  Print " press any key"
  WaitKey$
  Return
End Function