# Copyright 1997 by Steven McDougall.  
# This module is free software; you can redistribute it and/or modify it
# under the same terms as Perl itself.

package Game::Stones;

use strict;
use 5.004;

my @Game;


sub Take
{
    my($mine, $his, $pile, $maxTake) = @_;

    GetRow($pile, $maxTake)->{me}[$mine&1]{take}
}


sub GetRow
{
    my($pile, $maxTake) = @_;

    $Game[$maxTake] or GenerateGame($maxTake);

    my $game   = $Game[$maxTake];
    my $lower  = $game->{lower};
    my $period = $game->{period};
    my $row    = $pile < $lower ? $pile : $lower + ($pile-$lower) % $period;

    $game->{position}[$row]
}


sub GenerateGame
{
    my $maxTake = shift;
    
    my $position;
    $position->[0]{me }[0]{winner} = 'him';
    $position->[0]{me }[1]{winner} = 'me' ;
    $position->[0]{him}[0]{winner} = 'him';
    $position->[0]{him}[1]{winner} = 'me' ;

    my($lower, $upper);

    for my $pile (1..10001)
    {
	for my $player (qw(me him))
	{
	    for my $parity (0..1)
	    {
		Play($maxTake, $position, $pile, $player, $parity);
	    }
	}

	($lower, $upper) = Cycle($position, $pile, $maxTake);
	$lower and last;
    }

    $Game[$maxTake] = { position => $position,
			lower    => $lower,
			period   => $upper - $lower };
}


my %Other = ( me  => 'him',
	      him => 'me' );

sub Play
{
    my($maxTake, $position, $pile, $player, $parity) = @_;

    $position->[$pile]{$player}[$parity] = { winner => $Other{$player},
					     take   => 1              };
    
    for (my $take=1; $take<=$maxTake && $take<=$pile; $take++)
    {
	my $pile1     = $pile-$take;
	my $player1   = $Other{$player};
	my $parity1   = $player eq 'me' ? $parity ^ ($take & 1) : $parity;
	my $position1 = $position->[$pile1]{$player1}[$parity1];

	if ($position1->{winner} eq $player)
	{
	    $position->[$pile]{$player}[$parity] = { winner => $player,
						     take   => $take   };
	}
    }
} 


sub Cycle
{
    my($position, $pile, $maxTake) = @_;

    for my $p ($maxTake..$pile/2)
    {
	if (CompareBlocks($position, $pile, $pile-$p, $p)==0)
	{
	    my $lower = $pile - $p;
	    return $pile-$p, $pile;
	}
    }

    undef
}


sub CompareBlocks
{
    my($position, $block1, $block2, $height) = @_;

    for my $h (0..$height-1)
    {
	CompareRows($position->[$block1-$h], 
		    $position->[$block2-$h]) and return 1;
    }

    0
}


sub CompareRows
{
    my($row1, $row2) = @_;

    for my $player (qw(me him))
    {
	for my $parity (0..1)
	{
	    $row1->{$player}[$parity]{winner} eq
	    $row2->{$player}[$parity]{winner} or return 1;
	}
    }

    0
}


__END__


=head1 NAME

Game::Stones - plays the game of Stones

=head1 SYNOPSIS

  require Game::Stones;
  
  $take = Game::Stones::Take($my_stones, $his_stones, $pile, $maxTake);

=head1 REQUIRES

Perl 5.004

=head1 EXPORTS

Nothing

=head1 DESCRIPTION

In the game of Stones,
two players sit opposite an odd number of stones.
The players alternate taking a number of stones between 1 and N
until all the stones are gone.
The winner is the player with an odd number of stones.

C<Game::Stones> plays the game of Stones.
Whenever it is the module's turn,
call C<Game::Stones::Take>.
The parameters are:

=over 4

=item C<$my_stones>

The number of stones that the module has

=item C<$his_stones>

The number of stones that the other player has

=item C<$pile>

The number of stones remaining in the pile

=item C<$maxTake>

The maximum number of stones that may be taken in one turn

=back

C<Game::Stones::Take> returns the number of stones that the 
module takes on that turn.

=head1 ANALYSIS

=head2 State of play

The game of Stones is parameterized by 

  maxTake - the maximum number of stones that may be taken in one turn

