The point of the algorithm is to only swap two elements at each step (in hopes of producing the most efficient permutation generator).

The basic algorithm is that if you have your original list of elements, @e, then you start by swapping the last element with the element that is currently to it's left. You continue this until the formerly last element is now first.

Once you've done that, you treat the remaining elements as a list of $n-1 items and do the same to it (swap the last element with the one to its left), but you only do one step on this sublist.

Then you swap the last element of @e (currently the first element of the permuted list) with the element to its right (in the permuted list). Keep doing this until the element is at the end again.

Then treat the remaining elements as their own list again and perform the next step on them. If the next step would involve changing directions, then you instead treat the remaining $n-2 elements as their own list and do that sublist's next step, etc.

So you move the last element, via swapping pairs of elements, from the end to the beginning, to the end, etc. When you reach either end, just swapping again would repeat a previous permutation so you need to permute the remaining items. And you do that by following the same pattern.

So it is a like a proof by mathematical induction. You presume that you have a way to permute $n items using only one transposition (swapping of a pair of elements) between each permutation, then with $n+1 items it is easy to produce such a sequence again. You just use swapping to cycle the $n+1st item from end to end in the list and transpose the other $n items using the previous (unspecified) algorithm when required. But the previous algorithm is just the same until you get to just one item (which can't be swapped) and you are done.

I coded up this Perl version of the algorithm from scratch. 

#!/usr/bin/perl -w
use strict;

sub genPermuTranspOrder
{
    # @e is the original (unpermuted) list of elements.
    my @e= @_;

    # @o is the order we want to output the elements.
    # So @e[@o] is the permuted list.
    my @o= (0..$#e);

    # @p is the position of each element in @o,
    # that is, @o = (0..$#e)[@p]
    my @p= (0..$#e);
    # Note that it is also true that @p = (0..$#e)[@o].

    # $d[$n] is the direction we are moving $e[$n].
    my @d= (-1) x @e;

    # We return a code reference (closure) that each time
    # it is called will return the next permutation of @e.
    # Note that the first time this is called, it permutes
    # @e one step, so the calling code must output the
    # original @e before calling the iterator.
    return sub {

        # Start by assuming we'll move the last element of @e.
        my $n= $#e;

        my $j;
        for(;;) {

            # If we move this one, we'd set $p[$n] += $d[$n].
            # So $j is the possible new value for $p[$n].
            $j= $p[$n] + $d[$n];

            # That is okay if $j is in range and
            # we aren't swapping with an element later in @e.
            last   if  0 <= $j  &&  $j <= $#e  &&  $o[$j] < $n;

            # It wasn't okay.  So move this element
            # in the other direction next time.
            $d[$n]= -$d[$n];
            # And move to the left in @e.
            --$n;

            # If we are to the first element in @e
            # then we are done.
            return   if  $n < 1;
        }

        # $p[$n] is the (permuted) position of the $n'th
        # element ($e[$n]) we wish to swap in the direction
        # of $d[$n].  So we want to swap $o[ $p[$n] ] with
        # $o[ $p[$n]+$d[$n] ].  $j is already that second
        # offset so we'll set $i to be the first offset
        # and later we'll swap @o[$i,$j].
        my $i= $p[$n];

        # We need to keep @o = (0..$#e)[@p], so we need
        # swap corresponding elements of @p to match @o.
        # We should swap @p[@o[$i,$j]], but $o[$i] is $n.
        @p[ $n, $o[$j] ]= @p[ $o[$j], $n ];

        @o[$j,$i]= @o[$i,$j];

        # To confuse your instructor, the commented
        # line produces the permutations in a different
        # and strange "transposition order".
        # return @e[@p];

        return @e[@o];
    };
}

# Take $ARGV[0] (default 5) letters from 'a' to permute
my @e= (0,'a'..'z','A'..'Z')[1..($ARGV[0]||5)];
my $iter= genPermuTranspOrder( @e );
do {
    print "@e\n";
} while(  @e= $iter->()  );

[download]

Without cheating, try to predict what the last permutation will be for each size of list.

- tye        

In reply to Re: Steinhaus - Johnson - Trotter Algorithm for Permutations (explain) by tye
in thread Steinhaus - Johnson - Trotter Algorithm for Permutations by dragonchild

Title:
Use:  <p> text here (a paragraph) </p>
and:  <code> code here </code>
to format your post, it's "PerlMonks-approved HTML":


  • Posts are HTML formatted. Put <p> </p> tags around your paragraphs. Put <code> </code> tags around your code and data!
  • Titles consisting of a single word are discouraged, and in most cases are disallowed outright.
  • Read Where should I post X? if you're not absolutely sure you're posting in the right place.
  • Please read these before you post! —
  • Posts may use any of the Perl Monks Approved HTML tags:
    a, abbr, b, big, blockquote, br, caption, center, col, colgroup, dd, del, details, div, dl, dt, em, font, h1, h2, h3, h4, h5, h6, hr, i, ins, li, ol, p, pre, readmore, small, span, spoiler, strike, strong, sub, summary, sup, table, tbody, td, tfoot, th, thead, tr, tt, u, ul, wbr
  • You may need to use entities for some characters, as follows. (Exception: Within code tags, you can put the characters literally.)
            For:     Use:
    & &amp;
    < &lt;
    > &gt;
    [ &#91;
    ] &#93;
  • Link using PerlMonks shortcuts! What shortcuts can I use for linking?
  • See Writeup Formatting Tips and other pages linked from there for more info.