Interesting puzzle, and a nice challenge. Thanks for the diversion. :-)
I don't know if my solution is any more elegant, readable, or speedy*, but here it is:
Since the number of possible configurations for each of the 4 cubes is small (24), I generated them all up front and limited the data to only the 4 faces that would actually show (not the top or bottom faces). I then used a brute force method to search all possible combinations of configurations, but I didn't permute the order of the blocks (which would add another factor of 24 to the total number of solutions found). I also used extensive short-circuiting to avoid checking combinations that were already known to be failures.
I printed all of the solutions to STDOUT as well as the total number found at the end. The format for each solution is as follows:
ggry
ypgr
rypp
pryg
Each cube is represented by a row, and the columns of text correspond to the columns created by each of the 4 faces of the cube stack. For example, one face of the stack is 'gyrp' (reading from the top to the bottom).
As you noted, 8 solutions are reported for each unique solution.
use strict;
use warnings;
# cube strings are the colors for the left, front, right, back, top
# and bottom faces, respectively
my @cubes = ( 'pgpygr', 'rprrgy', 'ppryyg', 'rrygpy' );
my ( $num_solutions, @opts );
foreach my $cube ( @cubes )
{
push( @opts, get_all_opts( $cube ) );
}
foreach my $cube0str ( @{ $opts[0] } )
{
foreach my $cube1str ( @{ $opts[1] } )
{
next if has_duplicate_faces( $cube0str, $cube1str );
foreach my $cube2str ( @{ $opts[2] } )
{
next if has_duplicate_faces( $cube0str, $cube2str );
next if has_duplicate_faces( $cube1str, $cube2str );
foreach my $cube3str ( @{ $opts[3] } )
{
next if has_duplicate_faces( $cube0str, $cube3str );
next if has_duplicate_faces( $cube1str, $cube3str );
next if has_duplicate_faces( $cube2str, $cube3str );
# we have a winner
print "**********\n";
print join( "\n", $cube0str, $cube1str,
$cube2str, $cube3str ), "\n";
$num_solutions++;
}
}
}
}
printf "\n\nFound $num_solutions %s (%d unique %s),\n",
$num_solutions == 1 ? 'solution' : 'solutions',
$num_solutions / 8,
$num_solutions / 8 == 1 ? 'solution' : 'solutions';
print "but by permuting the block order this total can be ",
"increased by a factor of 24\n";
sub get_all_opts
{
my ( $cubestr ) = @_;
my @opts;
# generate all 8 options for the rings around the
# X, Y, and Z axes of the cube
my @faces = split( //, $cubestr );
push( @opts, permute_ring( @faces[ 0,1,2,3 ] ) );
push( @opts, permute_ring( @faces[ 4,1,5,3 ] ) );
push( @opts, permute_ring( @faces[ 0,4,2,5 ] ) );
return( \@opts );
}
sub permute_ring
{
my ( @faces ) = @_;
# rotate and reverse the 4 faces
my @opts;
for ( 1 .. 4 )
{
push( @opts, join( '', @faces ) );
push( @opts, scalar reverse join( '', @faces ) );
push( @faces, shift( @faces ) );
}
return( @opts );
}
sub has_duplicate_faces
{
my ( $cube1, $cube2 ) = @_;
for( 0 .. 3 )
{
if( substr( $cube1, $_, 1 ) eq substr( $cube2, $_, 1 ) )
{
return 1;
}
}
return 0;
}
*Update: After downloading and running your code, my solution appears to be a bit faster. The short-circuiting that I used meant that I only checked 12,480 4-block combinations for the given input data, whereas your solution checks 331,776 combinations. I didn't run extensive benchmarks (which might be more interesting once other solutions are posted), but on my box your code took about 50 sec to run and mine took less than 1 sec. Your code has more error checking and output capability, though, so speed isn't everything. :-)