#!/usr/bin/perl
use strict;
use IO::Handle;
STDOUT->autoflush();
STDERR->autoflush();

# Copyright Aug 7, 2008 Alexey Toptygin <alexeyt at freeshell dot org>
# Released under GPL 2.0 and not a later version.

# This code runs a breadth-first brute-force search to solve a sliding
# puzzle in the fewest number of steps, where pieces with the same shape 
# are considered identical as far as detecting solutions.
# Steps are moves of one piece by any path (without moving other pieces).

################## config ##################

# The below config is puzzle #135 in Professor Layton and the Curious Village
# I don't own the copyright to this puzzle; it is included as an example 
# of its class, which I believe is a fair use.

#  | 0 1 2 3 4
#--+----------
# 0| 0 0 3 3 6
# 1| 1 1 4 7
# 2| 1 1 4 8
# 3| 2 2 5 5 9

my $maxx = 4;
my $maxy = 3;

my $starting_pieces = [
  [ [0,3], [1,3] ],
  [ [0,2], [0,1], [1,2], [1,1] ],
  [ [0,0], [1,0] ],
  [ [2,3], [3,3] ],
  [ [2,2], [2,1] ],
  [ [2,0], [3,0] ],
  [ [4,3] ],
  [ [3,2] ],
  [ [3,1] ],
  [ [4,0] ],
];

# if this matches the serialized state, we have a winner
my $winner = qr/\[\[3,1],\[3,2],\[4,1],\[4,2],],/;

my $max_steps = 85;

################## code ##################

sub grid_by_piece {
  my $pieces = shift;
  my $grid;
  for my $i (0..$#$pieces) {
    for my $point (@{$pieces->[$i]}) {
      $grid->[$point->[0]][$point->[1]] = $i;
    }
  }
  return $grid;
}

sub print_pieces {
  my $pieces = shift;
  my $grid = grid_by_piece $pieces;
  print "  |"; for my $x (0..$maxx) { printf "%2.2s", $x; } print "\n";
  print "--+"; for my $x (0..$maxx) { print "--"; } print "\n";
  for my $y (0..$maxy) {
    printf "%2.2s|", $y;
    for my $x (0..$maxx) {
      printf "%2.2s", $grid->[$x][$y];
    }
    print "\n";
  }
  print "\n";
}

sub validate_grid {
  my $pieces = shift;
  my $grid;
  for my $piece (@$pieces) {
    for my $point (@$piece) {
      return 0 if $point->[0] < 0 or $point->[0] > $maxx;
      return 0 if $point->[1] < 0 or $point->[1] > $maxy;
      return 0 if ++$grid->[$point->[0]][$point->[1]] > 1;
    }
  }
  return 1;
}

sub pieces_sorted {
  my $opieces = shift;
  my $npieces;
  for my $piece (@$opieces) {
    push @$npieces,
         [ sort { $a->[0] <=> $b->[0] || $a->[1] <=> $b->[1] } @$piece ];
  }
  [ sort { $a->[0][0] <=> $b->[0][0] || $a->[0][1] <=> $b->[0][1] } @$npieces ];
}

# can't just use Dumper: it doesn't guarantee a unique representation
sub serialize {
  my $pieces = pieces_sorted $_[0];  
  my $stream = '[';
  foreach my $piece (@$pieces) {
    $stream .= '[';
    foreach my $point (@$piece) {
      $stream .= '[';
      $stream .= $point->[0];
      $stream .= ',';
      $stream .= $point->[1];
      $stream .= '],';
    }
    $stream .= '],';
  }
  $stream .= '];';
}

# hash of state => history
my $states = { serialize($starting_pieces) => [ $starting_pieces ] };
# keys of states we haven't propagated yet
my $new_states = [keys %$states];
my $steps = 0;

# some stats on our storage use
my $storage_points = 0;
map { $storage_points += @$_ } @$starting_pieces;
my $storage_pointrefs = $storage_points;
my $storage_staterefs = 1;

while (@$new_states and $steps < $max_steps) {
  my $next_new_states = [];
  for my $ostate (@$new_states) {
    my $opieces = $states->{$ostate}[-1];
    for my $i (0..$#$opieces) {
      my $fifo = [ $opieces ];
      while (my $fpieces = shift @$fifo) {
        for my $delta ([-1,0], [1,0], [0,-1], [0,1]) {
          my $npieces = [ @$fpieces ];
          $npieces->[$i] = [ map
            [$_->[0] + $delta->[0], $_->[1] + $delta->[1]],
            @{$fpieces->[$i]}
          ];
          next unless validate_grid $npieces;
          my $nstate = serialize $npieces;
          next if exists $states->{$nstate};
          $states->{$nstate} = [ @{$states->{$ostate}}, $npieces ];
          push @$next_new_states, $nstate;
          push @$fifo, $npieces;

          $storage_points += @{$npieces->[$i]};
          map { $storage_pointrefs += @$_ } @$npieces;
          $storage_staterefs += @{$states->{$nstate}};

          if ($nstate =~ $winner) {
            for my $step (0..$#{$states->{$nstate}}) {
              print "Step $step\n";
              print_pieces $states->{$nstate}[$step];
            }
            exit 0;
          }
        }
      }
    }
  }
  $steps++;
  $new_states = $next_new_states;

  print "$steps steps: ". @$new_states ."/". keys(%$states) ." states ";
  print $storage_points * 2 + $storage_pointrefs + $storage_staterefs +
          keys(%$states) ." SV ";
  print $storage_points + keys(%$states) * 2 ." AV\n";
}

print "we ain't found shit\n";
if (0) {
  print "dumping reachable states:\n\n";
  for my $state (keys %$states) {
    print_pieces $states->{$state}[-1];
  }
}