my $cube1 = 'pgpygr';
my $cube2 = 'rprrgy';
my $cube3 = 'ppryyg';
my $cube4 = 'rrygpy';
####
+-------+
| g |
| green |
| |
+-------+-------+-------+-------+
| p | g | p | y |
|purple | green |purple |yellow |
| | | | |
+-------+-------+-------+-------+
| r |
| red |
| |
+-------+
####
#!/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 solution
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($cube4),
);
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, $index3)) {
++$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 front
# square moves to the top, the bottom to the front,
# the top to the back, etc. Only the left and right
# squares remain unchanged. The cube is flipped the
# 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 cube is
# rotated the number of times given by the count $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 given
# 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 (in
# the range 0 ... 23), creates and returns a new cube
# 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}, $p4->{$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 respectively
# 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, $new4);
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 using
# an ascii "picture" of the cube (if $b_verbose is nonzero).
#
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;
}