Download the raw code.
use v6;
#try to move the mein piece right, and try to remove obstacles
class Groove {
has @.start;
has Str $.name;
has @.right;
};
grammar PieceGrammar {
token TOP { ^ <groove> <range> $ }
token range { (\d ** 2..3)
<!{ my @a := $0.comb.sort;
@a leg (@a[0]..@a[*-1]);
}> }
token groove { <[a..w]> }
};
class Piece {
has @.cells;
has Groove $.groove;
method doMove(Int $direction) {
for @.cells -> $cell {
@$cell >>+=>> (@$direction <<*>> $.groove.right);
}
}
method Str {
my @curcell = @($.groove.start);
my $str = $.groove.name;
for 1..7 {
$str ~= $_ if !(@.cells[0] leg @curcell) ff !(@.cells[*-1] leg @curcell);
@curcell <<+=>> $.groove.right;
}
return $str;
}
};
class Board {
has @.cells;
has Piece @.pieces;
has Groove %.grooves;
submethod initGrooves(@range, %starts, @direction) {
for @range Z %starts{@range} -> $key, $value {
my $field = $value.comb.map: {.ord};
%.grooves{$key} = Groove.new(:name($key),:right(@direction),:start($field));
}
}
submethod BUILD {
my %starts = {:a<at>, :b<bs>, :c<cr>, :d<dq>, :e<ep>, :f<fq>, :g<gq>,:h<hr>,
:i<ep>, :j<fp>, :k<fq>, :l<gq>, :m<gr>, :n<hr>, :o<hs>, :p<fp>, :q<gq>,
:r<hr>, :s<hs>, :t<gt>, :u<fu>, :v<ev>, :w<dw>};
self.initGrooves('a'..'h',%starts,(0,1));
self.initGrooves('i'..'o',%starts,(-1,1));
self.initGrooves('p'..'w',%starts,(-1,0));
}
method isOnBoard(@cell) {
return 'a'.ord+'t'.ord <= ([+] @cell) <= 'd'.ord+'w'.ord
&& 'a'.ord-'u'.ord <= ([-] @cell) <= 'g'.ord-'q'.ord;
}
method getPiece(@cell) {
for @.pieces -> $piece {
if ($piece.cells.grep: {!($_ leg @cell)}) {
return $piece;#cast?
}
}
return Bool::False;
}
method addPiece(Piece $piece) {
for $piece.cells -> $cells {
if (!self.isOnBoard(@$cells) or self.getPiece(@$cells)) {
die "invalid pieces";
}
}
@.pieces.push($piece);
}
};
sub move($board, @plan) {
@plan or return ("end");
my ($piece,$direction) = @(pop @plan);
my $cell = $piece.cells[$direction < 0 ?? 0 !! *-1];
my @newcell = @$cell >>+>> ($direction <<*>> $piece.groove.right);
if (my $obstacle = $board.getPiece(@newcell)) {
my ($left, $right) = $obstacle.cells.elems, 1;
while $obstacle.cells[$right-1] leg @newcell {
($left, $right) <<+=>> (-1,1);
}
my $lastdir = 0;
for @plan.reverse -> $p {
if ($p[0] ~~ $obstacle) {
$lastdir = $p[1];
last;
}
}
if (my $resultl = ($lastdir != -1) &&
move($board, (@plan,[($piece,$direction)],[$obstacle,-1] xx $left).list)) {
return @$resultl;
}
if (my $resultr = ($lastdir != 1) &&
move($board, (@plan,[($piece,$direction)],[$obstacle,1] xx $right).list)) {
return @$resultr;
}
return Bool::False;
} elsif ($board.isOnBoard(@newcell)) {
$piece.doMove($direction);
if ( my $solution = move($board, @plan)) {
my $res = $piece.Str;
$piece.doMove(-$direction);
return ($piece.Str, $res, @$solution);
}
$piece.doMove(-$direction);
return Bool::False;
} else {
return Bool::False;
}
}
sub MAIN {
my Board $board .= new();
while $*IN.get() -> $line {
my $g := PieceGrammar.parse($line) or say "invalid Piece" and return;
my @d := $g{'range'}.comb.sort;
my $groove = $board.grooves{$g{'groove'}};
my @cells = ((@d <<->> 1) X* $groove.right).map:
->$x,$y {[$groove.start <<+>> ($x, $y)]};
$board.addPiece(Piece.new(:cells(@cells), :groove($groove)));
}
my $start = $board.getPiece(('g'.ord,'q'.ord));
$start and $start.cells.elems == 2 and $start.groove.name eq "l" or say "No bullet specified" and return;
my @plan = [$start,1] xx 4;
my @solution = move($board, @plan);
@solution[0] or say "no solution" and return;
my ($curgroove, $curpos, $curstart) = ();
while (@solution.shift ~~ /(.)(\d+)/) {
if ($0 ne $curgroove) {
$curgroove.defined and say "$curgroove\[$curstart -> $curpos\]";
($curgroove, $curstart) = ($0,$1);
} else {
$curpos = $1;
}
}
say "$curgroove\[$curstart -> $curpos\]";
}
The program goes into an infinite loop sometimes, for example for the following input:
e12
e345
k34
l12
The algorithm does find solutions sometimes — not always optimal ones — but the fact that it hangs on certain inputs makes a big dent in its correctness scoring.
Tab characters are used both for indentation and (in a few cases) for vertical alignment. A stray tab character found its way into the middle of line 55.
This solution has a complicated internal representation where each position is
uniquely denoted by two lower-case letters. For example, the bullet in an
initial configuration is located at gq.
Efficiency is not really measurable since the algorithm is incorrect.
Many clever uses of hyperops, zips, cross products, leg, ff, chained
comparisons.
The slightly un-idiomatic while $*IN.get() -> $line { better written for
lines() -> $line {.
.map: {.ord} could've been written as .map: &ord. Or maybe even ยป.ord.
Piece.new(:cells(@cells), :groove($groove)) could have been abbreviated to
Piece.new(:@cells, :$groove). This is only really noteworthy because brevity
seems to be a concern almost everywhere else in the code.
Similarly, return Bool::False could've been simply return False. (Or simply
return. The values returned go into a list anyway, so the following
@solution[0] check could be simplified to @solution if Nil is returned,
as with return.)
The same brief, telegraph-like style is used in this solution as in the previous ones by the author. This is a slightly bigger problem than the other ones, so here the program is longer too. Arguably readability suffers a bit with this style as programs grow longer.