#!/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