package Games::Chomp;

use 5.006;
use strict;
use warnings;

use Benchmark;
#use Carp;

our $VERSION = '0.03';

=head1 NAME

Games::Chomp - Playing Chomp and calculating P- (winning) positions

=head1 SYNOPSIS

use Games::Chomp;

my $chomp = new Games::Chomp;

$chomp->run;


=head1 DESCRIPTION


Chomp is the name of a mathematical table game with 
finate number of positions. Though it is easily proven 
that the one who moves first has a winning strategy
currently there is no known mathematical function that 
will calculate the next winning move from any given position.

This module provides an algorithm to programatically 
calculate the winning moves for any given position.

The current implementation is still very slow.


=head1 The Rules of the Game

 There is a chocolate of n*m cubes.
 The upper left cube is poisoned. Two people are eating the
 chocolate (at least one cube at a time) and whoever eats the 
 poisoned chocolate loses.

 Eating the chocolate is done by pointing at one of the existing 
 cubes eating it and everything to the right and below it.

 Examples:
 In the following case 
 z - is the poisoned cube.
 o - is a regular cube
 x - is where the player points

 Beginning: a chocolate with 4 rows and 6 cubes in every row.
 zooooo
 oooooo
 oooooo
 oooooo

 player 1 points at row 2 cube 4

 zooooo
 oooxoo
 oooooo
 oooooo

 result:

 zooooo
 ooo
 ooo
 ooo


 player 2 points at row 3 cube 2

 zooooo
 ooo
 oxo
 ooo

 result:

 zooooo
 ooo
 o
 o

 player 1 points at row 1 cube 2

 zxoooo
 ooo
 o
 o

 z
 o
 o
 o

 player 2 points at row 2 cube 1

 z
 x
 o
 o

 result:

 z

 player 1 has to eat the poisoned cube so s/he loses.

=head1 POSITIONS

 P - Previous player wins 
     if you move to such a position you can win the whole game
     it actually means that all the possible moves of the other 
     player will lead him to N-position
     from a P position one can move only to N positions
 N - Next player wins
     If you move to such a position you will probably 
     lose the game (if your opponent is clever)
     It means that there is at least one move that leads to a 
     P-position


=head1 REPRESENTATIONS

 A certain state of the game can be represented in different ways.

=over 4

=item ROW-LENGTH

 One of the ways I call row-length representation. I use this
 representation in my implementation. In this representation we
 give a list of numbers that represent the number of chocolates 
 in the given row. (5,4,3) is the same as
     ooooo
     oooo
     ooo

=item Conjugate Column-length

 In this representation write down how many columns of a certain
 length are in the position. E.g. in the above position we have 
 3 colums of 3 lenth 1 column of 2 length and 1 column of 1 lenght
 hence we write.
 [3,1,1]
 This representation is more compact if the number rows is a lot
 smaller than the number of columns.
 There is a pair of functions to translate positions between the 
 different notations.


 Although in Perl the () and the [] have their own meanings
 (list and reference to anonimous list) I use the above notation
 as introduced by Doron Zeilberger

=back

=head1 COMPLEXITY

 For a chocolate of NxM squares the number of possible positions are
 (M+N above N)  That is   (M+N)! / (M! * N!) which is an exponential
 function in N if M=O(N).

=head1 OBJECTS

Before using anything you have to load the main module:

use Games::Chomp;

=head1 Games::Chomp::Position

This object represents one single position in the game.

It has the capability to traverse all possible positions up to an
upper limit defined within the object. A limit is just a sinle position. 

If we start at position X and set the limit to U then the object is capable
to traverse all possible M positions where M covers X and U covers M if
we look at the real-life representation of the relevant positions.

We can also say that the object will traverse all possible positions
that can be intermediate positions between Y and X.

=head2 METHODS

=over 4


=cut



# ----------------------------------------------------------------
package Games::Chomp::Position;


# ---------------------------------------
=item new

 my $position = new Games::Chomp::Position;

Create a new "position" object

