Heap's Algorithm and Generating Perl Code From Pseudocode

I've been researching recursion lately and in particular, permutations algorithms. This interest was spurred by a real-life case where such an algorithm would come in handy (combinations of @clients, @users, @tickets). I came across Wikipedia's entry for Heap's algorithm and the pseudocode illustrating the algorithm. I found the non-recursive version even more interesting specifically for its lack of needing to call itself, so I chose that version of the algorithm to study.

I thought it would be an interesting exercise to convert the pseudocode to Perl code. While I was converting it I was struck by how closely the Perl code could be made to look like the pseudocode, but also how easy idiomatic Perl made it to skip certain parts of the pseudocode altogether, so I wrote two separate Perl implementations of the algorithm: one to mirror the pseudocode as closely as possible, and one to cut corners using idiomatic Perl.

First, the "pseudocode" version:

 sub output {
     my (@to_print) = @_;
     print join( ',', @to_print ), "\n";
 }

 sub is_even {
     return $_[0] % 2 ? 0 : 1;
 }

 # By referring to $_[0] and $_[1] instead of assigning their values to other
 # variables, we can force pass-by-reference here so that the change will
 # impact @A directly even though we are in a separate function outside its
 # scope.
 sub swap {
     ($_[0],$_[1]) = ($_[1],$_[0]);
 }

 sub generate {
     my ($n, @A) = @_;
     my @c;

     for ( my $i = 0; $i < $n; $i += 1 ) {
         $c[$i] = 0;
     }

     output(@A);

     my $i = 0;
     while ( $i < $n ) {
         if ( $c[$i] < $i ) {
             if ( is_even($i) ) {
                 swap( $A[0], $A[$i] );
             }
             else {
                 swap( $A[ $c[$i] ], $A[$i] );
             }
             output(@A);
             $c[$i] += 1;
             $i = 0;
         }
         else {
             $c[$i] = 0;
             $i += 1;
         } # end if
     } # end while
 }

 generate( 3, 'work', 'sleep', 'play' );

Output:

work,sleep,play
sleep,work,play
play,work,sleep
work,play,sleep
sleep,play,work
play,sleep,work

Next, the idiomatic Perl version:

 sub output {
     print join( ',', @_ ), "\n";
 }

 sub generate {
     # We don't need to pass n here because we have @A. That's not at all
     # unique to Perl of course but the cool part comes later...
     my (@A) = @_;

     # I don't need to specify the length of array @c because as soon as we
     # refer to an element, it exists. I don't need to initialize @c or $i
     # because as soon as we start performing math on their values they will be
     # assumed to start at zero.
     my (@c,$i);

     output(@A);

     # The cool part: we can refer to the length of the @A array as simply @A
     # in scalar context.
     while ( $i < @A ) {
         if ( $c[$i] < $i ) {
             # Test for is_odd by seeing if modulo 2 of $i is non-zero.
             # Since we check for is_odd vs is_even, we swap the code in the
             # if-else.
             if ( $i % 2 ) {
                 # The swap function was handy but idiomatic Perl allows us to
                 # swap variables in place
                 ( $A[ $c[$i] ], $A[$i] ) = ( $A[$i], $A[ $c[$i] ] );
             }
             else {
                 ( $A[0], $A[$i] ) = ( $A[$i], $A[0] );
             }
             output(@A);
             # Nitpicky but it's nice to have ++ instead of += 1. Again, not
             # limited to Perl.
             $c[$i]++;
             $i = 0;
         }
         else {
             $c[$i] = 0;
             $i++;
         }
     }
 }

 generate( split '', 'abc' );

Output:

a,b,c
b,a,c
c,a,b
a,c,b
b,c,a
c,b,a

In what ways could the program be further reduced?

EDIT: A change by an anonymous commenter makes this even more compact:

 sub output {
     print join( ',', @_ ), "\n";
 }

 sub generate {
     my (@A) = @_;

     output(@A);

     while ( $i < @A ) {
         if ( $c[$i] < $i ) {
             my $x = $i % 2 ? $c[ $i ] : 0;
             ( $A[ $x ], $A[$i] ) = ( $A[$i], $A[ $x ] );
             output(@A);
             $c[$i]++;
             $i = 0;
         }
         else {
             $c[$i] = 0;
             $i++;
         }
     }
 }

 generate( split '', 'abcd' );

Tattletale Variables

Sometimes you might be faced with a huge program that, somewhere, is changing a variable's value to something undesired.

 use Data::Dumper;

 sub some_long_faraway_function {
     my $href = shift;
     # Pretend there's a lot of code here I don't want to sift through
     $href->{bananas} = 'some bad value';
 }

 my $shopping_list = {
     apples => 1,
     pears => 3,
     bananas => 5,
 };
 some_long_faraway_function($shopping_list);
 warn Dumper(\$shopping_list);

Output:

$VAR1 = \{
            'apples' => 1,
            'bananas' => 'some bad value',
            'pears' => 3
        };

You don't know where it's being changed, but you need to find out. Change the variable so that it tells you where it's being changed.

 package TattletaleScalar;
 use Carp qw(cluck);
 require Tie::Scalar;
 our @ISA = qw(Tie::StdScalar);
 sub STORE {
     warn "TATTLETALE variable set to {$_[1]}";
     cluck();
     ${$_[0]} = $_[1];
 }

 package main;

 use Data::Dumper;

 sub some_long_faraway_function {
     my $href = shift;
     # Pretend there's a lot of code here I don't want to sift through
     $href->{bananas} = 'some bad value';
 }

 my $shopping_list = {
     apples => 1,
     pears => 3,
     bananas => 5,
 };
 my $tmp = $shopping_list->{bananas}; # Save current value
 tie $shopping_list->{bananas}, 'TattletaleScalar';
 $shopping_list->{bananas} = $tmp; # Restore saved value
 some_long_faraway_function($shopping_list);
 warn Dumper(\$shopping_list);

Now we can see the stack every time the variable is changed:

TATTLETALE variable set to {5} at example.pl line 7.
at example.pl line 8.
    TattletaleScalar::STORE(TattletaleScalar=SCALAR(0x7fac290d3260), 5) called at example.pl line 29
TATTLETALE variable set to {some bad value} at example.pl line 7.
at example.pl line 8.
    TattletaleScalar::STORE(TattletaleScalar=SCALAR(0x7fac290d3260), "some bad value") called at example.pl line 19
    main::some_long_faraway_function(HASH(0x7fac29026508)) called at example.pl line 30
$VAR1 = \{
            'apples' => 1,
            'pears' => 3,
            'bananas' => 'some bad value'
        };

Build Your Memory Palace

Earlier this year, I gave a talk, "Building Your Memory Palace." Here are a few notes about the presentation:

• The presentation itself
• The original slides
• Wikipedia has a good page on Method of loci
• A Google search yields some good How-To videos
• HowStuffWorks has a good write-up