in reply to Sliding Tile Puzzle Solver
enjoy!# perl script to solve a sliding tile puzzle # I'm doing 4 x 4 but same should work for other sizes if # there's enough memory -- you need to change sub kids to # return possible moves for your size # Solution is _0123456789abcde which represents # _ 0 1 2 # 3 4 5 6 # 7 8 9 a # b c d e # in this configuration 0 or 3 can swap with _ # actually tiles can be named how you like, but _ is the gap # you put in the desired configuration in $target # (or visa-versa) $solution='_0123456789abcde'; #$target='015234_6789abcde'; $target = shift(@ARGV); srand(time); for(0..50) { rand();} $target=&rnd(30,$solution) unless $target; # random for testing print STDERR "Target is $target\n"; (%t)=($target,''); # %t is kids/grandkids... of target @wt=($target); # workque for target $level=1; $stime=time; $l=70; # I messed around with this to optimize speed / d +epth while(@wt) { # give a bit of feedback print STDERR "$level \r" unless $level & 127; $level++; if( ($a=shift(@wt)) ) { # next item for workque for(&kids($a)) { # for each of the possible moves from her +e next if defined($t{$_}); # if we've been here before, skip it push(@wt,$_); # add this position to the workque $t{$_}=$a; # remember this configuration & its paren +t $md{$_}=&md($_,$solution); # log the distance for this point to the + solution &done($_) if $_ eq $solution; } } # once in a while we want to reorder the workque by their distances if($level % $l == 1) { @wt=(sort bymd @wt)[0 .. 2*$l]; } } print "\nNo solution found.\n"; sub kids { # return a list of all possible moves from this configuration local($_,@r,$i); $i=index($_[0],'_') % 4; $_=$_[0]; push(@r,$_) if $i!=0 && s/(.)_/_$1/; $_=$_[0]; push(@r,$_) if $i!=3 && s/_(.)/$1_/; $_=$_[0]; push(@r,$_) if s/(.)(...)_/_$2$1/; $_=$_[0]; push(@r,$_) if s/_(...)(.)/$2$1_/; return @r; } sub done { # we're done -- print result @r=@_; print STDERR time - $stime," seconds $level tries: done $_[0]\n"; # forward from target for($a=$t{$_[0]}; defined($t{$a}); $a=$t{$a}) { unshift(@r,$a);} # dump results for(@r) { s/(....)/$1 /g; print "$_\n";} exit; } # execute $_[0] random moves on $_[1] sub rnd { $_[0] < 1? $_[1]: &rnd($_[0]-1, &r(&kids($_[1]))); } # return a random element from the list sub r { $_[($#_+1) * rand()];} # return manhattan distance of a to b sub md { local($a,$b,$r)=@_; for(0 .. 15) { $i=index($b,substr($a,$_,1))-$_; $i=-$i if $i < 0; $r+=$i % 4 + int($i/4); } $r; } sub bymd { $md{$a} <=> $md{$b}; }
|
|---|