#!/usr/bin/perl5 -w

# Freely redistributable code from Kent Paul Dolan, <xanthian@well.com>.

# Undated Log:

################
# Done/Features:
################

#                              NEIGHBORS

# Default neighbor array (-1, 1) implemented.

# Arbitrary neighbor array from command line implemented, both
#   duplicates and non-contiguous neighbors work and prove useful.

#                            VISUALIZATION

# Separation of states and their visualization implemented.

# Default visualization array implemented.

# Implemented visualization using ANSI / ISO text colors; now have
#   8 * 7 * 95 screen-distinguishable displays for states, after that,
#   displays for states wrap around.

# Implement flags to use just text, just color, or both to distinguish
#   displays.

#                     USER ENTERED STARTING STATES

# User entered starting state list from command line implemented for
#   CAs with states up to 0-9, though I think it is broken right now.

# Partially implemented more than one digit's worth of states, command
#   line changes pending.

#                  RANDOMLY GENERATED STARTING STATES

# Randomly generated rather than user entered starting state list
#   implemented.

# Extended names for randomization of starting states to be
#   self-descriptive instead of cryptic.

# Choice of starting state list randomization mechanism from command
#   line, multiple randomization mechanisms implemented.

# Reworked distributions on randomization of starting states list:
#   uniform, linear_skew, three_halves_power_skew, quadratic_skew,
#   five_halves_power_skew, cubic_skew, seven_halves_power_skew,
#   quartic_skew, nine_halves_power_skew, quintic_skew.  Balanced
#   starting state counts make for dull automatons.

#                          UNIVERSE DIAMETER

# Universe diameter derived from command line state list entry
#   implemented.

# Parameterized universe diameter from command line implemented.

# Default universe diameter (80, to fit standard window) implemented.

#                       NUMBER OF CA GENERATIONS

# Command line control of number of generations per restart cycle
#   implemented.

# Default number of generations (20 to fit standard window with slop
#   for succeeding prompt, et cetera) implemented.

########
# To Do:
########

# Implement alternate state command line initialization like above for
#   CAs with more than states 0-9 (high priority, state array input is
#   broken right now).

# Simplify main loop by moving bulk of effort to setup, running main
#   loop off that effort's product (high priority).

# Move all setups into a setup module (tedious but important).

# Do all usage checks in setup module, like the ones in the
#   randomization setups, to avoid having the set of legal values
#   represented, and thus maintained, two separate places in the code;
#   instead, let the setup use also define the legal values very
#   naturally as they are implemented.

# Defer exiting until all usage checks are complete, so that all
#   errors get reported on the first try by the user.

# Move randomization routines to setup subroutine so that names of
#   routines are available for usage, documentation messages; make
#   a hash to hold the kit of possible randomizations and return that
#   hash from setup.

# Command line control of number of restart cycles (Is this a good
#   idea? PRO: We then need only one perl compile for many cycles. 
#   CON: Current style of call to srand would only be useful once,
#   whereas now it is useful each cycle, because each cycle is a new
#   process with a new process ID to feed to srand).

# Include a "permuted" starting state "randomization" that includes
#   each state once or the same number of times (may be hard, need to
#   decide in multiple case whether to intermingle sets of
#   permutations or do them one by one along the state list).

# Parameterize choice of rules, including "random_rule", put
#   subroutine reference in a hash keyed by rule name during setup
#   (nice, high priority).

# Help module for other info besides usage, in particular names/lists
#   of choices for options which are acquired at run time as they are
#   defined in the code, to save double bookkeeping the usage and the
#   implementation changes that affect usage.

# Use pixel colors instead of colored text for visualization (just
#   plain hard; see if there is a simple perl xterm graphics module,
#   or if perltk would help, or abandon in favor of doing a non-visual
#   output mode and let the user solve this problem).

# Implement "non-visual" mode, with output to a file or named pipe
#   (perhaps feeding a rendering engine) instead of to the screen,
#   suggested format is a paragraph delimited set per state generation
#   of named, comma delimited values, suitable for reading back into a
#   Getoptions call for an array shaped entity, and then splitting
#   individual array values on commas, like this, for two generations
#   of a 32 cell diameter 1-D CA with 4 states:

