One game which my niece was trying to solve was called Insanity. It consisted simply of a set of 4 cubes with differently colored faces. The colors were green, purple, red and yellow, and the object was to stack the cubes on top of one another in such a way as to have no duplicate colors in any of the 4 columns.
I thought it would be fun to write a Perl script to solve it using "brute force", but didn't get it finished until after we returned Sunday night. I was mostly interested in seeing whether there was only a single solution, or multiple solutions -- in addition, of course, to the enjoyment of writing a fun Perl script. I'm presenting this as a challenge in case other monks would like to try it for themselves. I'm fairly sure someone can come up with a more elegant solution than my "brute force" method, or at least improve on its readability and/or speed.
The following represents the 4 cubes:
where 'g', 'p', 'r' and 'y' represent the colors 'green', 'purple', 'red' and 'yellow' respectively, and the colors in each string are, in order, the left, front, right, back, top and bottom faces. Thus, cube1 'pgpygr' represents the cube:my $cube1 = 'pgpygr'; my $cube2 = 'rprrgy'; my $cube3 = 'ppryyg'; my $cube4 = 'rrygpy';
+-------+ | g | | green | | | +-------+-------+-------+-------+ | p | g | p | y | |purple | green |purple |yellow | | | | | | +-------+-------+-------+-------+ | r | | red | | | +-------+
For those not interested in trying to solve it themselves, my program is behind the following spoiler tags.
You can see by running the program that there appear to be 8 solutions. However, for each true solution, there will be 8 solutions detected; one for each of the 4 horizontal rotations of the entire stack, times 2 for allowing all cubes to be "flipped" upside-down (180 degrees vertically). So the 8 apparent unique solutions in the program actually correspond to a single, truly unique solution.
#!/usr/bin/perl -w # # Solves the 4-colored cube game "Insanity", where the four cubes # must be aligned in a stack, such that no column contains more than # one color. # # Created 060625 by liverpole # # Strict use strict; use warnings; # Libraries use File::Basename; # Globals $| = 1; my $b_verbose = 0; # If true, displays an ascii picture of the so +lution my $iam = basename $0; my $cube1 = 'pgpygr'; my $cube2 = 'rprrgy'; my $cube3 = 'ppryyg'; my $cube4 = 'rrygpy'; # Create new cubes from the @data array my @cubes = ( new_cube($cube1), new_cube($cube2), new_cube($cube3), new_cube($cu +be4), ); show_cubes("Starting cubes", @cubes); # Solve cubes using brute force. # Each cube is put into one of its possible 24 configurations, for a # total of 24 ^ 4 configurations (331,776 total configurations). # my $total = 0; my $nwins = 0; my $pwins = { }; for (my $index0 = 0; $index0 < 24; $index0++) { for (my $index1 = 0; $index1 < 24; $index1++) { for (my $index2 = 0; $index2 < 24; $index2++) { for (my $index3 = 0; $index3 < 24; $index3++) { ++$total; if (won_game(\@cubes, $index0, $index1, $index2, $inde +x3)) { ++$nwins; } } } } } # Display the number of unique solutions found my $nuniq = (0 + (keys %$pwins)) / 8; printf "Found $nwins of $total, $nuniq unique win(s)\n"; # Subroutines # # new_cube: creates a hash for the given string of color symbols # ('g' = green, 'p' = purple, 'r' = red, 'y' = yellow) # sub new_cube { my ($string) = @_; my $c = '[gpry]'; if ($string !~ /($c)($c)($c)($c)($c)($c)/i) { die "$iam: invalid format: '$string'\n"; } my $pcube = { '1' => lc $1, '2' => lc $2, '3' => lc $3, '4' => lc $4, 'T' => lc $5, 'B' => lc $6, }; return $pcube; } # # flip_vertically: spins the cube pointed to by $1, so that the fron +t # square moves to the top, the bottom to the front, # the top to the back, etc. Only the left and righ +t # squares remain unchanged. The cube is flipped th +e # number of times given by the count $2. # # Pictorially: # # Before: After: # +-----+ +-----+ # | | | | # | E | | B | # | | | | # +-----+-----+-----+-----+ +-----+-----+-----+-----+ # | | | | | | | | | | # | A | B | C | D | | A | F | C | E | # | | | | | | | | | | # +-----+-----+-----+-----+ +-----+-----+-----+-----+ # | | | | # | F | | D | # | | | | # +-----+ +-----+ # sub flip_vertically { my ($p, $count) = @_; for (my $i = 0; $i < $count; $i++) { my ($cT, $c2, $cB, $c4) = ($p->{2}, $p->{B}, $p->{4}, $p->{T}) +; ($p->{2}, $p->{B}, $p->{4}, $p->{T}) = ($c2, $cB, $c4, $cT); } } # # rotate_horizontally: rotates the cube pointed to by $1 so that the # left square moves to the front, the front to +the # right, the right to the back, etc. Only the +top # and bottom squares remain unchanged. The cub +e is # rotated the number of times given by the coun +t $2. # # Pictorially: # # Before: After: # +-----+ +-----+ # | | | | # | E | | E | # | | | | # +-----+-----+-----+-----+ +-----+-----+-----+-----+ # | | | | | | | | | | # | A | B | C | D | | D | A | B | C | # | | | | | | | | | | # +-----+-----+-----+-----+ +-----+-----+-----+-----+ # | | | | # | F | | F | # | | | | # +-----+ +-----+ # sub rotate_horizontally { my ($p, $count) = @_; if ($count < 0) { $count = - $count; for (my $i = 0; $i < $count; $i++) { my ($c4, $c1, $c2, $c3) = ($p->{1}, $p->{2}, $p->{3}, $p-> +{4}); ($p->{1}, $p->{2}, $p->{3}, $p->{4}) = ($c1, $c2, $c3, $c4 +); } } elsif ($count > 0) { for (my $i = 0; $i < $count; $i++) { my ($c2, $c3, $c4, $c1) = ($p->{1}, $p->{2}, $p->{3}, $p-> +{4}); ($p->{1}, $p->{2}, $p->{3}, $p->{4}) = ($c1, $c2, $c3, $c4 +); } } } # # move_square_to_top: given a pointer to a cube hash $1, and a cube # index $2 (in the range 0 ... 5), moves the giv +en # square into the top position. # sub move_square_to_top { my ($p, $loc) = @_; (0 == $loc) and rotate_horizontally($p, 1); (2 == $loc) and rotate_horizontally($p, -1); (3 == $loc) and rotate_horizontally($p, -2); if (4 != $loc) { flip_vertically($p, 1); (5 == $loc) and flip_vertically($p, 1); } } # # change_position: given a pointer to a cube $1, and a position $2 (i +n # the range 0 ... 23), creates and returns a new cub +e # representing the original cube transformed to the # new position. # sub change_position { my ($pold, $pos) = @_; # Copy a new cube, as a copy of the old one my $pnew = { }; map { $pnew->{$_} = $pold->{$_} } (keys %$pold); # Move one of 6 squares to the top move_square_to_top($pnew, int($pos / 4)); # Rotate the cube horizontally from 0 to 3 squares rotate_horizontally($pnew, $pos % 4); return $pnew; } # # same_color_in_column: returns nonzero if any of the cubes pointed +to # by $1, $2, $3 and $4 contain the same color +in # any of their 4 columns; zero otherwise. # sub same_color_in_column { my ($p1, $p2, $p3, $p4) = @_; for (my $i = 1; $i <= 4; $i++) { my ($c1, $c2, $c3, $c4) = ($p1->{$i}, $p2->{$i}, $p3->{$i}, $p +4->{$i}); if ($c1 eq $c2 || $c1 eq $c3 || $c1 eq $c4 || $c2 eq $c3 || $c2 eq $c4 || $c3 eq $c4) { return 1; } } return 0; } # # won_game: returns nonzero if the game is won, for the array of # cubes $1, and using the cube positions given respectivel +y # by $2, $3, $4 and $5. If the game is not won, zero is # returned. # sub won_game { my ($pcubes, $index0, $index1, $index2, $index3) = @_; my $new1 = change_position($pcubes->[0], $index0); my $new2 = change_position($pcubes->[1], $index1); my $new3 = change_position($pcubes->[2], $index2); my $new4 = change_position($pcubes->[3], $index3); if (same_color_in_column($new1, $new2, $new3, $new4)) { return 0; } my $winstr = show_cubes("Solution Found!", $new1, $new2, $new3, $n +ew4); print "\n"; ++$pwins->{$winstr}; return 1; } # # show_cubes: displays the given configuration of cubes, either as # 4 strings of 6 faces each (left, front, right, back, # top, bottom), or using an ascii "picture" of the cubes # (if $b_verbose is nonzero). # sub show_cubes { my ($msg, @cubes) = @_; print "=== $msg ===\n"; my $winstr = ""; for (my $i = 0; $i < @cubes; $i++) { my $idx = $i + 1; my $cube = $cubes[$i]; $winstr .= show_cube($cube); } print "\n"; return $winstr; } # # show_cube: displays an individual cube, either as a string of the # 6 faces (left, front, right, back, top, bottom), or usi +ng # an ascii "picture" of the cube (if $b_verbose is nonzer +o). # sub show_cube { my ($p) = @_; my ($c1, $c2, $c3, $c4) = ($p->{'1'}, $p->{'2'}, $p->{'3'}, $p->{' +4'}); my ($cT, $cB) = ($p->{'T'}, $p->{'B'}); my $winstr = sprintf "%s %s %s %s %s %s", $c1, $c2, $c3, $c4, $cT, + $cB; print "$winstr\n"; if ($b_verbose) { print " +-------+\n"; printf " | |\n"; printf " | $cT |\n"; printf " | |\n"; print " +-------+-------+-------+-------+\n"; printf " | | | | |\n"; printf " | $c1 | $c2 | $c3 | $c4 |\n"; printf " | | | | |\n"; print " +-------+-------+-------+-------+\n"; printf " | |\n"; printf " | $cB |\n"; printf " | |\n"; print " +-------+\n"; print "\n"; } return $winstr; }
|
---|