<< Computer Algorithms | Use Ctrl + or – to enlarge or reduce text size. |

The number of permutations (different orders or arrangements) of N unique items is N factorial:

The number of permutations of N items where r

The programs below are written for the PBCC compiler and can be easily modified for Visual Basic, FORTRAN and any other BASIC-like compiler.

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 1

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 PBMain 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

The Johnson-Trotter algorithm generates all permutations of a set by interchanging

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) thenIn 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 PBMain 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

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:

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 PBMain 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