#   generation_state=1,2,0,3,0,1,2,2
#   generation_state=1,2,2,3,0,1,2,2
#   generation_state=1,2,0,2,0,1,2,2
#   generation_state=1,2,0,3,2,1,2,0
#                                       <==== empty line
#   generation_state=1,2,0,3,1,1,2,2
#   generation_state=1,2,0,1,0,1,2,3
#   generation_state=1,2,1,3,0,1,3,2
#   generation_state=1,1,0,3,0,1,2,2
#                                       <==== empty line

#   of course, that is a lot of pain for state numbers that will fit
#   in one character, but those could just as easily have been four
#   digit long state values instead of one digit long ones.

#####################################
# Silly stuff to Turing machinify, do
# right after "spare time" is taken
# off the endangered species list.
#####################################

# Non-numeric cell states.
# Non-linear progression of cell states (belongs above).
# Ordered, instead of bulk parallel, replacement of cell states.
#   (parser)
# Stackwise caching of universe state (backtracking parser).
# Searchable caching of (sub-)universe state (library speedup
#   mechanism).
# Non-constant size replacements; 1 cell ==> 0 to k cells (messy).
# Multiple cell to multiple cell replacements; issue: how to delimit?

# ENOUGH, already! Let's write come code.
# ====================================================================

####################
# OO Module includes
####################

use Getopt::Long;

#################################################
# Forward declarations of package MAIN variables.
#################################################

# Do forward declarations of package level variables; probably should
#   be a "use vars" but I cannot convince myself that I understand how
#   that capability of Perl works.  This may not be needed at all, I'm
#   trying hard not to use these as globals; I just don't like having
#   variable declarations scattered all over the main code: old
#   Fortran coding habits.

my @neighboroffsets;
my $randomness;
my $generations;
my $diameter;
my $states;
my $startstring;
my $toprandomness;
my @randomnessdistribution;
my %CA_rules;

#########################################
# Subroutine declarations and definitions
#########################################

##########
sub usage
##########
{
  print STDERR "Usage: $0 [neignboroffsets=n1 [neighboroffsets=n2 ...]][generations=ggg][states=s]               \n";
  print STDERR "       [randomness=[u|s][[diameter=ddd]|[startstring=nmopnmopnmop...]                            \n";
  print STDERR "Where: 'neighboroffsets' is a set of offsets, positive or negative integers defining 'neighbors' \n";
  print STDERR "       for the current cell, used in calculating the cell's 'next-state-more' weight.            \n";
  print STDERR "       'generations' is a positive integer telling how long to run the automaton, where zero is  \n";
  print STDERR "       the same as 'run forever' (or until interrupted by the user with a CTCL-C).               \n";
  print STDERR "       'states' is a positive integer telling how many different values a cell may assume.       \n";
  print STDERR "       'randomness' is a character, 'u' for 'uniform' or 's' for 'skewed', describing the initial\n";
  print STDERR "       distribution of the various cell state values.                                            \n";
  print STDERR "       'diameter' is an integer giving the width of the universe for the cellular-automaton.  If \n";
  print STDERR "       'startstring' is given, its width establishes the diameter of the universe, instead.      \n";
  exit(1);
}

