Beefy Boxes and Bandwidth Generously Provided by pair Networks
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 "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 on Scrambled Squares Puzzle
Download Code

Log In?
Username:
Password:

What's my password?
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 about the Monastery: (16)
As of 2014-07-31 13:35 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    My favorite superfluous repetitious redundant duplicative phrase is:









    Results (248 votes), past polls