The following runs in a fraction of second. I haven't looked at the other code contributions so I won't try to compare code complexity. (:

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:

*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. :-)

The solution posted 5 days ago wasn't a solution at all :)
I just realised that it solved a bit another puzzle :)

The updated pure rexep-based version is here:</p

Update (2006-07-06):
Here is a smarter brute-force approach. It reduces the number of loops from 331,776 to 65,536:

Final Update (2006-07-06):
This is an even smarter brute-force approach. The number of total loops is less than 8,048 and It is quite fast.

The total number of iterations needed to find all unique solutions is ((3*4)^4)/8 == 2592, as the unique solution does not depend on the cubes' order :) And all 8 solutions can be built using simple permutation of an array representing the unique one.

My regexp solution really uses the smallest possible number of loops, i think. Be stricter, it does not use loops at all to find the solution — only during the pre-processing :)))

It's difficult to make a good benchmark, as all presented scripts print their output directly to STDOUT and need to be a bit modified to become comparable by cmpthese(). But i'll try to do it today, if i have enough time.

Ieronim,
I told liverpole in the CB that I didn't really have time to play with this but since he indicated I was the reason he posted it as a Challenge (see some of my previous posts), I felt obligated to do so. Without thinking about it too much, I decided just to brute-force it and then see if there were any obvious optimizations on that. I do not expect it to be the fastest but it is fast enough.

With regards to benchmarking, it is almost never a good idea to include IO. Basically, the routines should be verified to produce essentially the same results first and then the output should be omitted. In other words, doing any preparation IO work before the bench, run the bench, and omit any IO output.

Update: Depending on how you count, the following only loops 1,152 times and still finds duplicates.

#!/usr/bin/perl
use strict;
use warnings;

my @cube = (
    [[qw/p g p y/], [qw/g g y r/], [qw/g g r p/]],
    rotations('rprrgy'),
    rotations('ppryyg'),
);
my %cube4 = map {("@$_" => 1)} @{rotations('rrygpy')};

for my $c1 (@{$cube[0]}) {
    for my $c2 (@{$cube[1]}) {
        for my $c3 (@{$cube[2]}) {
            my $sol = find_sol($c1, $c2, $c3);
            print "@$c1\n@$c2\n@$c3\n$sol\n\n" if $cube4{$sol};
        }
    }
}

sub find_sol {
    my ($c1, $c2, $c3) = @_;
    my @sol;
    for my $i (0 .. 3) {
        my %free = map {$_ => undef} qw/r g y p/;
        delete @free{ map $_->[$i], $c1, $c2, $c3 };
        push @sol, keys %free;
    }
    return "@sol";
}

sub rotations {
    my (%seen, @rot);
    my @cube = split //, shift @_;
    for ([0 .. 3], [1, 4, 3, 5], [4, 0, 5, 2]) {
        my @col = @cube[@$_];
        push @rot, map {push @col, shift @col; $seen{"@col"}++ ? () : 
+[@col]} 1..4;
        @col = reverse @{$rot[-1]};
        push @rot, map {push @col, shift @col; $seen{"@col"}++ ? () : 
+[@col]} 1..4;
    }
    return \@rot;
}
[download]

And the following performs even fewer (< 500):

#!/usr/bin/perl
use strict;
use warnings;

my @cube = (
    [[qw/p g p y/], [qw/g g y r/], [qw/g g r p/]],
    rotations('rprrgy'),
    rotations('ppryyg'),
);
my %cube4 = map {("@$_" => 1)} @{rotations('rrygpy')};

my @used;
for my $c1 (@{$cube[0]}) {
    @used = map {{$_ => 1}} @$c1;
    CUBE2:
    for my $c2 (@{$cube[1]}) {
        $used[$_]{$c2->[$_]} && next CUBE2 for 0 .. 3;
        $used[$_]{$c2->[$_]} = 1 for 0 .. 3;
        CUBE3:
        for my $c3 (@{$cube[2]}) {
            $used[$_]{$c3->[$_]} && next CUBE3 for 0 .. 3;
            my $sol = find_sol($c1, $c2, $c3);
            print "@$c1\n@$c2\n@$c3\n$sol\n\n" if $cube4{$sol};
        }
        $used[$_]{$c2->[$_]} = 0 for 0 .. 3;
    }
}

sub find_sol {
    my ($c1, $c2, $c3) = @_;
    my @sol;
    for my $i (0 .. 3) {
        my %free = map {$_ => undef} qw/r g y p/;
        delete @free{ map $_->[$i], $c1, $c2, $c3 };
        push @sol, keys %free;
    }
    return "@sol";
}

sub rotations {
    my (%seen, @rot);
    my @cube = split //, shift @_;
    for ([0 .. 3], [1, 4, 3, 5], [4, 0, 5, 2]) {
        my @col = @cube[@$_];
        push @rot, map {push @col, shift @col; $seen{"@col"}++ ? () : 
+[@col]} 1..4;
        @col = reverse @{$rot[-1]};
        push @rot, map {push @col, shift @col; $seen{"@col"}++ ? () : 
+[@col]} 1..4;
    }
    return \@rot;
}
[download]

Cheers - L~R

Here's my solution in the J programming language. The cubes in the example are defined near the beginning, but you can use any other cube colorings you wish. My solution uses brute force and is unoptimized, but on a modern machine it still runs within a few seconds so I don't care.

The output lists all the solutions and then gives the number of solutions just in case there are so many they scrolled out of the screen. Each solution is the list of four rotated cubes each given as six colors like in the input. The output is in spoiler tags.

Update: Let's compare the output with that of some of the other solutions posted in this thread.

Update: I cross-posted a description of the puzzle and my solution to the J wiki: Essays/InsanityCube.

Update 2010-11-29: has anyone linked to the description of this puzzle (called Instant Insanity there) on Jaap's puzzle page?

See also http://www.jsoftware.com/jwiki/Doc/Articles/Play173.