Scrambled Squares Puzzle

[tall_man]

I recently bought a puzzle called Scrambled Squares (tm), which had nine tiles. Each edge of each tile had one half of one of four pictures. The object was to assemble a square in which all the edge pictures matched their corresponding halves.

There are 9! (362880) combinations, and pieces have to be rotated to fit with each other, so it's tedious to solve by hand. I wrote a perl program that tests and eliminates bad fits early, solving the puzzle in less than a second. It makes use of pattern matching to find fitting rotations quickly.

Credits to hawtin who suggested using strings to manage small sets of numbers, in Re: Words that equal numbers.

Here is the program:

use strict;
use List::Util qw(sum);

# Represent the matchables with upper and lower case letters.
# Double the strings so rotations are all represented.
my @tiles = (
   "",         # filler
   "AbDCAbDC", # 1  Top of A, bottom of b, top of D, top of C
   "ABdcABdc", # 2
   "adcbadcb", # 3
   "ABDcABDc", # 4
   "CDbaCDba", # 5
   "AcdBAcdB", # 6
   "DdCBDdCB", # 7
   "AacDAacD", # 8
   "ABcbABcb", # 9
);
my $TOP = 0;
my $RIGHT = 1;
my $BOTTOM = 2;
my $LEFT = 3;

# rotation index
my (@rot, @pick, @tries, @passes, $rotation);
$rot[0] = 0;

sub get_target {
   my ($oldpos, $oldside) = @_;
   # match single constraint
   my $target = substr($tiles[$pick[$oldpos]], $rot[$oldpos] + $oldsid
+e, 1);
   $target =~ tr/A-Da-d/a-dA-D/;
   return $target;
}

sub get_target2 {
   my ($oldpos, $oldside, $oldpos2, $oldside2) = @_;
   # Two contraints in a row, clockwise.
   my $target1 = substr($tiles[$pick[$oldpos]], $rot[$oldpos] + $oldsi
+de, 1);
   my $target2 = substr($tiles[$pick[$oldpos2]], $rot[$oldpos2] + $old
+side2, 1);
   my $target = $target1 . $target2;
   $target =~ tr/A-Da-d/a-dA-D/;
   return $target;
}

sub fit_tile {
   my ($mypos, $tile, $side, $target) = @_;

   $tries[$mypos]++;

   my $ind = index($tiles[$tile], $target);
   return -1 if ($ind < 0);

   $passes[$mypos]++;

   # rotation to have letters match
   my $rotation = ($ind - $side) % 4;

   $pick[$mypos] = $tile;
   $rot[$mypos] = $rotation;
   return $rotation;
}

sub print_solution {
   print 0+$pick[8],":",0+$rot[8]," ",$pick[1],":",$rot[1], " ", $pick
+[2],":",$rot[2],"\n";
   print $pick[7],":",$rot[7]," ",$pick[0],":",$rot[0], " ", $pick[3],
+":",$rot[3],"\n";
   print $pick[6],":",$rot[6]," ",$pick[5],":",$rot[5], " ", $pick[4],
+":",$rot[4],"\n";
   print "\n";
   my $i;
   for $i (0..8) {
      print 0+$tries[$i]," tries, ",0+$passes[$i]," passes for level "
+,$i,"\n";
   }
   print sum(@tries)," total tries\n";
   print sum(@passes)," total passes\n";
}

# Note: the tiles that are not yet assigned
my ($un0, $un1, $un2, $un3, $un4, $un5, $un6, $un7, $un8);
# The current tile number.
my ($p0, $p1, $p2, $p3, $p4, $p5, $p6, $p7, $p8);
# What the tile has to match.
my ($t1, $t2, $t3, $t4, $t5, $t6, $t7, $t8);

# Try to fill in the tiles in the following order:
#    8  1  2
#    7  0  3
#    6  5  4

$un0 = "123456789";
MAJOR:
foreach $p0 (split(//,$un0)) {
   $pick[0] = $p0;
   $tries[0]++;
   $passes[0]++;
   my $un1 = $un0;
   $un1 =~ s/$p0//;
   $t1 = get_target(0, $TOP);  # top of inner tile
   foreach $p1 (split(//,$un1)) {
      $rotation = fit_tile(1, $p1, $BOTTOM, $t1);
      next if ($rotation < 0);
      $un2 = $un1;
      $un2 =~ s/$p1//;
      $t2 = get_target(1, $RIGHT); # side of tile 1
      foreach $p2 (split(//,$un2)) {
         $rotation = fit_tile(2, $p2, $LEFT, $t2);
         next if ($rotation < 0);
         $un3 = $un2;
         $un3 =~ s/$p2//;
         $t3 = get_target2(0, $RIGHT, 2, $BOTTOM); # sides of 0, 2
         foreach $p3 (split(//,$un3)) {
            $rotation = fit_tile(3, $p3, $LEFT, $t3);
            next if ($rotation < 0);
            $un4 = $un3;
            $un4 =~ s/$p3//;
            $t4 = get_target(3, $BOTTOM);
            foreach $p4 (split(//,$un4)) {
               $rotation = fit_tile(4, $p4, $TOP, $t4);
               next if ($rotation < 0);
               $un5 = $un4;
               $un5 =~ s/$p4//;
               $t5 = get_target2(0, $BOTTOM, 4, $LEFT);
               foreach $p5 (split(//,$un5)) {
                  $rotation = fit_tile(5, $p5, $TOP, $t5);
                  next if ($rotation < 0);
                  $un6 = $un5;
                  $un6 =~ s/$p5//;
                  $t6 = get_target(5, $LEFT);
                  foreach $p6 (split(//,$un6)) {
                     $rotation = fit_tile(6, $p6, $RIGHT, $t6);
                     next if ($rotation < 0);
                     $un7 = $un6;
                     $un7 =~ s/$p6//;
                     $t7 = get_target2(0, $LEFT, 6, $TOP);
                     foreach $p7 (split(//,$un7)) {
                        $rotation = fit_tile(7, $p7, $RIGHT, $t7);
                        next if ($rotation < 0);
                        $un8 = $un7;
                        $un8 =~ s/$p7//;
                        $t8 = get_target2(1, $LEFT, 7, $TOP);
                        $p8 = $un8;
                        $rotation = fit_tile(8, $p8, $RIGHT, $t8);
                        next if ($rotation < 0);
                        print_solution();
                        last MAJOR;
                     } # p7, p8
                  } # p6
               } # p5
            } # p4
         } # p3
      } # p2
   } # p1
} # p0

print "Done\n";