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 added below the left side. $ltetra{1,0,0} = 1; my %ttetra=%tricube; #T tetracube: a row of three blocks with one added 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 of 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 symetries #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=< 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 solutions (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$16 $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 character. ("[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 replace with '.{10}' # because '...{10}' will be the same regex than '.{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 property that the capture groups # are numbered from the same starting point in each alternation branch. # It is available starting from perl 5.10.0. } #### 1234 5789 6efE adAB hiFI gDGH bcC 1234 5789 6efE bcCF dgGH aABD hiI 1234 5789 6fiI abeA dDEH cBCF ghG 1234 5789 6fiI abeA dghD cBCF EGH 1234 5789 6fiI abeA ghEH cBCF dDG 1234 5789 6fiI bcCF aABE degD hGH 1234 5789 6fiI bcCF aABE eghH dDG 1234 5789 6fiI bcCF aABE gDGH deh 1234 5789 6fiI bcCF dgGH aABD ehE 1234 5789 6fiI bcCF degE aABD hGH ... #### ([[:alnum:]])([[:alnum:]])([[:alnum:]])..([[:alnum:]]).* .*?(?|(?!\1|\2|\3|\4)([[:alnum:]])....(?!\1|\2|\3|\4)([[:alnum:]])(?!\1|\2|\3|\4)([[:alnum:]])...(?!\1|\2|\3|\4)([[:alnum:]])|(?!\1|\2|\3|\4)([[:alnum:]])...(?!\1|\2|\3|\4)([[:alnum:]])(?!\1|\2|\3|\4)([[:alnum:]])(?!\1|\2|\3|\4)([[:alnum:]])|(?!\1|\2|\3|\4)([[:alnum:]])...(?!\1|\2|\3|\4)([[:alnum:]])(?!\1|\2|\3|\4)([[:alnum:]])....(?!\1|\2|\3|\4)([[:alnum:]])|(?!\1|\2|\3|\4)([[:alnum:]])(?!\1|\2|\3|\4)([[:alnum:]])(?!\1|\2|\3|\4)([[:alnum:]])...(?!\1|\2|\3|\4)([[:alnum:]])|(?!\1|\2|\3|\4)([[:alnum:]])....(?!\1|\2|\3|\4)([[:alnum:]])....(?!\1|\2|\3|\4)([[:alnum:]])...................(?!\1|\2|\3|\4)([[:alnum:]])|(?!\1|\2|\3|\4)([[:alnum:]])...................(?!\1|\2|\3|\4)([[:alnum:]])....(?!\1|\2|\3|\4)([[:alnum:]])....(?!\1|\2|\3|\4)([[:alnum:]])|(?!\1|\2|\3|\4)([[:alnum:]])........................(?!\1|\2|\3|\4)([[:alnum:]])(?!\1|\2|\3|\4)([[:alnum:]]).......................(?!\1|\2|\3|\4)([[:alnum:]])|(?!\1|\2|\3|\4)([[:alnum:]])(?!\1|\2|\3|\4)([[:alnum:]])(?!\1|\2|\3|\4)([[:alnum:]]).......................(?!\1|\2|\3|\4)([[:alnum:]])|(?!\1|\2|\3|\4)([[:alnum:]]).......................(?!\1|\2|\3|\4)([[:alnum:]])(?!\1|\2|\3|\4)([[:alnum:]])(?!\1|\2|\3|\4)([[:alnum:]])|(?!\1|\2|\3|\4)([[:alnum:]]).......................(?!\1|\2|\3|\4)([[:alnum:]])(?!\1|\2|\3|\4)([[:alnum:]])........................(?!\1|\2|\3|\4)([[:alnum:]])|(?!\1|\2|\3|\4)([[:alnum:]])........................(?!\1|\2|\3|\4)([[:alnum:]])....(?!\1|\2|\3|\4)([[:alnum:]])...................(?!\1|\2|\3|\4)([[:alnum:]])|(?!\1|\2|\3|\4)([[:alnum:]])...................(?!\1|\2|\3|\4)([[:alnum:]])....(?!\1|\2|\3|\4)([[:alnum:]])........................(?!\1|\2|\3|\4)([[:alnum:]])).* [snip]