Beefy Boxes and Bandwidth Generously Provided by pair Networks
Problems? Is your data what you think it is?
 
PerlMonks  

Pentominos Solver

by Lexicon (Chaplain)
on Sep 08, 2002 at 19:12 UTC ( #196076=CUFP: print w/ replies, xml ) Need Help??

My friend has this game called Pentominos. It's a tiling game. You have 11 pieces, all shaped like an L with a peg on the back:
 *
**
 **
You have an 8x8 chessboard. The object is to place all 11 pieces in any flat orientation onto the chessboard. After losing too many hours to the thing, I decided to lose some more, but in a productive way, namely de-rusting some of my perl skills (indeed, I haven't been seen here since Azatoth was my level.)

It took about 3 hours to get the base structure, then 6 hours of optimizations (so it'd run in my lifetime) and (lots of) debugging. I'd love to hear anyone's suggestions for optimizations or improvements.

On an Athlon 900 MHz with 1GB ram, it took about 215 seconds, completing around 2.25 million 'boards'. (you'll notice some of them are optimized away, but still counted, and many aren't counted at all... really, the counting is very subjective).

Here goes:

# Pentominos solver use strict; use warnings; use diagnostics; #=================================================================== # Constants and global variables #=================================================================== my $START_TIME = time(); my $SOLVE_COUNT = 0; # counts entrances into the solve() function my $INDEX_MIN = 1; # lowest/highest indexed pentomino my $INDEX_MAX = 11; my $X_MIN = 1; # max/min x/y coordinates on @board my $X_MAX = 6; my $Y_MIN = 2; my $Y_MAX = 6; my $O_MIN = 0; # max and min orientation indicies my $O_MAX = 7; #my @pent; #for (0..10) { $pent[$_] = {x=>0, y=>0, o=>0}; } my @board = ( [ 0, 0, 0, 0, 0, 0, 0, 0 ] , [ 0, 0, 0, 0, 0, 0, 0, 0 ] , [ 0, 0, 0, 0, 0, 0, 0, 0 ] , [ 0, 0, 0, 0, 0, 0, 0, 0 ] , [ 0, 0, 0, 0, 0, 0, 0, 0 ] , [ 0, 0, 0, 0, 0, 0, 0, 0 ] , [ 0, 0, 0, 0, 0, 0, 0, 0 ] , [ 0, 0, 0, 0, 0, 0, 0, 0 ] , ); # # Orientation reference # An array of array of hashes # Each pentomino has a center and occupies 4 extra spaces # of the 8 around the center. The orientations are simply # rotations, then a flip and rotations. # There are 8 possible orientations, 4 occupies spaces each, # and 2 coordinates for each space my @orientation = ( [ {x=>-1, y=>-1}, {x=> 0, y=>-1}, {x=> 0, y=>+1}, {x=>+1, y=> 0} ] +, [ {x=>-1, y=> 0}, {x=>-1, y=>+1}, {x=> 0, y=>-1}, {x=>+1, y=> 0} ] +, [ {x=>-1, y=> 0}, {x=> 0, y=>-1}, {x=> 0, y=>+1}, {x=>+1, y=>+1} ] +, [ {x=>-1, y=> 0}, {x=> 0, y=>+1}, {x=>+1, y=>-1}, {x=>+1, y=> 0} ] +, [ {x=>-1, y=> 0}, {x=> 0, y=>-1}, {x=> 0, y=>+1}, {x=>+1, y=>-1} ] +, [ {x=>-1, y=>-1}, {x=>-1, y=> 0}, {x=> 0, y=>+1}, {x=>+1, y=> 0} ] +, [ {x=>-1, y=>+1}, {x=> 0, y=>-1}, {x=> 0, y=>+1}, {x=>+1, y=> 0} ] +, [ {x=>-1, y=> 0}, {x=> 0, y=>-1}, {x=>+1, y=> 0}, {x=>+1, y=>+1} ] +, ); #=================================================================== # next_position_accross ( x coordinate, y coordinate ) #=================================================================== # From the x,y position, figures the next space from left to right # or, if at the end of the board, the left most space one line up. # If we exceed the topmost line, returns invalid coordinates (-1,-1) # so the calling program knows to back down the pentomino tree and # try again. #=================================================================== sub next_position_accross { my ($x, $y) = @_; if ( ++$x > $X_MAX ) { $x = $X_MIN; if ( ++$y > $Y_MAX ) { return (-1, -1); } } return ( $x, $y ); } #=================================================================== # next_position_diag ( x coordiante, y coordinate ) #=================================================================== # Eventually, in the interest of sexiness and efficiency, we might # impliment a function which tries spaces on diagonals closest to # the origin, but for now the accross function will do. #=================================================================== #sub next_position_diag { } #=================================================================== # insert_piece ( x coordinate, y coordinate, orientation, number ) #=================================================================== # inserts piece into the @board # based on the coord and orientation, marks the spaces on the @board # with the number of the piece filling each spot # suggested calling: # insert_piece($pent[$i]{x}, $pent[$i]{y}, $pent[$i]{o}, $i); #=================================================================== sub insert_piece { my ($x, $y, $o, $n) = @_; my @or = @{$orientation[$o]}; $board[$x][$y] = $n; for my $i (0..3) { $board[$x+$or[$i]{'x'}] [$y+$or[$i]{'y'}] = $n; } } #=================================================================== # delete_piece ( x coordinate, y coordinate, orientation ) #=================================================================== # deletes piece from the @board # based on the coord and orientation, empties the spaces on the # @board by marking them as 0. # suggested calling: # delete_piece($pent[$i]{x}, $pent[$i]{y}, $pent[$i]{o}; #=================================================================== sub delete_piece { my ($x, $y, $o) = @_; my @or = @{$orientation[$o]}; $board[$x][$y] = 0; for my $i (0..3) { $board[$x+$or[$i]{'x'}] [$y+$or[$i]{'y'}] = 0; } } #=================================================================== # check_position ( x coordinate, y coordinate , orientation ) #=================================================================== # Given coordinates on the @board and an index of previously tried # orientations, finds the next orientation possible at that spot, # if any. If not, returns an orientation of -1, indicating the # calling program should try a different spot. #=================================================================== sub check_position { my ($x, $y, $o) = @_; if ($board[$x][$y] > 0) { return -1; } LOOP: for (; $o <= $O_MAX; $o++) { my @or = @{$orientation[$o]}; # print "x=$x, y=$y, o=$o\n"; for my $i (0..3) { # print ("x'=" . ($or[$i]{'x'}) . " y'=" . ($or[$i]{'y'}) . "\n +"); if ($board[$x+$or[$i]{'x'}][$y+$or[$i]{'y'}] > 0) { next LOOP; } } # print "through\n"; return $o; } return -1; } #=================================================================== # print_board () #=================================================================== # Prints the current state of the board #=================================================================== sub print_board { my $t = time(); my $dif = $t-$START_TIME+1; my $rate = $SOLVE_COUNT/$dif; print "$dif seconds elapsed. Rate = $rate. Count = $SOLVE_COUNT\ +n"; print " 01234567\n --------\n"; for my $y (0..7) { print "$y|"; for my $x (0..7) { if ($board[$x][$y] == 0) { print '.'; } else { printf ("%x", $board[$x][$y]); } } print "|\n"; } print " --------\n"; } #=================================================================== # exceeds_hole_count ( index ) #=================================================================== # Support for an optimization technique. We count the holes below # and including a certain diagonal (index'th diagonal). Back in # the code, if the number of holes exceeds the index, return true # else false. # This way, we pack in the pentominos as tightly as possible, and # avoid equivalent, rearranged sets. #=================================================================== sub exceeds_hole_count { my $index = shift; my $count = 0; for my $x (0..7) { for my $y (0..7) { if (($x+$y) > $index ) { last } if ($board[$x][$y] == 0) { $count++ } if ($count > $index ) { return 1 } } } return 0; } #=================================================================== # solve ( index ) #=================================================================== # Driving function of the program, recursive #=================================================================== sub solve { if (!($SOLVE_COUNT % 1000)) { print_board(); } my $index = shift; my $x; if ($index > $X_MAX) {$x=$X_MAX;} else { $x = $index;} # my $x = $X_MIN; my $y = $Y_MIN; $SOLVE_COUNT+=$x; while (1) { my $o = $O_MIN; while (($o = check_position ( $x, $y, $o)) <= $O_MAX) { # print "I=$index, O=$o\n"; if ($o >= 0) { insert_piece ( $x, $y, $o, $index ); # print_board if $index >= 10; if ( $index >= $INDEX_MAX ) { print "Success!\n\n"; print_board(); exit(); } # If piece is efficiently placed, try the next pentomino # (tend to cluster them towards origin) if (!exceeds_hole_count($index)) { solve ($index+1); } delete_piece ( $x, $y, $o ); $o++ } else { last; } } while (1) { ($x, $y) = next_position_accross ( $x, $y ); # print "i=$index, x=$x, y=$y\n"; # if the pentomino has run off the board, we need to backup # and try again. if ($x < 0) { return } $SOLVE_COUNT++; # Start the piece well out onto the board if (($x+$y) < $index) { # print 's'; next }; # Optimization by which piece never starts too far out on board. if (($x+$y) > (2*$index)) { print 'b'; next }; if ($y > $index) { print 'y'; return }; last; } } } solve($INDEX_MIN); print "FAILIURE!\n"; print "COUNT = $SOLVE_COUNT\n"; print_board();
For those of you just dying to know the answer...
  01234567
  --------
0|.122..4.|
1|11122444|
2|13326684|
3|33566888|
4|.3556aa8|
5|7559aab.|
6|77799abb|
7|.799.bb.|
  --------

Edited: ~Mon Sep 9 16:14:35 2002 (GMT) by footpad: Added <readmore> tag, per Consideration.

Comment on Pentominos Solver
Download Code
Re: Pentominos Solver
by beretboy (Chaplain) on Sep 09, 2002 at 00:57 UTC
    Very cool! You may want to checkout Martin Gardners's Hexaflexagons And Other Mathmatical Dieversions. It has a chapter on Pentominos and lots of other interesting things.

    "Sanity is the playground of the unimaginative" -Unknown
Re: Pentominos Solver
by thor (Priest) on Sep 09, 2002 at 12:46 UTC
    You might want to check out Polya's Theorem. It may or may not be worth your time. The gist of Polya's theorem is the enumeration of things under rotations and flips. For instance, let's take a 3x3 board and place an L-shaped triomino on it. The following are considered equivilant:
    ... x.. xx. ... ..x .xx xx. x.. ... .xx ..x ...
    because any one can be obtained from any other by a rotation of the board. This should drastically cut down on the number of boards that you have deal with. Then again, it may not. I haven't used this in years, and it may only be good for counting such things, though my memory tells me otherwise.

    thor

Re: Pentominos Solver
by stefp (Vicar) on Sep 09, 2002 at 15:27 UTC
    Square polyominos were obfuscated a long time ago using regexps. The program won as most creative of the OPC3 : the sources. If you remove the printing code that shows the progression of the search, it is relatively fast too. The trick used is to fold the board to make the problem unidimensional. I used it as a obfuscation trick to use regexp but it can be used as well as a performance boost.

    BTW: there are 12 pentominoes, not eleven. Finding all of them is already quite a challenge.

    You should check a Knuth paper that talks about dancing links to solve polyominoes problems and the N-Queens problem. The best book about about polyominos was written by Samuel Golomb and aptly titled polyominoes.

    -- stefp -- check out TeXmacs wiki

      The board is already kinda unidirectional, albeit in a hacked way. I figure the problem is already either optimally solved or runnable a couple orders of magnatude faster than my code, but researching it would take longer than writing my code, and it just wasn't that important of a project (although I am a math major, and would easily be distracted into researching that as it's own project :). Anyway, here are the three heuristics I used:
      # If piece is efficiently placed, try the next pentomino # (tend to cluster them towards origin) if (!exceeds_hole_count($index)) { solve ($index+1); }
      There are 9 holes in pentominos (I assume that's the mythical 12'th pentomino that you refer to). Clearly we better leave holes sparingly. The exact forumula relates the indexth of the pentomino to the indexth diagonal, namely that there are less than or equal to index holes up to and including the indexth diag.
      ($x, $y) = next_position_accross ( $x, $y ); # if the pentomino has run off the board, backup # and try again. (n_p_a returns (-1,-1) in this case if ($x < 0) { return } $SOLVE_COUNT++; # Start the piece well out onto the board if (($x+$y) < $index) { next };
      A pentomino need never be in a diagonal less than it's index. Pentomino 1 starts in diagonal 2, for instance.
      # Optimization by which piece never starts too far out on board. if (($x+$y) > (2*$index)) { print 'b'; next }; if ($y > $index) { print 'y'; return }; last;
      And we keep them close to home in two ways. First, they need to stay within a radius of twice their index, and second they need never exceed the indexth row. This somewhat prevents reflection across the x-y plane. And now that I've thought about it some more, I have a glimmering of a far more elegant way to capture all that. But that's allright, I have other projects to work on. Back to your post, Regexps would have been super elegant. I'm off to check it out presently. Thanks!

        A math major should know how to search the litterature. especially when the references are spelled out.
        12 pentominoes and a solved 3x20. Straight out from my obfuscation.
        xxxxx x xxx x xx x xx XX XXX x xxx x x xxxx xx xx x xxx x x x xxx x xx xxx xxxx x x x xxx _________________________________________________________ | __| |____________| |__ |___ ___| |________ | | | |__ ___| | _____| |__ | | ______| __|__| | |_____|__|_______|__|_________|__|__|__|________|________|

        -- stefp -- check out TeXmacs wiki

Re: Pentominos Solver
by Anonymous Monk on Jan 21, 2003 at 15:10 UTC
    I wrote one in Pascal in 1986. It took four CPU-*months* on an 80286 to run through the whole solution set. I had to make the program resumable and ran it on any unused IBM AT I could find.

    The normal form is to put all TWELVE pieces into a known 60-unit shape. For a 6x10 rectangle area, there are 2339 unique solutions (with symmetric equivalents filtered out). For a 3x20 rectangle, there are TWO solutions.

    There are two optimizations of note.

    (1) Since there are twelve pieces, and you only want solutions that are unique (with symmetries filtered out), then lock one of the pieces into a single quadrant of the table. If the X-shaped piece stays in the upper left quadrant, then you won't get any equivalent solutions with the whole board flipped horizontally or vertically.

    (2) After you place a piece, look for any neighboring empty spaces. For each neighboring empty space, count the contiguously connected empty spaces. If any such space is not divisible by five, then you know you'll fail to put all the remaining pieces. Abort the current piece/position and move on.

Log In?
Username:
Password:

What's my password?
Create A New User
Node Status?
node history
Node Type: CUFP [id://196076]
Approved by beretboy
Front-paged by beretboy
help
Chatterbox?
and the web crawler heard nothing...

How do I use this? | Other CB clients
Other Users?
Others pondering the Monastery: (7)
As of 2014-11-23 17:35 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    My preferred Perl binaries come from:














    Results (134 votes), past polls