#############
sub visualize
#############
{
  my ($state_buffer_ref, $color_flag, $text_flag) = @_;

  defined( $state_buffer_ref )
    or die "no state buffer reference sent to subroutine visualize";

  defined( $color_flag )
    or die "no color flag sent to subroutine visualize";

  defined( $text_flag )
    or die "no color flag sent to subroutine visualize";

  my $display_glyph_string = "";
  my $state_index;

  # print STDERR "visualize:  state buffer size: '", 0 + @$state_buffer_ref , "'", "\n";
  # FIXME move this initialization to the setup code, pass the results
  #   back here as an array reference to array display_glyphs.

  my @display_glyphs = ();

  my $glyph_value;
  for ( $glyph_value = 33 ; $glyph_value <= 126 ; $glyph_value++ )
  {
    push @display_glyphs , "" . chr($glyph_value);
  }

  my @ansi_color_escapes_foreground =
  (
    "\e[40m" , "\e[41m" , "\e[42m" , "\e[43m" ,
    "\e[44m" , "\e[45m" , "\e[46m" , "\e[47m" ,
  );

  my @ansi_color_escapes_background =
  (
    "\e[30m" , "\e[31m" , "\e[32m" , "\e[33m" ,
    "\e[34m" , "\e[35m" , "\e[36m" , "\e[37m" ,
  );

  my @ansi_color_escape_combinations=();

  my $bg_index;
  my $fg_index;

  for ($fg_index = 0 ; $fg_index < @ansi_color_escapes_foreground ; $fg_index++ )
  {
    for ($bg_index = 0 ; $bg_index < @ansi_color_escapes_background ; $bg_index++ )
    {
      if ( $fg_index != $bg_index )
      {
        push @ansi_color_escape_combinations ,
          $ansi_color_escapes_background[ $bg_index ] .
          $ansi_color_escapes_foreground[ $fg_index ] ;
      }
    }
  }

  for ( $state_index = 0 ; $state_index < @$state_buffer_ref ; $state_index++ )
  {
    # Pull this cell's state out of the state buffer, wrap it with a
    #   modulus operator to fit into the display glyphs array length,
    #   use it to pull a display glyph from that glyph array, and append
    #   the resulting glyph to the display string.

#   $display_glyph_string .= $display_glyphs[ $$state_buffer_ref[ $state_index ] % @display_glyphs ] ;
    if ($color_flag)
    {
      if ($text_flag)
      {
        print $ansi_color_escape_combinations[
          $$state_buffer_ref[ $state_index ] % @ansi_color_escape_combinations ];
      }
      else
      {
        print $ansi_color_escapes_foreground[
          $$state_buffer_ref[ $state_index ] % @ansi_color_escapes_foreground ];
      }
    }
    if ($text_flag)
    {
      print $display_glyphs[ $$state_buffer_ref[ $state_index ] % @display_glyphs ] ;
    }
    else
    {
      print " ";
    }
  }

# print "$display_glyph_string" , "\n";

  # reset bg, fg colors to defaults
  print "\e[39m", "\e[49m" if $color_flag;
  print "\n";

}

#################
sub countofstates
#################
{
  my ( $bufferref , $currentbufferindex , $statetocount , $neighboroffsetsref ) =  @_ ;

  defined( $bufferref )
    or die "no buffer reference sent to count of states subroutine";
  defined( $currentbufferindex )
    or die "no current buffer index sent to count of states subroutine";
  defined( $statetocount )
    or die "no state to count sent to count of states subroutine";
  defined( $neighboroffsetsref )
    or die "no neighbor list array reference sent to count of states subroutine";

  my $bufferdiameter      = @$bufferref;
  my $countofstatetocount = 0;
  my $bufferindexoffset;

  foreach $bufferindexoffset (@$neighboroffsetsref)
  {
    $countofstatetocount +=
      ( $$bufferref[ ( $currentbufferindex + $bufferindexoffset )  % $bufferdiameter] == $statetocount );
  }
  return $countofstatetocount;
}

#######################
sub countofcurrentstate
#######################
{
  my ( $bufferref , $currentbufferindex , $states , $neighboroffsetsref ) =  @_ ;

  defined( $bufferref)
    or die "no buffer reference sent to count of current state subroutine";
  defined( $currentbufferindex )
    or die "no current buffer index sent to count of current state subroutine";
  defined( $states )
    or die "no number of states sent to count of current state subroutine";
  defined( $neighboroffsetsref )
    or die "no neighbor list array reference sent to count of current state subroutine";

  return countofstates $bufferref ,
         $currentbufferindex ,
         ( ( $$bufferref[ $currentbufferindex ] + 0 ) % $states ),
         $neighboroffsetsref;
}

