Beefy Boxes and Bandwidth Generously Provided by pair Networks
"be consistent"
 
PerlMonks  

Re: Challenge: Setting Sun Puzzle

by bobf (Monsignor)
on Oct 05, 2004 at 04:35 UTC ( [id://396469]=note: print w/replies, xml ) Need Help??


in reply to Challenge: Setting Sun Puzzle

Very interesting challenge!

Here is my solution. I didn't really make any effort to optimize it (I confess I got a bit lazy and used a few globals), and I'm sure there are some scary parts. If anyone spots something truly evil, please let me know so I can avoid using that construct in the future. I tried to make my code a bit generic so I could apply it to other puzzles as well.

According to this code, there are 2 solutions, each 112 moves in length (where 1 move is defined as moving 1 block exactly one square). Of course, there are many other solutions possible that use more than 112 moves. I am very pleased that the number of steps (112) agrees with previous solutions!

Update: I should note that since the board has left-right symmetry, the "two solutions" are simply mirror images of each other. Thanks to tye for the reminder.

My code:

Update: It seems I introduced a bug when I created some subroutines before I posted it. Darn off-by-1 errors! ;) I fixed the problem, and the updated code is below. It's a little ugly, but it works.

use strict; use warnings; open( OUTFILE, ">results.txt" ) or die "error opening output file"; # grid dimensions (max coord allowed) (used as globals so don't have t +o pass around) # note: this is not the number of cells in the grid, but the max coord + (array index, starts at 0) my $GRID_X_MAX = 3; my $GRID_Y_MAX = 4; # set up starting grid, winning condition, and block definitions # each block has a unique letter, holes are 0 my @start_grid = qw( ABBC ABBC 0DD0 EFGH EIJH ); my %win = ( block => 'B', x => 1, y => 3 ); # upper left corner of blo +ck in winning position my %blocks = ( A => 'b', B => 'd', C => 'b', D => 'c', E => 'b', F => 'a', G => 'a', H => 'b', I => 'a', J => 'a', ); my %blocktypes = ( a => { xsize => 1, ysize => 1 }, b => { xsize => 1, ysize => 2 }, c => { xsize => 2, ysize => 1 }, d => { xsize => 2, ysize => 2 }, ); # xmove and ymove are used to adjust the coords # directions: up = u, down = d, left = l, right = r my %movemts = ( u => { undo => 'd', xmove => 0, ymove => -1 }, d => { undo => 'u', xmove => 0, ymove => 1 }, l => { undo => 'r', xmove => -1, ymove => 0 }, r => { undo => 'l', xmove => 1, ymove => 0 } ); my @current_options = ( [ 'start', @start_grid ] ); my ( %seen_grid, @winners ); while( scalar @winners == 0 ) { print "testing ", scalar @current_options, " options, "; my @next_options; foreach my $option ( @current_options ) { my ( $path, @grid ) = @{ $option }; my @next_moves = find_next_moves( \@winners, $path, @grid ); foreach my $move ( @next_moves ) { my $dir = shift @{ $move }; my $gridkey = join( '', @{ $move } ); # genericize the block pattern for uniqueness $gridkey =~ tr/ABCDEFGHIJ/bdbcbaabaa/; # this could be bui +lt from %blocks if( not exists $seen_grid{$gridkey} ) { push( @next_options, [ join( '-', $path, $dir ), @{ $m +ove } ] ); $seen_grid{$gridkey}++; } } } print "found ", scalar @next_options, " options\n"; @current_options = @next_options; } foreach my $option ( @winners ) { my $path = shift @{ $option }; print OUTFILE "$path\n"; print OUTFILE ' ', join( "\n ", @{ $option } ), "\n"; } close OUTFILE; sub find_next_moves { my ( $ref2winners, $path, @grid ) = @_; my $last = substr( $path, -2 ); # create @orig_grid: $orig_grid[$y][$x] = $block # identify holes: [ $x, $y ], [...], ... # %blockpos: find the upper left corner of each block my ( @orig_grid, @holes, %blockpos ); process_grid( \@orig_grid, \@holes, \%blockpos, @grid ); # find blocks next to holes, store the dir they can move to fill t +he hole my %possible_blocks = find_blocks_to_move( \@orig_grid, \@holes ); # make sure the possible moves are valid (they don't overlap with +another block) my @new_opts = (); my ( $lastblock, $lastdir ) = split( '', $last ); foreach my $block ( keys %possible_blocks ) { my @moves = split( '', $possible_blocks{$block} ); MOVE: foreach my $move ( @moves ) { if( $block eq $lastblock and $movemts{$move}{undo} eq $las +tdir ) { next MOVE; # skip if undos last move } my ( $ref2newgrid, @new_grid_string ) = calc_new_grid( $bl +ock, $move, \@orig_grid ); if( not defined $ref2newgrid ) { next MOVE; } my $blockmove = join( '', $block, $move ); push( @new_opts, [ $blockmove, @new_grid_string ] ); if( grid_is_winner( $ref2newgrid ) ) { push( @{ $ref2winners }, [ join( '-', $path, $blockmov +e ), @new_grid_string ] ); } } } return ( @new_opts ); } sub process_grid { my ( $ref2grid, $ref2holes, $ref2blockpos, @grid ) = @_; for( my $y = 0; $y <= $GRID_Y_MAX; $y++ ) { @{ ${ $ref2grid }[$y] } = split( '', $grid[$y] ); for( my $x = 0; $x <= $GRID_X_MAX; $x++ ) { if( ${ $ref2grid }[$y][$x] eq 0 ) { push( @{ $ref2holes }, [ $x, $y ] ); } elsif( not defined ${ $ref2blockpos }{ ${ $ref2grid }[$y][ +$x] } ) { ${ $ref2blockpos }{ ${ $ref2grid }[$y][$x] }{x} = $x; ${ $ref2blockpos }{ ${ $ref2grid }[$y][$x] }{y} = $y; } } } } sub find_blocks_to_move { my ( $ref2orig_grid, $ref2holes ) = @_; my %blocks; foreach my $hole ( @{ $ref2holes } ) { my ( $hole_x, $hole_y ) = @{ $hole }; if( $hole_x > 0 and ${ $ref2orig_grid }[ $hole_y ][ $hole_x - +1 ] ne 0 ) { $blocks{ ${ $ref2orig_grid }[ $hole_y ][ $hole_x - 1 ] } = ( $blocks{ ${ $ref2orig_grid }[ $hole_y ][ $hole_x - 1 + ] } || '' ) . 'r'; } if( $hole_x < $GRID_X_MAX and ${ $ref2orig_grid }[ $hole_y ][ +$hole_x + 1 ] ne 0 ) { $blocks{ ${ $ref2orig_grid }[ $hole_y ][ $hole_x + 1 ] } = ( $blocks{ ${ $ref2orig_grid }[ $hole_y ][ $hole_x + 1 + ] } || '' ) . 'l'; } if( $hole_y > 0 and ${ $ref2orig_grid }[ $hole_y - 1 ][ $hole_ +x ] ne 0 ) { $blocks{ ${ $ref2orig_grid }[ $hole_y - 1 ][ $hole_x ] } = ( $blocks{ ${ $ref2orig_grid }[ $hole_y - 1 ][ $hole_x + ] } || '' ) . 'd'; } if( $hole_y < $GRID_Y_MAX and ${ $ref2orig_grid }[ $hole_y + 1 + ][ $hole_x ] ne 0 ) { $blocks{ ${ $ref2orig_grid }[ $hole_y + 1 ][ $hole_x ] } = ( $blocks{ ${ $ref2orig_grid }[ $hole_y + 1 ][ $hole_x + ] } || '' ) . 'u'; } } return( %blocks ); } sub calc_new_grid { my ( $block, $move, $ref2orig_grid ) = @_; my @new_grid = map { [ @{ $_ } ] } @{ $ref2orig_grid }; # find the position of $block my ( $orig_x, $orig_y ); for( my $y = 0; $y <= $GRID_Y_MAX; $y++ ) { for( my $x = 0; $x <= $GRID_X_MAX; $x++ ) { if( ${ $ref2orig_grid }[$y][$x] eq $block ) { ( $orig_x, $orig_y ) = ( $x, $y ); ( $x, $y ) = ( $GRID_X_MAX + 1, $GRID_Y_MAX + 1 ); # q +uit the loop } } } my $new_x = $orig_x + $movemts{$move}{xmove}; my $new_y = $orig_y + $movemts{$move}{ymove}; # delete the old positions for this block for( my $x = 1; $x <= $blocktypes{ $blocks{$block} }{xsize}; $x++ +) { for( my $y = 1; $y <= $blocktypes{ $blocks{$block} }{ysize}; $ +y++ ) { $new_grid[ $orig_y + $y - 1 ][ $orig_x + $x - 1 ] = 0; } } for( my $x = 1; $x <= $blocktypes{ $blocks{$block} }{xsize}; $x++ +) { for( my $y = 1; $y <= $blocktypes{ $blocks{$block} }{ysize}; $ +y++ ) { if( $new_grid[ $new_y + $y - 1 ][ $new_x + $x - 1 ] ne 0 ) { return; # skip if moving this block would overlap anot +her block } else { $new_grid[ $new_y + $y - 1 ][ $new_x + $x - 1 ] = $blo +ck; } } } my @new_grid_string = map { join( '', @{ $_ } ) } @new_grid; return( \@new_grid, @new_grid_string ); } sub grid_is_winner { my ( $ref2grid ) = @_; my ( $check_x, $check_y ); for( my $y = $GRID_Y_MAX; $y >= 0; $y-- ) { for( my $x = $GRID_X_MAX; $x >= 0; $x-- ) { if( ${ $ref2grid }[$y][$x] eq $win{block} ) { ( $check_x, $check_y ) = ( $x, $y ); } } } return ( $check_x == $win{x} and $check_y == $win{y} ) ? 1 : 0; }

And the two solutions:

Starting grid: ABBC ABBC 0DD0 EFGH EIJH Solutions are concatenated strings of 'block' . 'direction', where direction is r (right), l (left), u (up), d (down) start-Dl-Gu-Gr-Dr-Eu-Il-Jl-Hl-Gd-Gd-Dr-Fu-Ju-Ir-Ed-Fl-Dl-Cd-Cd-Br-Ar-F +u-Fu-Eu-Il-Eu-Jl-Hl-Gl-Gu-Cd-Dr-Hu-Ir-Ir-Hd-Ad-Fr-Eu-Ju-Hl-Ad-Ad-Jr-J +u-Dl-Cu-Ir-Gd-Dl-Cl-Iu-Gr-Cd-Dr-Dr-Au-Ed-Fl-Ju-Au-Cl-Gl-Id-Dd-Bd-Jr-F +r-Eu-Hu-Jr-Fr-Au-Cu-Gl-Gl-Il-Il-Dd-Bd-Fd-Fr-Ar-Cu-Cu-Bl-Fd-Fd-Jd-Jd-A +r-Cr-Er-Hu-Hu-Bl-Fl-Fu-Du-Ir-Gr-Ir-Gr-Bd-Fl-Fl-Jl-Jl-Du-Gu-Gr-Br final grid arrangement: HECA HECA FJDD 0BBG 0BBI start-Dr-Fu-Fl-Dl-Hu-Jr-Ir-Er-Fd-Fd-Dl-Gu-Iu-Jl-Hd-Gr-Dr-Ad-Ad-Bl-Cl-G +u-Gu-Hu-Hu-Ir-Jr-Er-Fr-Fu-Ad-Dl-Eu-Jl-Jl-Ed-Cd-Gl-Hu-Iu-Er-Cd-Cd-Il-I +u-Dr-Au-Jl-Fd-Dr-Ar-Ju-Fl-Ad-Dl-Dl-Cu-Hd-Gr-Iu-Cu-Ar-Fr-Jd-Dd-Bd-Il-G +l-Hu-Eu-Il-Gl-Cu-Au-Fr-Fr-Jr-Jr-Dd-Bd-Gd-Gl-Cl-Au-Au-Br-Gd-Gd-Id-Id-C +l-Al-Hl-Eu-Eu-Br-Gr-Gu-Du-Jl-Fl-Jl-Fl-Bd-Gr-Gr-Ir-Ir-Du-Fu-Fl-Bl final grid arrangement: CAHE CAHE DDIG FBB0 JBB0

Now I'm going to see how the other solutions work... :)

Replies are listed 'Best First'.
Re^2: Challenge: Setting Sun Puzzle
by tye (Sage) on Oct 05, 2004 at 16:04 UTC
    According to this code, there are 2 solutions,

    There are dozens of solutions and you throw most of them away at intermediate steps because they resulted in equivalent board positions.

    But you didn't bother to throw away duplicates that are left-rigtht mirror images of each other despite the board being symmetrical that way. (Neither did I.)

    So your "two" solutions means that, when using the minimum number of simple moves, the board layout (considering as identical any peices that are of the same shape and orientation) right before the last move is unique except for left-right mirroring.

    - tye        

      I took the symmetry into account and I found only one solution at 112 moves. Using more moves, there are another 483 solutions:

      The longest solution takes 158 moves. Of course this is making sure that no configuration is visited more than once. If I solved it by hand I'm pretty sure I'd take more than 158 because I would go in circles... ;-)

      Quite true. I thought of the mirror-image issue and I was going to update the post noting the symmetry, but you beat me to it! I'll do that now...

      Thanks for the comment. My language was not as precise as it could have been.

Log In?
Username:
Password:

What's my password?
Create A New User
Domain Nodelet?
Node Status?
node history
Node Type: note [id://396469]
help
Chatterbox?
and the web crawler heard nothing...

How do I use this?Last hourOther CB clients
Other Users?
Others chilling in the Monastery: (4)
As of 2024-03-29 05:15 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    No recent polls found