Analysis of impartial game described at http://math.stackexchange.com/questions/457360/splitting-stacks-nim/

gistfile1.pl

#!/usr/bin/perl                                                                               
#                                                                                             
# http://math.stackexchange.com/questions/457360/splitting-stacks-nim                         
#                                                                                             
#                                                                                             

my %did;
for my $total (1 .. 10) {
  my $pp = partitions($total);
  for my $p (@$pp) {
    next if $did{ to_str($p) }++;
    next if is_terminal_position($p);
    my $v = nim_value($p);
    my $total_pennies = total_pennies($p);
    my $total_piles = total_piles($p);
    my $k = "$total_pennies,$total_piles";
    if (exists $lugo{$k}) {
      if ($lugo{$k}[0] != $v) {
        warn sprintf "positions %s and %s have the same number of pennies and piles\n but nim-values of %d and %d\n",
           to_str($lugo{$k}[1]), to_str($p), $lugo{$k}[0], $v;
      }
    } else {
      $lugo{$k} = [ $v, $p ];
    }
#    printf "%20s %2d\n", to_str($p), nim_value($p);                                          
  }
}

# position has only heaps of sizes 2 and 1                                                        
sub is_terminal_position {
  my ($p) = @_;
  for my $h (@$p) {
    return if $h > 2;
  }
  return 1;
}

# return a list of all the positions reachable in one move from $p                            
sub moves_from {
  my ($p) = @_;
  return () if is_terminal_position($p);
  my @moves;
  for my $i (0 .. $#$p) {
    my $h = $p->[$i];
    for my $m (1 .. int($h/2)) {
      my @new_pos = @$p;
      splice @new_pos, $i, 1, $m, $h-$m;
      push @moves, \@new_pos;
    }
  }  
  return uniq_p(@moves);
}

# format a position as a string                                                               
# equal positions guaranteed to format the same                                               
sub to_str {
  my ($p) = @_;
  join ",", sort { $b <=> $a } grep $_ > 1, @$p;
}

# given a list of positions, remove duplicates                                                
sub uniq_p {
  my %h;
  for my $p (@_) {
    $h{ to_str($p) } = $p;
  }
  return values %h;
}

sub mex {
  my @h;
  $h[$_] = 1 for @_;
  for my $i (0 .. $#h) {
    return $i unless $h[$i];
  }
  return 0 + @h;
}

use Memoize;
# return nim-value of position $p                                                             
sub nim_value {
  my ($p) = @_;
#  warn sprintf "value-of %s\n", to_str($p);                                                  
  return mex(map nim_value($_), moves_from($p));
}
BEGIN { memoize nim_value => NORMALIZER => \&to_str }

# partitions of $n with parts of size at least $min                                           
# parts are always returned in decreasing order                                               
#  $min defaults to 1                                                                         
sub partitions {
  my ($n, $min) = @_;
 $min //= 1;
  return [[]] if $n == 0;
  return if $n < $min;
  my @partitions = [$n];
  for my $p ($min .. int($n/2)) {
    my $sub_partitions = partitions($n-$p, $p);
    if ($sub_partitions) {
      push @partitions, map [@$_, $p], @$sub_partitions;
    }
  }
  return \@partitions;
}

# total number of piles, not counting piles of 1, which are dead                              
sub total_piles {
  my ($p) = @_;
  return 0 + grep $_ > 1, @$p;
}

# total number of pennies, not counting piles of 1, which are dead                            
sub total_pennies {
  my ($p) = @_;
  my $t = 0;
  $t += $_ for grep $_ > 1, @$p;
  return $t;
}