Data commit

Task/Permutations-by-swapping/Perl/permutations-by-swapping-1.pl

@@ -0,0 +1,58 @@
+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;

Task/Permutations-by-swapping/Perl/permutations-by-swapping-2.pl

@@ -0,0 +1,25 @@
+#!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";
+}