#!/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 = &computer-move, :&human = &prompt-for-human-move) { my &abort := -> \$reason = "aborted" { say \$reason; return }; my @player = ; 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 = ; 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