comment on

This puzzle (among many others) is discussed in Winning ways for your mathematical plays, volume 4 as "the donkey puzzle". They give general methods for how to attack this kind of puzzles and give a shortcut map for how to solve this particular one from any position to any other.

But to keep the subject more to perl, here is a quick and dirty program I made to solve it. If I didn't make mistakes (unlikely), the solution is 90 moves.

#!/usr/bin/perl -w
use strict;
my $start = <<'EOF';
ABBC
ABBC
 DD 
EFGH
EIJH
EOF
    ;
my (%previous, %letters, @letters, @normalize, @todo);
$start =~ /\n/ || die "No newline in start position\n";
my $line_length = $-[0];
$start =~ /^(.{$line_length}\n)+\z/ || 
    die "Some line is not of length $line_length\n";
while ($start =~ /(\S)/g) {
    push @letters, $1 if !$letters{$1}++;
}

sub normalize {
    my $pos = shift;
    my %seen;
    while ($pos =~ /(\S)/g) {
        next if exists $seen{$1};
        $seen{$1} = keys %seen;
    }
    $pos =~ s/(\S)/$letters[$seen{$1}]/g;
    return $pos;
}

sub push_normalized {
    my ($from, $to) = @_;
    my $normal = normalize($to);
    return if exists $previous{$normal};
    $previous{$normal} = $from;
    solution($to) if $to =~ /BB.\n\z/;
    push @todo, $to;
}

sub solution {
    my $pos = shift;
    my @sequence;
    while (defined($pos)) {
        unshift @sequence, $pos;
        $pos = $previous{normalize($pos)};
    }
    printf "Solution in %d moves\n", $#sequence;
    print $_, "-"x $line_length, "\n" for @sequence;
    exit;
}

sub depth {
    my $pos = shift;
    my $count = 0;
    while (defined($pos)) {
        $pos = $previous{normalize($pos)};
        $count++;
    }
    return $count;
}

sub solve {
    push_normalized(undef, $start);
    my $considered;
    while (defined(my $pos = shift @todo)) {
        print STDERR ("Considering position $considered, now at depth 
+", 
                      depth($pos), "\n$pos") if ++$considered %1000 ==
+ 0;
        # print STDERR "Considering\n$pos";
        for my $letter (@letters) {
            # print STDERR "Letter $letter\n";
            # Move right
            $_ = $pos;
            until (/$letter[^ $letter]/) {
                s/($letter+) / $1/g || 
                    die "Impossible right pos for $letter\n$_";
                # print STDERR "Move right to\n$_";
                push_normalized($pos, $_);
            }
            # Move left
            $_ = $pos;
            until (/(?<![ $letter])$letter/) {
                s/ ($letter+)/$1 /g ||
                    die "Impossible left pos for $letter\n$_";
                # print STDERR "Move left to\n$_";
                push_normalized($pos, $_);
            }
            # Move down
            $_ = $pos;
            until (/$letter(?!.{$line_length}[ $letter])/s) {
                s/(?<=$letter.{$line_length}) /$letter/sg || 
                    die "Impossible down1 pos for $letter\n$_";
                s/(?<!$letter.{$line_length})$letter/ /sg || 
                    die "Impossible down2 pos for $letter\n$_";
                # print STDERR "Move down to\n$_";
                push_normalized($pos, $_);
            }
            # Move up
            $_ = $pos;
            until (/(?<![ $letter].{$line_length})$letter/s) {
                s/ (?=.{$line_length}$letter)/$letter/sg || 
                    die "Impossible up1 pos for $letter\n$_";
                s/$letter(?!.{$line_length}$letter)/ /sg || 
                    die "Impossible up2 pos for $letter\n$_";
                # print STDERR "Move up to\n$_";
                push_normalized($pos, $_);
            }
        }
    }
}

solve();
[download]

_{janitored by ybiC: Balanced <readmore> tags around codeblock to 'hide' solution.}

In reply to Re: Challenge: Setting Sun Puzzle by thospel
in thread Challenge: Setting Sun Puzzle by Limbic~Region

Are you posting in the right place? Check out Where do I post X? to know for sure.
Posts may use any of the Perl Monks Approved HTML tags. Currently these include the following:
<code> <a> <b> <big> <blockquote> <br /> <dd> <dl> <dt> <em> <font> <h1> <h2> <h3> <h4> <h5> <h6> <hr /> <i> <li> <nbsp> <ol> <p> <small> <strike> <strong> <sub> <sup> <table> <td> <th> <tr> <tt> <u> <ul>
Snippets of code should be wrapped in <code> tags not <pre> tags. In fact, <pre> tags should generally be avoided. If they must be used, extreme care should be taken to ensure that their contents do not have long lines (<70 chars), in order to prevent horizontal scrolling (and possible janitor intervention).
Want more info? How to link or How to display code and escape characters are good places to start.


Don't ask to ask, just ask
	PerlMonks