#!/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();