#!/usr/bin/perl

sub canonical;

my %tile = 
  (A => [3, 11, 7],
   B => ['3*', 10, 8],
   C => [3, '0*', 7, 7],
   E => ['3*', 2, 10, 8, 8],
   F => [3, 3, 11, 9, 7],
   G => [3, '0*', 9, '6*'],
  );

expand_set(\%tile);
$tile{D} = $tile{C};

#my $target = canonical [6, 4, 4, 2, 2, 0, 10, 10, 8, 8];
my $target = canonical $tile{D}[0];

# A state consists of:
# 1. The current agglomeration of tiles so far
# 2. A hash indicating which primitive tiles have been used up
my $root = [[], {C => undef, D => undef}];

sub dfs {
  my ($root, $children, $aha) = @_;
  my @queue = $root;
  while (@queue) {
    my $next = shift @queue;
    my $s = tile_to_string($next->[0]);
    warn "> $s\n";
    next if $seen{$s}++;
    if ($aha->($next)) {
      return $next;
    } else {
      push @queue, $children->($next);
    }
  }
  return;
}

my $result = dfs($root, \&add_tile, \&win);

if (defined $result) {
  print "Yes: ", join(" ", keys %{$result->[1]}), "\n";

} else {
  print "No.\n";
}

################################################################


sub add_tile {
  my $state = shift;
  my ($c, $used) = @$state;
  my @new;
  my ($i, $n, $action);
  
  if (defined($i = next_to_eliminate($c, $target))) {
    $n = (6 + $c->[$i]) % 12;
    $action = "eliminate";
  } elsif (defined($n = next_to_introduce($c, $target))) {
    $action = "introduce";
  } else { "???" }

  for my $name (keys %tile) {
    next if $used->{$name};  # Can't use same tile twice
    my %used = (%$used, $name => 1);
    for my $tilepos (@{$tile{$name}}) {
      for my $tp (adjust_to($n, $tilepos)) {
        my $new_conf;
        if ($action eq "eliminate") {
          $new_conf = insert_into($c, $i, $tp);
        } elsif ($action eq "introduce") {
          $new_conf = $tp;
        }
        push @new, [$new_conf, \%used];
      }
    }
  }

  return @new;
}

sub win {
  my $state = shift;
  my ($c, $used) = @$state;
  return if defined next_to_eliminate($c, $target);
  return $#$c == $#$target;
}

################################################################

# Look through the tile for a specified value
# reorganize the tile so that that value is first
sub adjust_to {
  my ($val, $tile) = @_;
  my @adjusted;
  for my $i (0 .. $#$tile) {
    next unless $tile->[$i] eq $val;
    my @tile = @$tile;
    push @tile, splice(@tile, 0, $i);
    push @adjusted, [@tile];
  }
  return @adjusted;
}

# given configuration, insert position, and new tile, 
# insert new tile into configuration at given position
# eliminate superfluous motions
sub insert_into {
  my ($c, $pos, $t) = @_;
  my @c = @$c;
  splice @c, $pos+1, 0, @$t;
  my $reducing;
  do {
    $reducing = 0;
    for my $i (-1 .. $#c-1) {
      my ($a, $b) = @c[$i, $i+1];
      my ($an, $as) = ($a =~ /(\d+)(.*)/);
      my ($bn, $bs) = ($b =~ /(\d+)(.*)/);
      next unless abs($an - $bn) == 6;
      next unless $as eq $bs;
      if ($i == -1) {
        pop @c; shift @c;
      } else {
        splice @c, $i, 2;
      }
      $reducing = 1;
      last;
    }
  } while $reducing;
  \@c;
}

sub next_to_eliminate {
  my ($here, $there) = @_;
  for my $i (0 .. $#$here) {
    return $i if $i > $#$there || $here->[$i] ne $there->[$i];
  }
  return;
}

sub next_to_introduce {
  my ($here, $there) = @_;
  return $there->[@$here];
}

sub expand_set {
  my $tiles = shift;
  for my $name (keys %$tiles) {
    my @set;
    for (0 .. 11) {
      push @set,
        rotate($tiles->{$name}, $_),
        rotate(flip($tiles->{$name}), $_);
    }
    $tiles->{$name} = [tile_set(@set)];
  }
}

#convert a tile to a string 
sub tile_to_string {
  my $tile = canonical(shift());
  "@$tile";
}

# Rotate a tile by $rot*30 degrees
sub rotate {
  my ($tile, $rot) = @_;
  my @rot = @$tile;
  for (@rot) {
    my ($n, $star) = /(\d+)(.*)/;
    $_ = (($n + $rot) % 12) . $star;
  }
  \@rot;
}

# Reflect a tile
sub flip {
  my ($tile) = @_;
  my @flip = reverse @$tile;
  for (@flip) {
    my ($n, $star) = /(\d+)(.*)/;
    $_ = (12 - $n) . $star;
  }
  \@flip;
}

sub tile_set {
  my %seen;
  for my $tile (@_) {
    $seen{tile_to_string(canonical $tile)} = $tile;
  }
  values %seen;
}


# reorder a tile into canonical form
sub canonical {
  my $tile = [@{shift()}];
  my $canonical = [@$tile];
  for (0 .. $#$tile) {
    push @$tile, shift @$tile;
    @$canonical = @$tile if tilecmp($tile, $canonical) < 0;
  }
  $canonical;
}

sub tilecmp {
  my ($a, $b) = @_;
  for my $i (0 .. $#$a) {
    return 1 if $i > $#$b;
    my $cmp = $a->[$i] <=> $b->[$i];
    return $cmp if $cmp;
  }
  return -1 if $#$a < $#$b;
  return 0;
}