####################
sub countofnextstate
####################
{
  my ($bufferref , $currentbufferindex ,$states , $neighboroffsetsref) = @_ ;

  defined($bufferref)
    or die "no buffer reference sent to count of next state subroutine";
  defined($currentbufferindex)
    or die "no current buffer index sent to count of next state subroutine";
  defined($states)
    or die "no number of states sent to count of next state subroutine";
  defined($neighboroffsetsref)
    or die "no neighbor list array reference sent to count of next state subroutine";

  return countofstates $bufferref ,
         $currentbufferindex ,
         ( ( $$bufferref[ $currentbufferindex ] + 1 ) % $states ),
         $neighboroffsetsref;
}

#################
sub setrandomness
#################
{
  my ( $states , $randomness ) = @_ ;
  my $toprandomness = 0;
  my $randomnessdistribution = ();
  my $stateindex;

  defined( $states )
    or ( warn "no states value sent to setrandomness subroutine" and &usage );
  defined( $randomness )
    or ( warn "no randomness character sent to setrandomness subroutine" and &usage );

  ( 0 < ( $states = int $states ))
    or ( warn "states needs a positive value in setrandomness subroutine" and &usage );

  srand( time() ^ ( $$ + ($$ << 15 ) ) ) ; # seed random number generator
  
  for ( $stateindex = 0 ; $stateindex < $states ; $stateindex ++ )
  {
    if ( $randomness eq "uniform" )
    {
      $randomnessdistribution[ $stateindex ] = 4096 ;  # uniform distribution <== constant value here
    }
    elsif ( $randomness eq "linear_skew" )
    {
      # linear skewed distribution <== nonconstant values here, raised to first power
      $randomnessdistribution[ $stateindex ] = 1 + int rand( 4096 );
    }
    elsif ( $randomness eq "three_halves_power_skew" )
    {
      # three halves power skewed distribution <== nonconstant values here, raised to three halves power
      $randomnessdistribution[ $stateindex ] = rand( 256 );
      $randomnessdistribution[ $stateindex ] =
        $randomnessdistribution[ $stateindex ] *
        sqrt( $randomnessdistribution[ $stateindex ] );
      $randomnessdistribution[ $stateindex ] = 1 + int $randomnessdistribution[ $stateindex ] ;
      
    }
    elsif ( $randomness eq "quadratic_skew" )
    {
      # quadratic skewed distribution <== nonconstant values here, raised to second power
      $randomnessdistribution[ $stateindex ] = rand( 64 );
      $randomnessdistribution[ $stateindex ] *= $randomnessdistribution[ $stateindex ];
      $randomnessdistribution[ $stateindex ] = 1 + int $randomnessdistribution[ $stateindex ];
    }
    elsif ( $randomness eq "five_halves_power_skew" )
    {
      # five halves power skewed distribution <== nonconstant values here, raised to five halves power
      $randomnessdistribution[ $stateindex ] = rand( 32 );
      $randomnessdistribution[ $stateindex ] =
        $randomnessdistribution[ $stateindex ] *
        $randomnessdistribution[ $stateindex ] *
        sqrt( $randomnessdistribution[ $stateindex ] );
      $randomnessdistribution[ $stateindex ] = 1 + int $randomnessdistribution[ $stateindex ];
    }
    elsif ( $randomness eq "cubic_skew" )
    {
      # cubic skewed distribution <== nonconstant values here, raised to third power
      $randomnessdistribution[ $stateindex ] = rand( 16 );
      $randomnessdistribution[ $stateindex ] =
        $randomnessdistribution[ $stateindex ] *
        $randomnessdistribution[ $stateindex ] *
        $randomnessdistribution[ $stateindex ] ;
      $randomnessdistribution[ $stateindex ] = 1 + int $randomnessdistribution[ $stateindex ];
    }
    elsif ( $randomness eq "seven_halves_power_skew" )
    {
      # seven halves power skewed distribution <== nonconstant values here, raised to seven halves power
      $randomnessdistribution[ $stateindex ] = rand( 16 );
      $randomnessdistribution[ $stateindex ] =
        $randomnessdistribution[ $stateindex ] *
        $randomnessdistribution[ $stateindex ] *
        $randomnessdistribution[ $stateindex ] *
        sqrt( $randomnessdistribution[ $stateindex ] );
      $randomnessdistribution[ $stateindex ] = 1 + int $randomnessdistribution[ $stateindex ];
    }
    elsif ( $randomness eq "quartic_skew" )
    {
      # quartic skewed distribution <== nonconstant values here, raised to fourth power
      $randomnessdistribution[ $stateindex ] = rand( 8 );
      $randomnessdistribution[ $stateindex ] =
        $randomnessdistribution[ $stateindex ] *
        $randomnessdistribution[ $stateindex ] *
        $randomnessdistribution[ $stateindex ] *
        $randomnessdistribution[ $stateindex ] ;
      $randomnessdistribution[ $stateindex ] = 1 + int $randomnessdistribution[ $stateindex ];
    }
    elsif ( $randomness eq "nine_halves_power_skew" )
    {
      # nine halves power skewed distribution <== nonconstant values here, raised to nine halves power
      $randomnessdistribution[ $stateindex ] = rand( 8 );
      $randomnessdistribution[ $stateindex ] =
        $randomnessdistribution[ $stateindex ] *
        $randomnessdistribution[ $stateindex ] *
        $randomnessdistribution[ $stateindex ] *
        $randomnessdistribution[ $stateindex ] *
        sqrt( $randomnessdistribution[ $stateindex ] );
      $randomnessdistribution[ $stateindex ] = 1 + int $randomnessdistribution[ $stateindex ];
    }
    elsif ( $randomness eq "quintic_skew" )
    {
      # quintic skewed distribution <== nonconstant values here, raised to fifth power
      $randomnessdistribution[ $stateindex ] = rand( 8 );
      $randomnessdistribution[ $stateindex ] =
        $randomnessdistribution[ $stateindex ] *
        $randomnessdistribution[ $stateindex ] *
        $randomnessdistribution[ $stateindex ] *
        $randomnessdistribution[ $stateindex ] *
        $randomnessdistribution[ $stateindex ] ;
      $randomnessdistribution[ $stateindex ] = 1 + int $randomnessdistribution[ $stateindex ];
    }
    else
    {
      warn "randomness should not be '${randomness}' in setrandom subroutine" and &usage;
    }
    $toprandomness += $randomnessdistribution[ $stateindex ] ;
  }
  return ( $toprandomness , @randomnessdistribution ) ;
}

