use strict; use List::Util qw(sum); # Represent the matchables with upper and lower case letters. # Double the strings so rotations are all represented. my @tiles = ( "", # filler "AbDCAbDC", # 1 Top of A, bottom of b, top of D, top of C "ABdcABdc", # 2 "adcbadcb", # 3 "ABDcABDc", # 4 "CDbaCDba", # 5 "AcdBAcdB", # 6 "DdCBDdCB", # 7 "AacDAacD", # 8 "ABcbABcb", # 9 ); my $TOP = 0; my $RIGHT = 1; my $BOTTOM = 2; my $LEFT = 3; # rotation index my (@rot, @pick, @tries, @passes, $rotation); $rot[0] = 0; sub get_target { my ($oldpos, $oldside) = @_; # match single constraint my $target = substr($tiles[$pick[$oldpos]], $rot[$oldpos] + $oldside, 1); $target =~ tr/A-Da-d/a-dA-D/; return $target; } sub get_target2 { my ($oldpos, $oldside, $oldpos2, $oldside2) = @_; # Two contraints in a row, clockwise. my $target1 = substr($tiles[$pick[$oldpos]], $rot[$oldpos] + $oldside, 1); my $target2 = substr($tiles[$pick[$oldpos2]], $rot[$oldpos2] + $oldside2, 1); my $target = $target1 . $target2; $target =~ tr/A-Da-d/a-dA-D/; return $target; } sub fit_tile { my ($mypos, $tile, $side, $target) = @_; $tries[$mypos]++; my $ind = index($tiles[$tile], $target); return -1 if ($ind < 0); $passes[$mypos]++; # rotation to have letters match my $rotation = ($ind - $side) % 4; $pick[$mypos] = $tile; $rot[$mypos] = $rotation; return $rotation; } sub print_solution { print 0+$pick[8],":",0+$rot[8]," ",$pick[1],":",$rot[1], " ", $pick[2],":",$rot[2],"\n"; print $pick[7],":",$rot[7]," ",$pick[0],":",$rot[0], " ", $pick[3],":",$rot[3],"\n"; print $pick[6],":",$rot[6]," ",$pick[5],":",$rot[5], " ", $pick[4],":",$rot[4],"\n"; print "\n"; my $i; for $i (0..8) { print 0+$tries[$i]," tries, ",0+$passes[$i]," passes for level ",$i,"\n"; } print sum(@tries)," total tries\n"; print sum(@passes)," total passes\n"; } # Note: the tiles that are not yet assigned my ($un0, $un1, $un2, $un3, $un4, $un5, $un6, $un7, $un8); # The current tile number. my ($p0, $p1, $p2, $p3, $p4, $p5, $p6, $p7, $p8); # What the tile has to match. my ($t1, $t2, $t3, $t4, $t5, $t6, $t7, $t8); # Try to fill in the tiles in the following order: # 8 1 2 # 7 0 3 # 6 5 4 $un0 = "123456789"; MAJOR: foreach $p0 (split(//,$un0)) { $pick[0] = $p0; $tries[0]++; $passes[0]++; my $un1 = $un0; $un1 =~ s/$p0//; $t1 = get_target(0, $TOP); # top of inner tile foreach $p1 (split(//,$un1)) { $rotation = fit_tile(1, $p1, $BOTTOM, $t1); next if ($rotation < 0); $un2 = $un1; $un2 =~ s/$p1//; $t2 = get_target(1, $RIGHT); # side of tile 1 foreach $p2 (split(//,$un2)) { $rotation = fit_tile(2, $p2, $LEFT, $t2); next if ($rotation < 0); $un3 = $un2; $un3 =~ s/$p2//; $t3 = get_target2(0, $RIGHT, 2, $BOTTOM); # sides of 0, 2 foreach $p3 (split(//,$un3)) { $rotation = fit_tile(3, $p3, $LEFT, $t3); next if ($rotation < 0); $un4 = $un3; $un4 =~ s/$p3//; $t4 = get_target(3, $BOTTOM); foreach $p4 (split(//,$un4)) { $rotation = fit_tile(4, $p4, $TOP, $t4); next if ($rotation < 0); $un5 = $un4; $un5 =~ s/$p4//; $t5 = get_target2(0, $BOTTOM, 4, $LEFT); foreach $p5 (split(//,$un5)) { $rotation = fit_tile(5, $p5, $TOP, $t5); next if ($rotation < 0); $un6 = $un5; $un6 =~ s/$p5//; $t6 = get_target(5, $LEFT); foreach $p6 (split(//,$un6)) { $rotation = fit_tile(6, $p6, $RIGHT, $t6); next if ($rotation < 0); $un7 = $un6; $un7 =~ s/$p6//; $t7 = get_target2(0, $LEFT, 6, $TOP); foreach $p7 (split(//,$un7)) { $rotation = fit_tile(7, $p7, $RIGHT, $t7); next if ($rotation < 0); $un8 = $un7; $un8 =~ s/$p7//; $t8 = get_target2(1, $LEFT, 7, $TOP); $p8 = $un8; $rotation = fit_tile(8, $p8, $RIGHT, $t8); next if ($rotation < 0); print_solution(); last MAJOR; } # p7, p8 } # p6 } # p5 } # p4 } # p3 } # p2 } # p1 } # p0 print "Done\n";