p4-moritz

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

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 @island := islands(@b);

    sub mmin(Int $x) { ($x + 1) div 3 }
    sub mmax(Int $x) { $x div 2 }

    my $min-moves = [+] map &mmin, @island>>.value;
    my $max-moves = [+] map &mmax, @island>>.value;

    sub first-choice {
        @island.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(@island[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(@island[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)';

    done;
}


# vim: ft=perl6

Readability

Nice and neat, and with a certain grace.

Funny comment on line 30:

# without loss of generality etc.

(Referring to the fact that the stones are in a ring and it doesn't matter which move is chosen.)

Consistency

# in a board, True stands for an empty slot and False for a filled slot

Whyyy? Why this way, and not the other way around? Does the absence of a stone feel like True to you? Wait, don't answer that.

Anyway, it turns out that "empty slot" actually corresponds to "there's a stone there", and "filled slot" corresponds to "there's not a stone there". So it's actually... right... anyway. It's just that the comment introduces a new concept (slots) that is the opposite of stones and boolean values. Thankfully, the word "slot" is never used again outside that comment. ("empty" is, and has to be read as "there's a stone there".)

Clarity of intent

The return values of islands aren't clear until one actually reads the source code of that routine. If I were pointy-haired boss over all the programmers in the world, I'd force them to somehow document every return value with more structure than just a plain list of values.

Algorithmic efficiency

The algorithm (contained in next-move) is pretty ingenious, about as good as it gets without nimbers. It considers the various heaps/islands as "switchers" that give a certain wiggle-room in how many moves remain of the game. It then tries to steer the fate into a beneficial number of remaining moves.

It's incorrect, though:

11
computer
computer takes 0,1
human to move: 2,3,4,5,6,7,8,9,10
3,4
computer takes 5,6
human to move: 2,7,8,9,10
8,9
human wins

Idiomatic use of Perl 6

List assignment combined with xx on line 114. Neat.

Very elegant use of nested subs, especially the &return-shifted thing. Personally, I'd have omitted the parens on the calls to return-shifted, to highlight its pretending at keywordship. But that's a matter of taste, I guess. return isn't really a keyword either. :-)

Brevity

Yes, not much verbiage here.