###################
sub applyrandomness
###################
{
  my ( $states , $toprandomness , $randomnessdistributionref ) = @_ ;

  my $state;
  my $probe;
  my $runningsum = 0;

  defined( $states )
    or ( warn "no number of states input to subroutine applyrandomness" and &usage );
  defined( $toprandomness )
    or ( warn "no sum of randomnessdistribution entries input to subroutine applyrandomness" and &usage );
  defined( $randomnessdistributionref )
    or ( warn "no randomnessdistribution array reference input to subroutine applyrandomness" and &usage );

  ( $states == ( 0 + @$randomnessdistributionref ) )
    or ( die "number of states '$states' does not match size of randomness distribution array '" .
    0 + @$randomnessdistributionref . "'" );
  $probe = 1 + int rand( $toprandomness ) ;
  for ( $state = 0 ; $state < $states ; $state++ )
  {
    $runningsum += $$randomnessdistributionref[ $state ];
    if ( $runningsum >= $probe )
    {
      # print STDERR ", probe ", $probe , ", state " , $state , "\n";
      # exit 1;
      return $state;
    } ;
  }
  die "fell through state seeking loop in subroutine applyrandomness, with probe '${probe}'";
}

sub load_rules
{
  my %rule_hash = ();

  $rule_hash{"majority_next_state"} = sub
  {
    my ($buffer_ref , $b_index , $num_states , $neighboroffsets_ref, @trash) = @_;
    die "too many parameters passed to majority_next_state rule" if @trash;

    if
    (
      ( &countofnextstate ( $buffer_ref, $b_index, $num_states, $neighboroffsets_ref ) )
      >=
      ( &countofcurrentstate ( $buffer_ref, $b_index, $num_states, $neighboroffsets_ref ) )
    )
    {
      return ( ( $$buffer_ref[$b_index] + 1 ) % $states );
    }
    else
    {
      return $$buffer_ref[$b_index];
    }
  };

  $rule_hash{"life_1d"} = sub
  {
    my ($buffer_ref , $b_index , $num_states , $neighboroffsets_ref, @trash) = @_;
    die "too many parameters passed to life_1d rule" if @trash;

    my $live = 1;
    my $dead = 0;

    my $live_neighbors = &countofstates($buffer_ref , $b_index , $live , $neighboroffsets_ref);

    if ( ( $$buffer_ref[$b_index] == $live ) and ( ( $live_neighbors == 2 ) or ( $live_neighbors == 3 ) ) )
    {
      return $live; # survival case
    }
    elsif ( ( $$buffer_ref[$b_index] == $live ) and ( $live_neighbors == 3 ) )
    {
      return $live; # birth case
    }
    else
    {
      return $dead; # lonely and overcrowded cases combined
    }

  };

  return \%rule_hash;

}

