Beefy Boxes and Bandwidth Generously Provided by pair Networks
Keep It Simple, Stupid
 
PerlMonks  

comment on

( [id://3333]=superdoc: 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";

In reply to Scrambled Squares Puzzle by tall_man

Title:
Use:  <p> text here (a paragraph) </p>
and:  <code> code here </code>
to format your post; it's "PerlMonks-approved HTML":



  • Are you posting in the right place? Check out Where do I post X? to know for sure.
  • Posts may use any of the Perl Monks Approved HTML tags. Currently these include the following:
    <code> <a> <b> <big> <blockquote> <br /> <dd> <dl> <dt> <em> <font> <h1> <h2> <h3> <h4> <h5> <h6> <hr /> <i> <li> <nbsp> <ol> <p> <small> <strike> <strong> <sub> <sup> <table> <td> <th> <tr> <tt> <u> <ul>
  • Snippets of code should be wrapped in <code> tags not <pre> tags. In fact, <pre> tags should generally be avoided. If they must be used, extreme care should be taken to ensure that their contents do not have long lines (<70 chars), in order to prevent horizontal scrolling (and possible janitor intervention).
  • Want more info? How to link or How to display code and escape characters are good places to start.
Log In?
Username:
Password:

What's my password?
Create A New User
Domain Nodelet?
Chatterbox?
and the web crawler heard nothing...

How do I use this?Last hourOther CB clients
Other Users?
Others drinking their drinks and smoking their pipes about the Monastery: (9)
As of 2024-04-18 14:58 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    No recent polls found