The state, or position, of a game of Stones is described by a 4-tuple:

  (Pile, Turn, A, B)

Where:

  Pile is the number of stones remaining in the pile
  Turn indicates which player has the next turn
  A    is the number of stones in player A's pile
  B    is the number of stones in player B's pile

For example, the position at the start of a game with 7 stones, where A
goes first, would be written 

  (7, A, 0, 0).

=head2 Searching the move tree

In principle, we can find the optimal strategy from any position by
doing a complete search of the move tree from that position. This can
be done with a simple recursive algorithm. However, this is not a
practical solution because the number of nodes in the tree grows
exponentially with Pile.

=head2 Parity

We can simplify the problem by observing that the actual number stones
in a player's pile is irrelevant: only the parity matters. This is
true not just for the final position (where Pile==0) but for any
position.

We can further simplify by recalling that there are always an odd
number stones in the game. Therefore, the parity of B's pile is
determined by Pile and the parity of A's pile. This means that we can
represent any position as a 3-tuple:

  (Pile, Turn, pA)

where Pile and Turn are as before, and pA is the parity of A's pile.

=head2 Dynamic Programming

Next, we observe that many paths through the move tree lead to the
same positions. Rather than evaluate these positions repeatedly on
each branch of the tree, we keep a table of previously evaluated
positions. In C, we might declare this table as

  /*          Pile  Turn    pA  */
  int Winner[10002][ 2  ][   2]

Each time we encounter a position in the move tree, we check the
table. If there is an entry, we prune the search tree at that node and
use the saved result; otherwise, we evaluate the position and record
the result in the table.

Regardless of the potential of a recursive algorithm to explode
exponentially, the number of positions in the table is linear in
Pile. Since we never evaluate any position more than once, we can now
search the move tree in linear time.

This technique of reducing an exponential algorithm to a polynomial one by
keeping a table of previously solved sub-problems goes by the general
name "dynamic programming".

=head2 Bottom up

Now that we have the table, it is simpler to fill it in from the
bottom up using a single loop than to search through it from the top
down using a recursive subroutine. 

=head2 Winners & losers

Row 0 can be filled in by inspection: A wins if his pile has odd
parity, and it doesn't matter whose turn it is.

  #      Pile  Turn  pA 
  Winner[   0]{   A}[ 0] = "B";
  Winner[   0]{   A}[ 1] = "A";
  Winner[   0]{   B}[ 0] = "B";
  Winner[   0]{   B}[ 1] = "A";

For positions in higher rows, we define the winner as the player who
has a winning strategy from that position.

=head2 Accessible positions

To evaluate positions in higher rows, we consider the set of
accessible positions.  An accessible position is a position that can
be reached from the current position in one turn. Consider:

  maxTake = 3
  
                        Pile  Turn  pA
  Current    position  (   5,    A,  1)
  Accessible positions (   4,    B,  0)
                       (   3,    B,  1)
                       (   2,    B,  0)
  
  Current    position  (   5,    B,  1)
  Accessible positions (   4,    A,  1)
                       (   3,    A,  1)
                       (   2,    A,  1)

There are two significant facts about accessible positions:

=over 4

=item 1

Pile is smaller. Therefore, each accessible position is in a lower row
of the table, and has already been evaluated.

=item 2

It is the other player's turn. This is the basis for the algorithm for
assigning a winner to the current position: the current player loses
the current position if and only if the current player loses every
accessible position.

=back

=head2 Cycles

We can make one final simplification by observing that each row of the
table depends only upon the maxTake proceeding rows. Therefore, the
table must be cyclic. The cycle length is limited by the number of
bits of state in maxTake rows.

Each row of the table is specified by 4 bits: the winner for the 4
positions in that row.  maxTake rows are specified by 4*maxTake
bits. Therefore, the table must repeat within 2^(4*maxTake) rows.

For maxTake==3, the maximum cycle length is 2^(4*3) or 4096, which is
less than 10001, but not by enough to bother with. For any higher
value of maxTake, the maximum cycle length is greater than 10001.

However, this is only an upper bound. The cycle length might be
less. For maxTake from 3 to 9, the cycle length turns out to be far
less - no more than 20.