=cut
# The internal data structure is very simple
# The object is a hash which has 3 array references
#   one to the current position in row-length representation
#   one to the upper limit in row-length representation
#   one to the lower limit in row-length representation
# The default values are 0 position and 0 limit.
sub new {
    my $self = shift;
    my $class = ref($self) || $self;
    
    my %data = (
		position     => [0],
		upper_limit  => [0],
		lower_limit  => [0],
		);

    bless(\%data, $class);
    return \%data;
}


# ---------------------------------------
=item display

Displays (on the console) the position in row-length representation

$position->display;

=cut
sub display {
    my $self = shift;

    print "(", join(",", @{$self->{positions}}), ")\n";
    print "---\n";
}

# ---------------------------------------
=item compare

$position->compare(A,B);
A and B are references to row-length representations;
compare returns 
  0   if they are equal
 -1   if A < B
  1   if A > B
undef if not comparable

=cut
sub compare {
    my $self = shift;
    my $a = shift;
    my $b = shift;

    my $ret=0;
    my $i=0;
    while (defined $$a[$i] and
	   defined $$b[$i]) {
	if ($$a[$i] < $$b[$i]) {
	    return undef if $ret == 1;
	    $ret = -1;
	}

	if ($$a[$i] > $$b[$i]) {
	    return undef if $ret == -1;
	    $ret = 1;
	}
	$i++;
    }
    return $ret if @$a == @$b;
    return undef if (@$a < @$b and $ret == 1);
    return undef if (@$a > @$b and $ret == -1);
    return $ret;
}


# ---------------------------------------
=item upper_limit_in_row_length(LIST)

Set and/or retrieve the upper limit in row-length format.
@p = $postion->upper_limit_in_row_length(@p);
@p = $postion->upper_limit_in_row_length;

=cut
sub upper_limit_in_row_length {
    my $self = shift;
    if (@_) {
	my $ret = $self->compare([@_], [$self->row_length]);
	if (not defined $ret) {
	    warn "\nTried to set upper limit that is not comparabel with current position\n";
	    #print STDERR (caller(0))[0,1,2],"\n";
	    #print STDERR (caller(1))[0,1,2],"\n";
	    return ();
	}
	if (0 <= $ret) {
	    @{$self->{upper_limit}} = @_;
	} else {
	    warn("\nUpper limit is lower than current position\n");
	    return ();
	}
    }
    return @{$self->{upper_limit}};
}

# ---------------------------------------
=item lower_limit_in_row_length(LIST)

Set and/or retrieve the lower limit in row-length format.
@p = $postion->lower_limit_in_row_length(@p);
@p = $postion->lower_limit_in_row_length;

=cut
sub lower_limit_in_row_length {
    my $self = shift;
    if (@_) {
	@{$self->{lower_limit}} = @_;
    } else {
	@{$self->{lower_limit}};
    }
}

# ---------------------------------------
=item row_length

Retrieve the current position in row-length representation
@p = $position->row_length;

Set the current position using row-length representation
@p = $position->row_length(@p);


=cut
sub row_length {
    my $self = shift;
    if (@_) {
	my $cmp = $self->compare([@_], [$self->upper_limit_in_row_length()]);
	if (undef $cmp) {
	    warn "\nTried to set position that is not comparable to upper limit\n";
	    return ();
	}
	$cmp = $self->compare([@_], [$self->lower_limit_in_row_length]);
	if (undef $cmp) {
	    warn "\nTried to set position that is not comparable to lower limit\n";
	    return ();
	}

	@{$self->{position}} = @_;
    } else {
	@{$self->{position}};
    }
}

# ---------------------------------------
=item next