########################
########################
## Begin main processing
########################
########################

$rules_hash_ref = &load_rules;

@buffer_one = @buffer_two = ();

# set defaults, except for neighboroffsets, which is more complex to
# handle and must be set to defaults _after_ the command line is checked
# that no values are set there, in the call to Getopt.

@neighboroffsets=();   # list of offsets from current cell offset = 0 of
                       #   cells which are _neighbors_ to this cell;
                       #   neighbors need not be contiguous.

$randomness="uniform"; # choice of "u" for uniform or "s" for skewed

$generations=20;       # how many rows of results to create, including
                       #   the initial row; default leaves extra room
                       #   for prompt in standard 24 x 80 xterm window.

$diameter=80;          # modulus at which our one dimensional universe
                       #   wraps around to bite its own tail

$states=4;             # number of states automaton cell can assume;
                       #    default set is (0,1,2,3).

$startstring="";       # initial set of cell values; will be set at
                       #   random with a user chosen or default
                       #   distribution if no value is set from the
                       #   command line

$rule_name=
"majority_next_state"; # initial rule name; the rule that got this project
                       # started.

$color_flag=1;         # is color used in the display?

$text_flag=1;          # printable characters, or just spaces, in the
                       #   display?

$result = GetOptions # from the command line
(
  "rule_name=s"        => \$rule_name       ,
  "generations=i"      => \$generations     ,
  "diameter=i"         => \$diameter        ,
  "neighboroffsets=i@" => \@neighboroffsets ,
  "randomness=s"       => \$randomness      ,
  "states=i"           => \$states          ,
  "startstring=s"      => \$startstring     ,
  "color_flag!"        => \$color_flag      ,
  "text_flag!"         => \$text_flag       ,
);

usage() if $result == 0;

if (@neighboroffsets == 0) # is our array empty, we got nothing from the command line?
{
  @neighboroffsets = ( -1 , 1 );
}

if (($startstring eq "") or ($states > 10 ))
{
  ($toprandomness , @randomnessdistribution) = &setrandomness($states , $randomness);

  for ($i = 0; $i < $diameter; $i++)
  {
    push @buffer_one , &applyrandomness($states , $toprandomness, \@randomnessdistribution);
  }
}
else
{
  $diameter = length $startstring;

  while ($startstring =~ s/^(.)//)
  {
    push @buffer_one, $1;
  }

}

visualize \@buffer_one, $color_flag, $text_flag;

for ( $i = 0; $i < $generations; $i++ )
{
  for ( $b_index = 0 ; $b_index < @buffer_one ; $b_index++ )
  {
    $buffer_two[$b_index] = &{ $$rules_hash_ref{$rule_name} }(\@buffer_one , $b_index , $states , \@neighboroffsets );
  }

  @buffer_one = @buffer_two;

  visualize \@buffer_one, $color_flag, $text_flag;

}