#!/usr/bin/perl
use warnings;
use strict;
use Benchmark 'cmpthese';
print limbic_final();
print "--------------------\n";
print ieronim_pure();
cmpthese( 500, {
'ieronim (new)' => 'my @results = ieronim_pure()',
'L~R (semi)' => 'my @results = limbic_semifinal()',
'L~R (final)' => 'my @results = limbic_final()'
});
sub ieronim_pure {
#my @cubes = qw/pgpygr rprrgy ppryyg rrygpy/;
my @cubes = qw/rprrgy ppryyg rrygpy/;
my %seen;
my $str = join("", map {$_, scalar reverse $_} "pgpy","ggry","pygr
+")
."!".join "!",
map { join "", grep {!$seen{$_}++} map {join "", @$_}
+@$_}
map { [ rotate([@{$_}[0,1,2,3]]),
rotate([@{$_}[4,1,5,3]]),
rotate([@{$_}[0,4,2,5]]) ] } map { [split //]
+} @cubes;
my @result;
my $re = qr/^(?:[^!]{4})*
(?:
([^!])
([^!])
([^!])
([^!])
)
(?:[^!]{4})*!
(?:[^!]{4})*
(?:
(?!\1)([^!])
(?!\2)([^!])
(?!\3)([^!])
(?!\4)([^!])
)
(?:[^!]{4})*!
(?:[^!]{4})*
(?:
(?!\1|\5)([^!])
(?!\2|\6)([^!])
(?!\3|\7)([^!])
(?!\4|\8)([^!])
)
(?:[^!]{4})*!
(?:[^!]{4})*
(?:
(?!\1|\5|\9)([^!])
(?!\2|\6|\10)([^!])
(?!\3|\7|\11)([^!])
(?!\4|\8|\12)([^!])
)(?{
push @result, [join("", $1,$2,$3,$4),
join("", $5,$6,$7,$8),
join("", $9,$10,$11,$12),
join("", $13,$14,$15,$16)]
})
(?!)
/x;
#print $str;
$str =~ /$re/;
return map { join "\n", @$_, "", ""} @result;
}
sub rotate {
my @strips;
$strips[0] = shift;
$strips[1] = [reverse @{$strips[0]}];
my @rotated;
foreach (0..$#{$strips[0]}) {
foreach my $strip (@strips) {
push @$strip, shift @$strip;
push @rotated, [@$strip];
}
}
return @rotated;
}
sub permute {
my $ary = shift;
return [$ary] if @$ary == 1;
my @result;
foreach my $i (0..$#{$ary}) {
push @result, map { [$ary->[$i], @$_] } @{permute([@{$ary}[0..
+$i-1, $i+1..$#{$ary}]])};
}
return \@result;
}
##################################################################
sub limbic_final {
my @result;
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);
push @result, "@$c1\n@$c2\n@$c3\n$sol\n\n" if $cube4{$
+sol};
}
$used[$_]{$c2->[$_]} = 0 for 0 .. 3;
}
}
return @result;
}
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;
}
sub limbic_semifinal {
my @result;
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);
push @result, "@$c1\n@$c2\n@$c3\n$sol\n\n" if $cube4{$
+sol};
}
}
}
return @result;
}