in reply to [code challenge] knights move
Same algorithm, but much faster.
#!/usr/bin/perl # http://perlmonks.org/?node_id=1131329 [code challenge] knights move use strict; use warnings; my @queue = my $start = <<endofdata; # find backwards OOO ... ... XXX endofdata tr/XO/OX/ for my $end = $start; my %from; my $count = 0; my @changes = map { # make all patterns my ($skip, $gap) = map "\0" x $_, split /-/; [ "$skip\xff$gap\xff", "${skip}.${gap}X", "${skip}X${gap}.", "${skip}v${gap}v", "${skip}.${gap}O", "${skip}O${gap}.", "${skip}a${gap}a" ], } qw(0-5 0-8 1-6 1-8 2-1 2-6 4-5 4-8 5-6 5-8 6-1 6-6 8-5 10-1); while( $_ = shift @queue and $_ ne $end ) # breadth first search { for my $change ( @changes ) { my ($mask, $x, $xrev, $xnew, $o, $orev, $onew) = @$change; if( ($mask &= $_) eq $x || $mask eq $xrev ) { $xnew ^= $_; $from{$xnew} //= do { push @queue, $xnew; $_ }; } elsif( $mask eq $o || $mask eq $orev ) { $onew ^= $_; $from{$onew} //= do { push @queue, $onew; $_ }; } } } my $answer; while( $from{$end} ) # print in reverse order of found { $count++; if( $answer ) { my @lines = $end =~ /.+/g; $answer =~ s/\n/' ' . shift(@lines) . "\n"/ge; } else { $answer = $end; } $end eq $start and last; $end = $from{$end}; # go back a step } printf '%3d' . ' %3d' x ($count-1) . "\n\n", 1..$count; print $answer;
|
|---|