$position->next;
Moves to the next position while traversing the space 
up to the upper limit.
Returns TRUE  if moved to new position
Returns FALSE if could not move (because we are at the upper limit)
=cut
# we assume that      lower_limit < position < upper_limit 
# when this method is called
sub next {
    my $self = shift;

    my $i=0;
    while (defined $self->{position}->[$i] and
	   defined $self->{upper_limit}->[$i] and
	   $self->{position}->[$i] == $self->{upper_limit}->[$i]) {
	$i++;
    }

    if (not defined $self->{upper_limit}->[$i]) {
	return 0; # no more positions within this limit
    }


    # set the starting value
    if (not defined $self->{position}->[$i]) {
	if (defined $self->{lower_position}->[$i]) {
	    $self->{position}->[$i] = $self->{lower_position}->[$i];
	} else {
	    $self->{position}->[$i] = 1;
	}
    } else {
	$self->{position}->[$i]++;  # increase the last one
    }

    # set all the previous lines to this value
    # or to their minimal value
    foreach my $j (0..$i-1) {   
	if (defined $self->{lower_limit}->[$j] and
	    $self->{lower_limit}->[$j] > $self->{position}->[$i]) {
	    $self->{position}->[$j] =  $self->{lower_limit}->[$j];
	} else {
	    $self->{position}->[$j] = $self->{position}->[$i];
	}
    }
    return 1;
}

# ---------------------------------------
=item conjugate

@c = $position->conjugate(@c);
Set and return the current position on conjugate column representation

=cut
sub conjugate {
    my $self = shift;

    my @revpos;
    my @conjugate;

    if (@_) {
	@conjugate = @_;
	@revpos = ($conjugate[0]);
	foreach my $i (1..$#conjugate) {
	    push @revpos, $conjugate[$i]+$revpos[-1];
	}
	@{$self->{position}} = reverse @revpos;
    } else {
	unless (@{$self->{position}}) {
	    warn "\nNo position was set\n";
	    return ();
	}
	@revpos = reverse @{$self->{position}};
	@conjugate = ($revpos[0]);
	foreach my $i (1..$#revpos) {
	    push @conjugate, $revpos[$i]-$revpos[$i-1];
	}
    }
    return @conjugate;
}

=back


=head1 Games::Chomp



=head2 METHODS

=over 4

=cut
# ----------------------------------------------------------------
package Games::Chomp;


my $filename = "chomp.txt"; # hardcoded place to save the positions
                            # between runs to reduce computation time

my @P = (); # P-positions (winning)
my @N = (); # N-positions (losing)

my @solved=(0,0); 
   # a list of rectangulars for which we already have full solution.
   # $solved[2]=20 means that 3-rows 20-columns already have full solution
   # described in the P-positions hence we don't need the N-positions smaller
   # than this rectangular.

# ---------------------------------------
=item new

 my $chomp = new Games::Chomp;

=cut
sub new {
    my $self = shift;
    my $class = ref($self) || $self;
    
    my %data;# = (position => []);

    bless(\%data, $class);
    return \%data;
}

sub row_length_position {
   my $self = shift;
   my @p = @_;



}

# ---------------------------------------
=item  $chomp->run;

     ask for position in row-length representation
     computes all the positions up to that position and
     saves them in a file called chomp.txt in the local
     directory.
     Using run later will use the already calculated
     positions that were saved in that file.

=cut
sub run {
    my $self = shift;

    print "Please enter a position separated by spaces: ";
    my $input = <STDIN>;
    chomp $input;
    my $pos = new Games::Chomp::Position;
    $pos->row_length(split / +/, $input);

    my $t0 = new Benchmark;

    $self->load_file();

    if ($self->resolve($pos)) {
	print "Winning P-Positions\n";
	$pos->display;
    } else {
	print "Losing N-Position\n";
	$pos->display;
    }

    my $t1 = new Benchmark;
    my $td = timediff($t1,$t0);
    print "the code took:",timestr($td),"\n";

# $self->show_all_P;
# $self->show_all_N;

    $self->save_file();

}

# ---------------------------------------
=item  $chomp->reset;

     Empties the list of winning positions kept in memory.
     The only case you want to use this is if you want to
     benchmark the module and start from an empty environment.

=cut
sub reset {
    my $self = shift;
    
    @P = ();
    @N = ();

    return 1;  # not really interesting
}


# ---------------------------------------
=item  $chomp->resolve(POSITION);

     POSITION is array reference, it is a reference to a row-length 
     representation.
     
     resolve returns 1 if the above position is a winning position
     and returns 0 if it is a losing position. As a side effect
     it *might* compute the 'winningness' of all the positions
     which are smaller than this one.

