- Simple ? Backtracking ?... Regex ruleZ!
The program produces 240 lines : each line is a solution as "1234 5789 6efE adAB hiFI gDGH bcC"
There is 27 little cubes in the Soma cube. Each position is coded with a character : 1,2,3 for the first row in the lower face, then 4,...9. In the middle : 'a' to 'i'. On the top 'A' to 'I'.
use strict;
use warnings;
use 5.10.0;
use re 'eval';
#Some Cube solver with one (very) big regex
#http://en.wikipedia.org/wiki/Soma_cube
sub rotate; #rotate one shape (branch, tricube, ...)
sub makereg; #make regex for one shape (one orientation)
sub rot24; #list every regex for one shape (every directions)
#http://en.wikipedia.org/wiki/Soma_cube
my %tricube; # The "L" tricube.
$tricube{0,0,0} = 1; #1st cube - coord (0,0,0)
$tricube{-1,0,0} = 1; #2nd cube - coord (-1,0,0)
$tricube{-1,1,0} = 1; #...
my %ltetra=%tricube; #L tetracube: a row of three blocks with one adde
+d below the left side.
$ltetra{1,0,0} = 1;
my %ttetra=%tricube; #T tetracube: a row of three blocks with one adde
+d below the center.
$ttetra{-1,-1,0} = 1;
my %stetra=%tricube; #S tetracube: bent triomino with block placed on
+outside of clockwise side.
$stetra{0,-1,0} = 1;
my %lscrew=%tricube; #Left screw tetracube: unit cube placed on top of
+ anticlockwise side. Chiral in 3D.
$lscrew{-1,1,1} = 1;
my %rscrew=%tricube; #Right screw tetracube: unit cube placed on top o
+f clockwise side. Chiral in 3D.
$rscrew{-1,1,-1} = 1;
my %branch=%tricube; #Branch tetracube: unit cube placed on bend. Not
+chiral in 3D.
$branch{-1,0,1} = 1;
#7 lines to determine 1 position by shape
#first line is different than others because we don't want to find sym
+etries
#1) L tetracube is the only shape which can oriented in 24 ways
#2) L tetracube must not lie in the middle
# see : http://www.mathematische-basteleien.de/somacube.htm#Positions%
+20of%20the%20Soma%20Pieces%203%20and%202
# In consequence we force 1 orientation of L tetracube in lower face (
+z=-1) : this way, we have 240 solutions
my $gr=<<GR;
123__456__789__________________________________________________
123__456__789____________abc__def__ghi____________ABC__DEF__GHI
123__456__789____________abc__def__ghi____________ABC__DEF__GHI
123__456__789____________abc__def__ghi____________ABC__DEF__GHI
123__456__789____________abc__def__ghi____________ABC__DEF__GHI
123__456__789____________abc__def__ghi____________ABC__DEF__GHI
123__456__789____________abc__def__ghi____________ABC__DEF__GHI
GR
# a char. is a position in the cube :
# z=-1 z=0 z=1
#
# 789 ghi GHI
# 456 def DEF
# 123 abc ABC
#
# ex: ( 0,-1,-1) => 2
# ex: ( 1, 0, 1) => F
#rotation matrix (Ox, Oy, Oz) -90°, 180°, 90°
my (@rx,@ry,@rz);
for my $sin (-1 .. 1) {
my $cos = $sin?0:-1; # if sin=± 1 then cos=0 ; if sin=0 then cos
+=-1
push @rx , [ [1,0,0],[0,$cos,-$sin],[0,$sin,$cos] ] ;
push @ry , [ [$cos,0,$sin],[0,1,0],[-$sin,0,$cos] ] ;
push @rz , [ [$cos,-$sin,0],[$sin,$cos,0],[0,0,1] ] ;
}
my $bigregex = join ".*\n.*?", # a newline between each shape-related
+ regex
makereg(\%ltetra), #orientation is forced to avoid similar sol
+utions (by symetry)
rot24(\%ttetra,1..4), # "1..4" parameters produces (?!\1|\2|\3
+|\4) $1,...$4 captured before with : makereg(\%ltetra)
rot24(\%stetra,1..8),
rot24(\%lscrew,1..12),
rot24(\%rscrew,1..16),
rot24(\%branch,1..20),
rot24(\%tricube,1..24),
;
$bigregex.=".*\n";
#print length $bigregex;
#print $bigregex;
$|=1;
$gr =~ qr{$bigregex(?{print "$1$2$3$4 $5$6$7$8 $9$10$11$12 $13$14$15$1
+6 $17$18$19$20 $21$22$23$24 $25$26$27\n"})(?!)};
#fast first solution:
#$gr =~ qr{$bigregex(?{print "$1$2$3$4 $5$6$7$8 $9$10$11$12 $13$14$15$
+16 $17$18$19$20 $21$22$23$24 $25$26$27\n"})};
sub makereg {
my $shape = shift;
my $not = '';
$not = '(?!\\'.(join'|\\',@_).')' if (scalar @_); # (?!\1|\2|\3|\
+4)
my $max= scalar keys %$shape; #number of unit cubes (4 except for
+the "L" tricube)
my $count=0;
my $reg='';
for my $z (-1 .. 1) {
for my $y (-1 .. 1) {
for my $x (-1 .. 1) {
if (exists $shape->{$x,$y,$z}) {
#$string =~ /[[:alnum:]]/ # Any alphanumeric characte
+r. ("[A-Za-z0-9]")
$reg.="$not([[:alnum:]])";
$count++;
return $reg if ($count == $max);
} elsif ($count) {
$reg.='.';
}
}
if ($count) {
$reg.='..';
}
}
if ($count) {
$reg.='..........'; # 10 chars -- warning: do not repl
+ace with '.{10}'
# because '...{10}' will be the same regex tha
+n '.{10}..'
# but will not be the same string - see %copy
+in sub rot24
}
}
}
sub rotate {
my $r = $_[0]; #rotation (matrix)
my $from = $_[1];
my $to = $_[2];
for my $c (keys %$from) {
my ($x,$y,$z) = split $; , $c;
my ($xn,$yn,$zn) = map {$x*$_->[0]+$y*$_->[1]+$z*$_->[2]} @$r
+;
$to->{$xn,$yn,$zn}=1;
}
}
sub rot24 { #6 faces x 4 orientations
my ($shape,@excep)=@_;
my @sh24;
my @r;
my %copy;
my %rot;
my $reg;
push @r,$shape;
$reg = makereg($shape,@excep);
push @sh24,$reg if not $copy{$reg}++;
for my $i (0 .. 2) { #Oz 4 rotations (Identity + 3 rot)
undef %rot;
rotate($rz[$i],$shape,\%rot);
$reg = makereg(\%rot,@excep);
push @sh24,$reg if not $copy{$reg}++;
push @r,{ (%rot) };
}
for my $i (0,2) { # Oy 2 rotations
undef %rot;
rotate($ry[$i],$shape,\%rot);
$reg = makereg(\%rot,@excep);
push @sh24,$reg if not $copy{$reg}++;
push @r,{ (%rot) };
}
for my $s (@r) { # 6 faces, 4 orientations (Identity + 3 rotations
+)
for my $i (0 .. 2) {
undef %rot;
rotate($rx[$i],$s,\%rot);
$reg = makereg(\%rot,@excep);
push @sh24,$reg if not $copy{$reg}++;
}
}
return (
'(?|' . (join '|', @sh24 ) . ')'
); # (?| reg1 | reg2 | reg3 | ... )
#(?|pattern) in perldoc perlre :
#This is the "branch reset" pattern, which has the special propert
+y that the capture groups
# are numbered from the same starting point in each alternation br
+anch.
# It is available starting from perl 5.10.0.
}
