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.

`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";
`

Comment onScrambled Squares PuzzleDownloadCode