=cut
sub resolve {
    my $self = shift;
    my $pos = shift;

#    unless ($self->special_position($pos)) {
	
    if ($self->in_P($pos)) {
	return 1;
    }

    my $rows = $pos->rows;
    my $cols = $pos->cols;

    # in an already solved rectangular
    #if (defined $solved[$rows] and $solved[$rows] >= $pos->[0]) { 
	#return 0;
    #}

    if ($self->in_N($pos)) {
	return 0;
    }


    my @all = $self->all_moves_from_here($pos);
    while (my $p = shift @all) {
#    print "DEBUG: Lengths: ", scalar @all, "\n";
	if ($self->resolve($p)) {  # found winning sub position
	    $self->put_in_N($pos);
	    return 0;
	}
    }
    # all sub positions were losing
    $self->put_in_P($pos);
    return 1;
}

# $c->analyze(3,2,1);
# ---------------------------------------
sub analyze {
    my $self = shift;
#    my $position = shift;

    my $p = new Games::Chomp::Position;
    $p->upper_limit_in_row_length(@_);
    while ($p->next) {
	
    }
    
}

=pod

sub analyze_rect {
    my $self = shift;
    #my $pos = shift;
    my $rows = shift;
    my $cols = shift;
    
    if (defined $solved[$rows] and $solved[$rows] >= $cols) {
	return 1;
    }
    if ($rows <= 2 or $cols == 0) {
	return 1;
    }

    if ($cols < $rows+2) {
	$self->analyze_rect($rows-1, $cols);

    }


}

# (1), (n+1, n)

# analyze all positions with not more that n stones
sub analyze_number {
    my $self = shift;
    my $number = shift;

    if ($number > 1) {
	analyze_number($number-1);
    }
    foreach my $pos (all_positions_with_n($number)) {
	$self->resolve($pos);
    }
}


sub fill_solved {
    my $self = shift;
    my $pos = shift;

#    return;
    foreach my $r (2..$#$pos) {
	last if ($pos->[$r]<2);
	next if (defined $solved[$r] and $solved[$r] >= $pos->[$r]);
	$solved[$r] = $pos->[$r];
	my @tempN = ();
	foreach my $p (@N) {
	    if ($#$p > $r or $p->[0]> $pos->[0]) {
		push @tempN, $p;
	    }
	}
	@N = @tempN;
    }
}

=cut

# ---------------------------------------
sub in_P {
    my $self = shift;
    my $pos = shift;

    return 1 if ($self->special_position($pos) eq "win");

    $self->in_group($pos, \@P);
}

# ---------------------------------------
sub in_N {
    my $self = shift;
    my $pos = shift;
    return 1 if ($self->special_position($pos) eq "lose");

    $self->in_group($pos, \@N);
}

# ---------------------------------------
sub special_position {
    my $self = shift;
    my $pos = shift;

#    return 0 if $sel

    if ($pos->rows == 1) {   # one row only
	return ($pos->cols == 1  ? "win" : "lose");
    }

    my @c = $pos->conjugate;
    if ($pos->rows == 2) {   # two row
	return ($c[1]==1 ? "win" : "lose");
    }

    # 3 or more rows
    if ($c[1] == 1) {    # n, n-1
	return "lose";
    }

#    if ($pos->[0] == @$pos) {   # sqare
#	return $pos->[1] == 1 ? "win" : "lose";
#    }
    return 0;
}

# ---------------------------------------
sub in_group {
    my $self = shift;
    my $pos = shift;
    my $group = shift;

POS:foreach my $p (@$group) {
        $pos->is_same_row_length(@$p);
	#next unless (@$pos == @$p);
	#foreach my $i (0..$#{$pos}) {
	#    next POS if ($pos->[$i] != $p->[$i]);
	#}
	#return 1; # all rows were equal
    }
    return 0;
}

# ---------------------------------------
=item  $chomp->show_all_P

     prints all the P (winning) positions calculated so far
     (except the already obvious onces.) in row-length representation.

=cut
sub show_all_P {
    my $self = shift;

    print "All P (Previous player wins) Positions:\n";
    foreach my $p (@P) {
	$self->display_position($p);
    }
}

