#!/usr/bin/perl my $PI; BEGIN { $PI = atan2(0, -1) } $|=1; sub canonical; use strict; my %tile = (A => [3, 11, 7], B => ['3*', 10, 8], C => [3, '0*', 7, 7], E => ['3*', 2, 10, 8, 8], F => [3, 3, 11, 9, 7], G => [3, '0*', 9, '6*'], ); expand_set(\%tile); $tile{D} = $tile{C}; my $target = canonical [6, 4, 4, 2, 2, 0, 10, 10, 8, 8]; #my $target = [map $_->[0], @{canonical $tile{D}[0]}]; # A state consists of: # 1. The current agglomeration of tiles so far # 2. A hash indicating which primitive tiles have been used up my $root = [[], {}, #{C=>undef, D=>undef} ]; my $COUNT = 0; { my %seen; sub dfs { my ($root, $children, $aha) = @_; my @queue = $root; while (@queue) { my ($i, $l) = (0, length($queue[0][0])); # for (1 .. $#queue) { # next if $l < $queue[$_][0]; # $i = $_; $l = $queue[$_][0]; # } # my $next = splice @queue, $i, 1; my $next = pop @queue; my $s = tile_to_string($next->[0]); my $N = @queue; next if $seen{$s}++; warn "$N> $s\n" if $COUNT++ % 50 == 0; open my($fh), ">", sprintf("out/dump.%03d", $COUNT) or die "dump.$COUNT: $!"; show($next->[1], $fh); print $fh "gsave 250 0 translate\n"; showtile($next->[0], $fh); print $fh "grestore showpage\n"; if ($aha->($next)) { return $next; } else { push @queue, $children->($next); } } return; } } my $result = dfs($root, \&add_tile, \&win); if (defined $result) { show($result->[1]); } else { print "No.\n"; } my $sqrt_3; BEGIN { $sqrt_3 = sqrt(3) } sub fmt_coord { my @c; return sprintf("(%.2f, %.2f)", @_); for (@_) { if (nearly_integer($_*2/$sqrt_3)) { my $ms = int($_*2/$sqrt_3 + 0.5); push @c, $ms % 2 ? "$ {ms}S/2" : $ms/2 . "S"; } elsif (nearly_integer($_*2)) { my $ms = int($_*2 + 0.5); push @c, $ms % 2 ? "$ {ms}/2" : $_ . "S"; } else { push @c, sprintf "%.2f", $_; } } "(" . join(", ", @c), ")"; } sub nearly_integer { my $x = shift; close_to($x, int($x)); } ################################################################ sub add_tile { my $state = shift; my ($c, $used) = @$state; my @new; my ($i, $n, $action); print " ", join(" ", map $_->[0], @$c), "\n"; if (defined($i = next_to_eliminate($c, $target))) { my ($cn, $cs) = ($c->[$i][0] =~ /(\d+)(.*)/); $n = ((6 + $cn) % 12) . $cs; $action = "eliminate"; print " Trying to eliminate item #$i ($c->[$i][0]) by inserting $n\n"; } elsif (defined($n = next_to_introduce($c, $target))) { $action = "introduce"; print " Trying to introduce $n\n"; } else { "???" } for my $name (keys %tile) { next if exists $used->{$name}; # Can't use same tile twice my %used = (%$used, $name => 1); for my $tile (@{$tile{$name}}) { for my $tp (adjust_to($n, $tile)) { my ($new_conf, $new_used); if ($action eq "eliminate") { ($new_conf, $new_used) = insert_into($c, $i, $tp); } elsif ($action eq "introduce") { $new_used = $tp; $new_conf = [@$new_used]; } $used{$name} = $new_used; push @new, [$new_conf, \%used]; } } } return @new; } sub win { my $state = shift; my ($c, $used) = @$state; return if defined next_to_eliminate($c, $target); return $#$c == $#$target; } ################################################################ # Look through the tile for a specified value # reorganize the tile so that that value is first sub adjust_to { my ($val, $tile) = @_; my @adjusted; for my $i (0 .. $#$tile) { next unless $tile->[$i][0] eq $val; my @tile = @$tile; push @tile, splice(@tile, 0, $i); push @adjusted, [@tile]; } return @adjusted; } # given configuration, insert position, and new tile, # insert new tile into configuration at given position # eliminate superfluous motions sub insert_into { my ($c, $pos, $t) = @_; my @c = @$c; my @tp; { my $p1 = ($pos+1) % @c; @tp = @{mark_positions($c[$p1][1], $c[$p1][2], $t)}; splice @c, $pos+1, 0, @tp; } my $reducing; do { $reducing = 0; for my $i (-1 .. $#c-1) { my ($a, $b) = ($c[$i][0], $c[$i+1][0]); my ($an, $as) = ($a =~ /(\d+)(.*)/); my ($bn, $bs) = ($b =~ /(\d+)(.*)/); next unless abs($an - $bn) == 6; next unless $as eq $bs; if ($i == -1) { pop @c; shift @c; } else { splice @c, $i, 2; } $reducing = 1; last; } } while $reducing; (\@c, \@tp); } # Given x and y coordinates, and TP, a number list, # calculate the positions of the vertices of the tile, # given that the first vertex in the list is at (x, y) # Return list of ([number, x, y], ...) in the same order # as the original TP sub mark_positions { my ($X, $Y, $tp) = @_; # It's already marked if (ref $tp->[0]) { $X -= $tp->[0][1]; $Y -= $tp->[0][2]; return [map [$_->[0], $_->[1]+$X, $_->[2]+$Y], @$tp]; } my @coords = (); my ($x, $y) = ($X, $Y); for my $v (@$tp) { push @coords, [$v, $x, $y]; my ($turn, $len) = ($v =~ /(\d+)(.*)/); my $angle = 2 * $PI * (15 - $turn) / 12; $len = ($len eq "*" ? sqrt(3) : 1); $x += $len * cos($angle); $y += $len * sin($angle); } unless (close_to($x, $X) and close_to($y, $Y)) { warn "Uh oh, tile was not closed: ($x, $y) != ($X, $Y)\n"; } \@coords; } sub close_to { my ($a, $b) = @_; abs($a-$b) < 1e-6; } sub next_to_eliminate { my ($here, $there) = @_; for my $i (0 .. $#$here) { return $i if $i > $#$there || $here->[$i][0] ne $there->[$i]; } return; } sub next_to_introduce { my ($here, $there) = @_; return $there->[@$here]; } sub expand_set { my $tiles = shift; for my $name (keys %$tiles) { my @set; for (0 .. 11) { push @set, rotate($tiles->{$name}, $_), rotate(flip($tiles->{$name}), $_); } $tiles->{$name} = [map mark_positions(0, 0, $_), tile_set(@set)]; } } #convert a tile to a string sub tile_to_string { my @tile = @{canonical(shift())}; @tile = map $_->[0], @tile if ref $tile[0]; "@tile"; } # Rotate a tile by $rot*30 degrees sub rotate { my ($tile, $rot) = @_; $tile = [@$tile]; for (@$tile) { my ($n, $star) = $_ =~ /(\d+)(.*)/; $_ = (($n + $rot) % 12) . $star; } $tile; } # Reflect a tile sub flip { my $tile = shift; $tile = [reverse @$tile]; for (@$tile) { my ($n, $star) = $_ =~ /(\d+)(.*)/; $_ = (12 - $n) . $star; } $tile; } sub tile_set { my %seen; for my $tile (@_) { $seen{tile_to_string(canonical $tile)} = $tile; } values %seen; } # reorder a tile into canonical form sub canonical { my $tile = [@{shift()}]; my $canonical = [@$tile]; for (0 .. $#$tile) { push @$tile, shift @$tile; @$canonical = @$tile if tilecmp($tile, $canonical) < 0; } $canonical; } sub tilecmp { my ($a, $b) = @_; my $tagged = ref $a->[0]; for my $i (0 .. $#$a) { return 1 if $i > $#$b; my $cmp = $tagged ? $a->[$i][0] <=> $b->[$i][0] : $a->[$i] <=> $b->[$i]; return $cmp if $cmp; } return -1 if $#$a < $#$b; return 0; } sub splitnum { my ($nn, $ns) = $_[0] =~ /^(\d+)(.*)$/; wantarray ? ($nn, $ns) : $nn; } sub show { my ($used, $fh) = @_; print $fh "%!PS\n%10 10 scale\n%8.5 11 translate\n"; print $fh "gsave 150 150 translate\n"; for my $name (keys %$used) { next unless defined $used->{$name}; print $fh "% Tile $name\ngsave\n"; showtile($used->{$name}, $fh); } print $fh "grestore\n"; # print $fh "showpage\n"; } sub showtile { my ($tile, $file) = @_; my ($first, @rest) = @$tile; printf $file "%d %d moveto\n", $_->[1]*50, $_->[2]*50 for $first; printf $file "%d %d lineto\n", $_->[1]*50, $_->[2]*50 for @rest; print $file "closepath stroke\n"; }