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
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 permutation1 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 reached3▸ ◂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 example3▸ ◂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