Download the raw code.
#!/usr/bin/env perl6
use v6;
# in a board, True stands for an empty slot and False for a filled slot
#
# I call a consecutive run of at least 2 empty slots an "island".
# returns a list of pairs, which .key being the first index of the island,
# and .value the length
sub islands(@b) {
return () unless any @b;
gather {
my $island-start = @b.pairs.first(*.value).key;
for $island-start + 1 .. @b.end -> $i {
if !@b[$i] {
given $i - $island-start {
take $island-start => $_ if $_ >= 2;
}
$island-start = $i + 1;
}
}
# since @b[*-1] is never empty, we don't have to check for islands
# at the end of @b.
}
}
sub game-ended(@board) {
return False if all @board;
not islands(@board.rotate(1 + @board.pairs.first(!*.value).key));
}
sub next-move(@board) {
if all(@board) {
# without loss of generality etc.
return 0;
}
# get around considering circular boundary conditions by a simple shift
# the +1 ensures that the alst array item is never empty.
my $offset = 1 + @board.pairs.first(!*.value).key;
my @b = @board.rotate($offset);
# backward transformation
my &return-shifted = -> $x as Int {
# say "return (unshifted) $x";
return ($x + $offset) % @board;
}
my @islands := islands(@b);
if @islands == 1 && @islands[0].value %% 2 {
# we can just slice the island into two, and then always do
# the same move as the other player in the other half
return-shifted @islands[0].key + @islands[0].value div 2 - 1
}
sub mmin(Int $x) { ($x + 1) div 3 }
sub mmax(Int $x) { $x div 2 }
my $min-moves = [+] map &mmin, @islands>>.value;
my $max-moves = [+] map &mmax, @islands>>.value;
sub first-choice {
@islands.first({mmin(.value) != mmax(.value)});
}
given $max-moves - $min-moves {
when * % 2 == 1 {
return-shifted(first-choice.key + $min-moves % 2);
}
default {
if $max-moves % 2 == 1 {
# we'd like to preserve the max number of moves
return-shifted(@islands[0].key)
} else {
# reduce the number of choices by one
my $p = first-choice;
if $p {
return-shifted($p.key);
} else {
# there's nothing we can do anyway
return-shifted(@islands[0].key);
}
}
}
}
}
sub computer-move(@board) {
my $next = next-move(@board);
my $second = ($next + 1) % @board;
say "computer takes $next,$second";
return ($next, $second);
}
sub prompt-for-human-move(@board) {
say "human to move: ", join(',', @board.pairs.grep(*.value)>>.key);
my @next = get.chomp.split(/\, \s*/)>>.Int;
}
sub play(Int $size where { $_ >= 2 }, $start where { $_ eq any <computer human> }, :&computer = &computer-move, :&human = &prompt-for-human-move) {
my &abort := -> $reason = "aborted" { say $reason; return };
my @player = <computer human>;
my %other = @player Z=> @player.rotate;
my %move-maker = :&computer, :&human;
# say %move-maker.perl;
my @board = True xx $size;
my $player = $start;
while !game-ended(@board) {
# say (:$player).perl;
my @next = %move-maker{$player}.(@board);
if @next != 2 {
abort 'Illegal move (not two numbers)';
} elsif [==] @next {
abort 'Illegal move: numbers are the same';
} elsif (@next[0] + 1) % $size != @next[1] {
abort 'Illegal move: numbers are not adjacent';
} elsif not 0 <= all(@next) < $size {
abort "Illegal numbers (must be between 0 and {$size-1}";
} elsif not all @board[@next] {
abort "Sorry, at least one of those stones was already taken";
}
@board[@next] = False xx 2;
$player = %other{$player};
}
say %other{$player}, " wins";
}
multi sub MAIN() {
my &abort := -> $reason = "aborted" { say $reason; return };
my $size = (get() // abort).chomp.Int;
abort if $size < 2;
my @player = <computer human>;
my %other = @player Z=> @player.rotate;
my @board = True xx $size;
my $start-player = (get() // abort).chomp;
abort unless $start-player eq any @player;
play :$size, start => $start-player;
}
multi sub MAIN('test') {
use Test;
plan *;
is next-move([True xx 5]), 0, 'empty board => 0';
is next-move([True xx 2, False xx 2]), 0, 'only choice left (0)';
is next-move([False xx 2, True xx 2]), 2, 'only choice left (2)';
ok next-move([True, False, False, True]) == any(0,3), 'only choice left (circular)';
ok next-move([True xx 2, False xx 2, True xx 2, False xx 2])
== any(0, 4), '2 islands length 2';
ok next-move([True xx 3, False xx 2, True xx 3, False xx 2])
== any(0, 1, 5, 6), '2 islands length 2';
is next-move([False xx 2, True xx 4]), 3, 'winning move with length 4 (1)';
ok next-move([False xx 2, True xx 4, False xx 2, True xx 3])
== any(2, 4),
'winning move with length 4 (2)';
is next-move([False, True xx 10, False]), 5, 'winning move for length 10';
done;
}
# vim: ft=perl6
This version of the code carries three improvements:
A comment adding the missing documentation for islands I complained about.
I'm glad to see it; incidentally, I complained about it before I saw the
improvement. 'Course, you'll have to trust me on that. :-)
The array @island has changed name to @islands. Ok, that one slipped me
by, but thumbs up for the name change.
In next-move, a further heuristic has been added to slice islands with
even lengh in twain, further improving the play. Incidentally this little
afterthought corresponds to the entire strategy of play in fox's solution.
The new little heuristic plugs the hole I found in the previous version. So I guess I'll have to find a new one:
15
human
human to move: 0,1,2,3,4,5,6,7,8,9,10,11,12,13,14
6,7
computer takes 8,9
human to move: 0,1,2,3,4,5,10,11,12,13,14
10,11
computer takes 13,14
human to move: 0,1,2,3,4,5,12
2,3
computer takes 4,5
human to move: 0,1,12
0,1
human wins