# ---------------------------------------
sub show_all_N {
    my $self = shift;

    print "All N (Next Player wins) Positions:\n";
    foreach my $p (@N) {
	$self->display_position($p);
    }
}
	

# ---------------------------------------
# separate function so we can hold the winning and losing positions
# in any format.
sub put_in_P {
    my $self = shift;
    my $pos = shift;
    push @P, [$pos->row_length];
}

sub put_in_N {
    my $self = shift;
    my $pos = shift;
    push @N, [$pos->row_length];
}




=pod
sub all_positions_till {
    my $self = shift;
    my $pos = shift;

    my @list = ();
    my $p = [1];
    while ($p , $pos) {
	#$p = next;
    }
}
=cut

# get a reference to a position (later position object)
# and returns a list of all the possible positions that can be reached
# from here
sub all_moves_from_here {
    my $self = shift;
    my $pos = shift;

    my @possible=();
ROW:for (my $row=0; $row < @$pos; $row++) {
COL:    for (my $col = 0; $col< $pos->[$row]; $col++) {
	    next COL if ($row == 0 and $col ==0);
	    my @newpos = @$pos;  # a copy of the current position
	    #$newpos[$row] = $col;
	    if ($col) {
		for (my $newrow=$row; $newrow < @$pos; $newrow++) {
		    if ($newpos[$newrow]> $col) {
			$newpos[$newrow]=$col;
		    }
		}
	    } else {
		$#newpos=$row-1;
	    }
	    push @possible, \@newpos;
	}
    }
    return @possible;
}
				    


sub load_file {
    my $self = shift;

    return 0 unless (-e $filename);
    open F, $filename or return 0;
    while (my $line = <F>) {
	chomp $line;
	my @values = split /,/, $line;
	my $group = shift @values;
	if ($group eq "P") {
	    push @P, \@values;
	} elsif ($group eq "N") {
	    push @N, \@values;
	} elsif ($group eq "S") {
	   @solved = @values;
	} else {
	    warn "\nINVALID LINE: $line\n";
	}
    }
    close F;
}


sub save_file {
    my $self = shift;

    open F, ">", $filename or die "Could not save to file\n";

    print F join ",", "S", @solved;
    print F "\n";

    foreach my $pos (@P) {
	print F join "," , "P", @$pos;
	print F "\n";
    }

    foreach my $pos (@N) {
	print F join "," , "N", @$pos;
	print F "\n";
    }

    close F;
}
=pod
sub display_position {
    my $self = shift;
    my $pos = shift;

    foreach my $p (@$pos) {
	print "$p\n";
    }
    print "---\n";
}
=cut


# ---------------------------------------
=item  $chomp->transpose(POSITION)

Returns a reference to an array which is a POSITION where
the rows and the columns are transposed.
given [5,4,3]  it returns [3,3,3,2,1]
not implemented yet

=cut
sub transpose {
    my $self = shift;

}

1;





=back

=head1 TODO

 Add more test for larger postitions
 Benchmark: compare time of 40, 20 , 20   with 40, 30, 30 and 
 make similar comparisons.
 Implement the ideas explained the below mentioned articles.
 Increase speed, increase speed, increase speed
 Add the solved array and by that reducing the memory
     requirements and increasing the speed

 Further check position and limit when the user tries to update them to
    make sure that    Lower Limit < Position < Upper Limit 
    is true all the time

=head1 AUTHOR

 Gabor Szabo <lt>gabor@tracert.com<gt>

=head1 COPYRIGHT

 The Games::Chomp module is Copyright (c) 2002 Gabor Szabo.
 All rights reserved.
 
 You may distribute under the terms of either the GNU General Public
 License or the Artistic License, as specified in the Perl README file.

=head1 SEE ALSO

 Three-Rowed CHOMP by Doron Zeilberger
 Appeared in Adv. Applied Math. v. 26 (2001), 168-179. 
 http://www.math.temple.edu/~zeilberg/mamarim/mamarimhtml/chomp.html

 Xinyu Sun: An improvement on Chomp
 http://www.math.temple.edu/~xysun/chomp/chomp.htm

=cut