Rather than evaluate the table all the way up to 10001, we can stop
once we detect a cycle. When presented with a position in a row that
we have not evaluated, we reduce Pile modulo the cycle length and
obtain the result from a row that we have evaluated.


=head1 IMPLEMENTATION

Game::Stones is a straightforward implementation of the analysis given
above. The entry point to the module is Game::Stones::Take(). This
routine has the signature described in "The Stones Contest":

  $take = Game::Stones::Take($my_stones, $his_stones, $pile, $maxTake)

=head2 Data Structures

@Game is an array of hashes, one for each value of $maxTake.

    $Game[$maxTake] = { position => $position,
			lower    => $lower,
			period   => $upper - $lower };

$position is the table of game positions.
$lower is the first row in the table cycle and $upper is the last.
period is the period of the cycle. We compute the period and discard
$upper.

The position table is indexed like this:

    $position->[$pile]{me}[$pA]{winner} = 'him';
    $position->[$pile]{me}[$pA]{take  } = $take;

The players are represented by the strings 'me' and 'him'. Since we
actually want to play this game, we need to record not just the winner
for each position, but also the number of stones to take from that
position in order to win. Thus, there is one final hash after the
three indices into the table:

  { winner => $winner,
    take   => $take  }


=head2 Subroutines

GenerateGame($maxTake) fills in the position table. First, it fills in
$position->[0]. Then, it iterates through the higher rows in the table
using three nested loops:

    for my $pile (1..10001)
    {
	for my $player (qw(me him))
	{
	    for my $parity (0..1)
	    {
		Play($maxTake, $position, $pile, $player, $parity);


Play() iterates over the accessible positions 

    for (my $take=1; $take<=$maxTake && $take<=$pile; $take++)
    {

and sets winner and take for the current position. $position1 is a
reference to an accessible position; Play() gets to it by computing
its indices in $position->[]{}[] from the current position and $take:

	my $pile1     = $pile-$take;
	my $player1   = $Other{$player};
	my $parity1   = $player eq 'me' ? $parity ^ ($take & 1) : $parity;
	my $position1 = $position->[$pile1]{$player1}[$parity1];

The expression for $parity1 is slightly squirrelly; review the pA
column in the examples of accessible positions shown above to see why
this is.

If there are several winning values for take, Play() chooses the
largest, on the consideration that we might as well get it over
with. If there are no winning values for take, it takes 1 stone, so as
to give the other player more opportunities to make a mistake.

After filling in each row, GenerateGame() calls Cycle() to see if
there is a cycle in the table. For our purposes, a cycle must contain
at least maxTake rows. We can't detect a cycle until the table is
twice the cycle length.  Cycle() checks for all possible cycle lengths
between these two bounds.

Cycle() calls CompareBlocks() to compare blocks of rows for
equality. CompareBlocks() calls CompareRows() to compare rows. Rows
compare equal if they have the same winners, because winner and take
depend only on the winners in lower rows, not the take values.

When Cycle() detects a cycle, it returns its bounds as 
($lower, $upper) to GenerateGame(). GenerateGame() breaks out of its
loops, records $lower and computes period, and returns.

GetRow($pile, $maxTake) calls GenerateGame() to compute the tables for
$Game[$maxTake], if it hasn't already done so. Then it uses $lower and
$period to reduce $pile to a row of the table that has been evaluated:

    my $row = $pile < $lower ? $pile : $lower + ($pile-$lower) % $period;

Finally, it indexes into $Game[$maxTake]{position} with $row and
returns a row from the table.

Take() calls GetRow() to get a row from the table, and then indexes into
the row with 'me' (because it's my turn) and $mine&1 (the parity of my
pile). This gives it a single position from the table; it returns the
take value for that position.

=head1 BUGS

Not clean under C<-w>. Sorry.

=head1 SEE ALSO

"The Stones Contest", The Perl Journal, #7 (Fall 1997), p48.

"The Stones Contest: Results", The Perl Journal, #9 (Spring 1998), p64.

=head1 AUTHOR

Steven McDougall, swmcd@world.std.com

=head1 COPYRIGHT

Copyright 1997 by Steven McDougall. 
This module is free software; 
you can redistribute it and/or modify it under the same terms as Perl itself.

=cut