Source code in the perl programming language

use strict;
use warnings;

# This code uses "Even's Speedup," as described on
# the Wikipedia page about the Steinhaus–Johnson–
# Trotter algorithm.

# Any resemblance between this code and the Python
# code elsewhere on the page is purely a coincidence,
# caused by them both implementing the same algorithm.

# The code was written to be read relatively easily
# while demonstrating some common perl idioms.

sub perms :prototype(&@) {
   my $callback = shift;
   my @perm = map [$_, -1], @_;
   $perm[0][1] = 0;

   my $sign = 1;
   while( ) {
      $callback->($sign, map $_->[0], @perm);
      $sign *= -1;

      my ($chosen, $index) = (-1, -1);
      for my $i ( 0 .. $#perm ) {
         ($chosen, $index) = ($perm[$i][0], $i)
           if $perm[$i][1] and $perm[$i][0] > $chosen;
      }
      return if $index == -1;

      my $direction = $perm[$index][1];
      my $next = $index + $direction;

      @perm[ $index, $next ] = @perm[ $next, $index ];

      if( $next <= 0 or $next >= $#perm ) {
         $perm[$next][1] = 0;
      } elsif( $perm[$next + $direction][0] > $chosen ) {
         $perm[$next][1] = 0;
      }

      for my $i ( 0 .. $next - 1 ) {
         $perm[$i][1] = +1 if $perm[$i][0] > $chosen;
      }
      for my $i ( $next + 1 .. $#perm ) {
         $perm[$i][1] = -1 if $perm[$i][0] > $chosen;
      }
   }
}

my $n = shift(@ARGV) || 4;

perms {
   my ($sign, @perm) = @_;
   print "[", join(", ", @perm), "]";
   print $sign < 0 ? " => -1\n" : " => +1\n";   
} 1 .. $n;


#!perl
use strict;
use warnings;

sub perms {
   my ($xx) = (shift);
   my @perms = ([+1]);
   for my $x ( 1 .. $xx ) {
      my $sign = -1;
      @perms = map {
         my ($s, @p) = @$_;
         map [$sign *= -1, @p[0..$_-1], $x, @p[$_..$#p]],
            $s < 0 ? 0 .. @p : reverse 0 .. @p;
      } @perms;
   }
   @perms;
}

my $n = shift() || 4;

for( perms($n) ) {
   my $s = shift @$_;
   $s = '+1' if $s > 0;
   print "[", join(", ", @$_), "] => $s\n";
}