# 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();