Perl: the Markov chain saw PerlMonks

### Scrambled Squares Puzzle

by tall_man (Parson)
 on Jul 08, 2003 at 14:38 UTC ( #272303=CUFP: print w/replies, xml ) Need Help??

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

Create A New User
Node Status?
node history
Node Type: CUFP [id://272303]
Approved by particle
help
Chatterbox?
and the web crawler heard nothing...

How do I use this? | Other CB clients
Other Users?
Others chilling in the Monastery: (4)
As of 2020-10-24 03:58 GMT
Sections?
Information?
Find Nodes?
Leftovers?
Voting Booth?
My favourite web site is:

Results (242 votes). Check out past polls.

Notices?