LanX has asked for the wisdom of the Perl Monks concerning the following question:

Here a little challenge I found in an old quiz book which I'd like to offer for diversion.

On a 3x4 chess board 3 black and white knights are positioned at opposite ends. 

XXX
...
...
OOO

[download]

What's the minimal number of moves to swap their positions?

Write a Perl program calculating (and proving) an optimal solution and printing all intermediary steps.

Like ... 

OOO 
.X.
...
XX.

[download]

Cheers Rolf
(addicted to the Perl Programming Language and ☆☆☆☆ :)
Je suis Charlie!

Update

Please use <spoiler> tags when posting solutions :)

Replies are listed 'Best First'.
Re: [code challenge] knights move
by BrowserUk (Patriarch) on Jun 21, 2015 at 23:17 UTC

    A couple of questions:

    1. Do moves have to progress black, white, black white; or is any ordering acceptable?
    2. Do you count every move (black or white) as a move; or pairs of moves, 1 black & 1 white, as in some chess descriptions?
    With the rise and rise of 'Social' network sites: 'Computers are making people easier to use everyday'
    Examine what is said, not who speaks -- Silence betokens consent -- Love the truth but pardon error.
    "Science is about questioning the status quo. Questioning authority".
    In the absence of evidence, opinion is indistinguishable from prejudice.
    I'm with torvalds on this Agile (and TDD) debunked I told'em LLVM was the way to go. But did they listen!
[reply]
      1. any ordering

      2. no pairing. (one color might even be moved more often at the end)

      see also Knight's Tour for a similar problem class.

      Cheers Rolf
      (addicted to the Perl Programming Language and ☆☆☆☆ :)
      Je suis Charlie!

[reply]
Re: [code challenge] knights move
by Anonymous Monk on Jun 21, 2015 at 21:48 UTC 
    #!/usr/bin/perl

# http://perlmonks.org/?node_id=1131329 [code challenge] knights move

use strict;
use warnings;

my @queue = my $start = <<endofdata; # find backwards
OOO
...
...
XXX
endofdata

tr/XO/OX/ for my $end = $start;
my %from;
my $count = 0;
my @moves = qw(0-5 0-8 1-6 1-8 2-1 2-6 4-5 4-8 5-6 5-8 6-1 6-6 8-5 10-
+1);

while( $_ = shift @queue and $_ ne $end ) # breadth first search
  {
  for my $move ( @moves )
    {
    my ($skip, $gap) = split /-/, $move;
    for my $new (
      s/^.{$skip}\K(\w)(.{$gap})\./.$2$1/sr,
      s/^.{$skip}\K\.(.{$gap})(\w)/$2$1./sr,
      )
      {
      if( $new ne $_ && !$from{$new} )
        {
        $from{$new} = $_; # keep backtrace
        push @queue, $new;
        }
      }
    }
  }

while( $from{$end} ) # prints in reverse order of found
  {
  $count++;
  print "     $count\n", $end;
  $end eq $start and last;
  $end = $from{$end}; # go back a step
  }

    [download]
[reply]
[d/l]
      Well you provided code but no output.

      And at least one of your allowed moves looks wrong (0-8) or I'm not understanding you're coding system.

      How long does your code run?

      Cheers Rolf
      (addicted to the Perl Programming Language and ☆☆☆☆ :)
      Je suis Charlie!

[reply]

        Just run it. :)

        0-8 means start in upper left corner and go down two and right one. Double check the code, The 0 is the skip from the start of string, and the 8 is the gap (in bytes) between the squares to be swapped.

        This program runs in just under seven seconds on my machine, an AMD Athlon(tm) Dual Core Processor 5050e running at 2.8GHz.

[reply]

        A knight has eight moves, but only four are "forward", which is desired for the regexes. 

        move  gap

  S
E..    1

S..
  E    5

 S
 .
E.     6

S
.
.E     8

        [download]
[reply]
[d/l]
Re: [code challenge] knights move
by Anonymous Monk on Jun 25, 2015 at 16:44 UTC

    Same algorithm, but much faster. 

    #!/usr/bin/perl

# http://perlmonks.org/?node_id=1131329 [code challenge] knights move

use strict;
use warnings;

my @queue = my $start = <<endofdata; # find backwards
OOO
...
...
XXX
endofdata

tr/XO/OX/ for my $end = $start;
my %from;
my $count = 0;

my @changes = map { # make all patterns
  my ($skip, $gap) = map "\0" x $_, split /-/;
  [ "$skip\xff$gap\xff",
    "${skip}.${gap}X", "${skip}X${gap}.", "${skip}v${gap}v",
    "${skip}.${gap}O", "${skip}O${gap}.", "${skip}a${gap}a" ],
  } qw(0-5 0-8 1-6 1-8 2-1 2-6 4-5 4-8 5-6 5-8 6-1 6-6 8-5 10-1);

while( $_ = shift @queue and $_ ne $end ) # breadth first search
  {
  for my $change ( @changes )
    {
    my ($mask, $x, $xrev, $xnew, $o, $orev, $onew) = @$change;
    if( ($mask &= $_) eq $x || $mask eq $xrev )
      {
      $xnew ^= $_;
      $from{$xnew} //= do { push @queue, $xnew; $_ };
      }
    elsif( $mask eq $o || $mask eq $orev )
      {
      $onew ^= $_;
      $from{$onew} //= do { push @queue, $onew; $_ };
      }
    }
  }

my $answer;

while( $from{$end} ) # print in reverse order of found
  {
  $count++;
  if( $answer )
    {
    my @lines = $end =~ /.+/g;
    $answer =~ s/\n/'  ' . shift(@lines) . "\n"/ge;
    }
  else
    {
    $answer = $end;
    }
  $end eq $start and last;
  $end = $from{$end}; # go back a step
  }

printf '%3d' . '  %3d' x ($count-1) . "\n\n", 1..$count;
print $answer;

    [download]
[reply]
[d/l]

Back to Seekers of Perl Wisdom