Beefy Boxes and Bandwidth Generously Provided by pair Networks
"be consistent"
 
PerlMonks  

Comment on

( #3333=superdoc: print w/replies, xml ) Need Help??
#!/usr/bin/perl -w package Cellular::Automata::1D; #===================================================================== +======== # # $Id: 1D.pm,v 0.01 2001/07/05 20:37:34 mneylon Exp $ # $Revision: 0.01 $ # $Author: mneylon $ # $Date: 2001/07/05 20:37:34 $ # $Log: 1D.pm,v $ # Revision 0.01 2001/07/05 20:37:34 mneylon # Initial Release # # #===================================================================== +======== use strict; use Exporter; use Carp; use Data::Dumper; BEGIN { use Exporter (); use vars qw($VERSION @ISA @EXPORT %EXPORT_TAGS); $VERSION = sprintf( "%d.%02d", q($Revision: 0.01 $) =~ /\s(\d+ +)\.(\d+)/ ); @ISA = qw(Exporter); @EXPORT = qw(); %EXPORT_TAGS = ( ); } my %allowed_prefs = ( ruletype => [ qw( explicit grouped ) ], ends => [ qw( edges mirrors warps ) ] ); sub new { my $class = shift; my ( $size, $radius, $colors, $color_rep, $rules, $options ) = @_; # Defaults croak "Size must be greater than zero" unless ( $size ||= 100 ) > +0; croak "Radius must be non-negative" unless ( $radius ||= 1 ) >= 0; croak "Colors must be greater than one" unless ( $colors ||= 2 ) > + 1; $color_rep ||= join '', ('A'..'Z'); if ( ref ( $color_rep ) eq 'ARRAY' ) { $color_rep = join '', @$color_rep; } croak "Color representation must have at least as many colors as s +pecified" unless ( length $color_rep >= $colors ); croak "Color representation must be specified with more than 26 co +lors" unless ( $colors < 26 || ( $colors > 26 && length $color_rep >= $colors ) ); croak "Color representation cannot have duplicated characters" unless ( _test_color_representation( $colors, $color_rep ) ); $rules ||= {}; $options ||= { ruletype => 'grouped', ends => 'edges' }; my $self = { size => $size, radius => $radius, colors => $colors, rep => $color_rep, cells => [ substr( $color_rep, 0, 1 ) x $size ], rules => {}, options => {} }; bless $self, $class; $self->set_rules( $rules ); $self->set_preferences( $options ); return $self; } sub set_rule { my ( $self, $states, $state ) = @_; if ( ref( $states ) eq 'ARRAY' ) { $states = join '', @$states; } return 0 unless ( _test_colors( $states, $self->{ colors }, $self- +>{ rep } ) && _test_colors( $state, $self->{ colors }, $self->{ rep } ) ); return 0 unless ( length $states >= 2 * $self->{ radius } + 1 ); $states = substr( $states, 0, 2 * $self->{ radius } + 1 ); if ( $self->{ options }->{ ruletype } eq 'grouped' ) { $states = _sort_on_colors( $states, $self->{ rep } ); } $self->{ rules }->{ $states } = substr( $state, 0, 1 ); return 1; } sub set_rules { my ( $self, @rules ) = @_; my %rule_hash; if ( @rules == 1 && ref( $rules[0] ) eq 'HASH' ) { %rule_hash = %{ $rules[ 0 ] }; } else { %rule_hash = @rules; } my $total = 0; foreach my $rule ( keys %rule_hash ) { $total += $self->set_rule( $rule, $rule_hash{ $rule } ); } return $total; } sub get_rule { my ( $self, $rule ) = @_; if ( $self->{ options }->{ ruletype } eq 'grouped' ) { $rule = _sort_on_colors( $rule, $self->{ rep } ); } return $self->{ rules }->{ $rule }; } sub get_rules { my ( $self ) = @_; my %rulehash; foreach my $key ( keys %{ $self->{ rules } } ) { $rulehash{ $key } = $self->{ rules }->{ $key }; } return %rulehash; } sub clear_rules { my ( $self ) = @_; $self->{ rules } = {}; } sub set_cell { my ( $self, $pos, $color ) = @_; croak "Position is out of range" unless ( $pos >= 0 && $pos < $self->{ size } ); croak "Color is not one of specified color" unless _test_colors( substr( $color, 0, 1 ), $self->{ colors }, $self->{ rep } ); $self->{ cells }->[ $pos ] = substr( $color, 0, 1 ); } sub set_cells { my ( $self, $pos, @colors ) = @_; if ( @colors == 1 && ref( $colors[0] eq 'ARRAY' ) ) { @colors = @{$colors[0]}; } elsif ( @colors == 1 ) { @colors = split //, $colors[0]; } croak "Position is out of range" unless ( $pos >= 0 && $pos < $self->{ size } ); croak "Color array too large" unless ( $pos + @colors <= $self->{ size } ); foreach my $i ( 0..@colors-1 ) { $self->set_cell( $pos + $i, $colors[$i] ); } } sub get_cell { my ( $self, $pos ) = @_; croak "Position is out of range" unless ( $pos >= 0 && $pos < $self->{ size } ); return $self->{ cells }->[ $pos ]; } sub get_cells { my ( $self, $start, $length ) = @_; $start ||= 0; $length ||= $self->{ size } - $start - 1; croak "Start position is out of range" unless ( $start >= 0 && $start < $self->{ size } ); croak "Length is out of range" unless ( $start + $length < $self->{ size } && $length > 0 ); my @array; push @array, $self->get_cell( $_ ) foreach ( $start..$start+$lengt +h ); if ( wantarray ) { return @array; } else { return join '', @array; } } sub set_size { my ( $self, $size ) = @_; croak "Size must be greater than zero" unless ( $size > 0 ); $self->{ size } = $size; $self->{ cells } = [ substr( $self->{ rep }, 0, 1 ) x $size ]; } sub get_size { my ( $self ) = @_; return $self->{ size }; } sub set_radius { my ( $self, $radius ) = @_; $self->{ radius } = $radius; $self->clear_rules(); } sub get_radius { my ( $self ) = @_; return $self->{ radius }; } sub set_colors { my ( $self, $colors, @color_rep ) = @_; croak "Number of colors must be larger than 1" unless $colors > 1; my $color_rep; if ( @color_rep > 1 ) { $color_rep = join '', map { substr( $_, 0, 1 ) } @color_rep; } elsif ( @color_rep == 1 ) { $color_rep = $color_rep[0]; } else { $color_rep = $self->{ rep }; } # Various checks croak "Color representation must be at least as large as number of + colors" unless ( length( $color_rep ) >= $colors ); croak "Color representation must have all unique characters" unless _test_color_representation( substr( $color_rep, 0, $colors ) ); $self->{ colors } = $colors; $self->{ rep } = $color_rep; $self->clear_rules(); } sub get_colors { my ( $self ) = @_; return $self->{ colors }; } sub set_color_representation { my ( $self, @color_rep ) = @_; my $color_rep; if ( @color_rep > 1 ) { $color_rep = join '', map { substr( $_, 0, 1 ) } @color_rep; } else { $color_rep = $color_rep[0]; } # Various checks croak "Color representation must be at least as large as number of + colors" unless ( length( $color_rep ) >= $self->{ colors } ); croak "Color representation must have all unique characters" unless _test_color_representation( substr( $color_rep, 0, $self->{ colors } ) ); $self->{ rep } = $color_rep; $self->clear_rules(); } sub get_color_representation { my ( $self ) = @_; return wantarray ? split //, $self->{ rep } : $self->{ rep }; } sub set_preferences { my ( $self, @prefs ) = @_; my %prefs; if ( @prefs == 1 && ref( $prefs[0] ) eq 'HASH' ) { %prefs = %{ $prefs[0] }; } else { %prefs = @prefs; } foreach my $key ( keys %prefs ) { if ( $allowed_prefs{ lc( $key ) } ) { if ( grep { $_ eq lc( $prefs{ $key } ) } @{ $allowed_prefs{ lc( $key ) } } ) { $self->{ options }->{ lc( $key ) } = lc( $prefs{ $key } ); } else { croak "Value for preference '", lc( $key ), "' must be ", "one of (", join(',', @{ $allowed_prefs{ lc{ $key } } } ); } } else { croak "Preference field '", $key, "' not known"; } } } sub get_preferences { my ( $self ) = @_; my %hash; foreach my $key ( keys %{ $self->{ options } } ) { $hash{ $key } = $self->{ options }->{ $key }; } return %hash; } sub process { my ( $self, $times ) = @_; $times ||= 1; foreach ( 1..$times ) { $self->_process(); } } # Internal, does one step sub _process { my ( $self ) = @_; my @newstate = (); foreach my $i ( 0..$self->{ size }-1 ) { my @states = (); # Left end... if ( $i < $self->{ radius } ) { foreach my $j ( $i - $self->{ radius } .. -1 ) { if ( $self->{ options }->{ ends } eq 'mirrors' ) { push @states, $self->{ cells }->[ abs( $j ) ]; } elsif ( $self->{ options }->{ ends } eq 'warps' ) { push @states, $self->{ cells }->[ $j + $self->{ size } ]; } else { push @states, substr( $self->{ rep }, 0, 1 ); } } foreach my $j ( 0..$i+ $self->{ radius } ) { push @states, $self->{ cells }->[ $j ]; } } elsif ( $i > $self->{ size } - $self->{ radius } - 1 ) { foreach my $j ( $i - $self->{ radius } .. $self->{ size } - 1 +) { push @states, $self->{ cells }->[ $j ]; } foreach my $j ( $self->{ size } .. $i + $self->{ radius } ) { if ( $self->{ options }->{ ends } eq 'mirrors' ) { push @states, $self->{ cells }->[ 2*$self->{ size } - $j - + 2 ]; } elsif ( $self->{ options }->{ ends } eq 'warps' ) { push @states, $self->{ cells }->[ $j - $self->{ size } ]; } else { push @states, substr( $self->{ rep }, 0, 1 ); } } } else { foreach my $j ( $i - $self->{ radius }..$i + $self->{ radius } + ) { push @states, $self->{ cells }->[ $j ]; } } my $states = join '', @states; if ( $self->{ options }->{ ruletype } eq 'grouped' ) { $states = _sort_on_colors( $states, $self->{ rep } ); } if ( $self->{ rules }->{ $states } ) { $newstate[ $i ] = $self->{ rules }->{ $states }; } else { $newstate[ $i ] = substr( $self->{ rep }, 0, 1 ); } } $self->{ cells } = \@newstate; } # ---- # Subs below here are for internal use only # ---- # Internal : Test the given string against the color rep to make # sure all string characters are only from the color rep. True if # so, false otherwise. sub _test_colors { my ( $string, $colors, $rep ) = @_; return ( $string !~ /[^\Qsubstr( $rep, 0, $colors )\E]/ ); } # Internal : Test the color representation string to make sure there # are no duplicates, Returns true if free of duplicates, false otherwi +se sub _test_color_representation { my ( $colors, $rep ) = @_; return ( substr( $rep, 0, $colors ) !~ /(.).*\1/ ); } # Internal : Sorts the first string based on the order of colors of # the second string sub _sort_on_colors { my ( $string, $order ) = @_; return join '', sort { index( $order, $b ) <=> index( $order, $a ) } split //, $string; } __END__ =pod =head1 NAME Cellular::Automata::1D - Implements 1-dimensional cellular simulations =head1 SYNOPSIS use Cellular::Automata::1D; my $am = new Cellular::Automata( 100, 3, 3, ".*X" ); $am->set_preferences( { ends => 'edges', ruletype => 'grouped' } ); $am->set_rules( { '...' => '*', '..*' => '*', '.**' => 'X', '***' => 'X', '..X' => 'X', '.XX' => '.', 'XXX' => '.', '.*X' => 'X', '**X' => 'X', '*XX' => ',' } ); $am->set_cells( 0, '.*X.*X.*X.' ); $am->process( 100 ); print $am->get_cells( ); =head1 DESCRIPTION C<Cellular::Automata::1D> allows one to create automata that are autom +ated by rules set by the user. The class allows for an number of 'colors' (or states) for cells, as well as for a cell to determine it's next st +ate by looking over a range of cells (eg, the 'radius'). Rulesets may be defined as grouped (only the quantity of cells of certain colors in th +e range are used to determin the next state) or explicit (quantity and position of cells are important). Note that in the grouping state, gi +ven C colors and a radius of R (where 2*R+1 cells are used), then the numb +er of rules required (N) will be: ( C + 2*R )! N = ----------------------- (eg, choose( C + ( 2*R+1 ) - 1, 2*R+ +1 ) ) ( 2*R + 1 )! ( C - 1 )! while for explicit rules, this quantity will be N = C^(2*R+1) While this module tries to allow you to easily define such rulesets, s +kipping over unneeded rules, be aware that any large values of C or R will drastically increase the + ruleset. In all cases, the cells are numbers from 0 upwards, starting from the +'left'. Note that in the case of grouping rulesets, the rule will be stored in + a 'sorted' manner which may be different from what you inputted into the ruleset. For example, in a 3 color, radius 3 rule set, a rule that is + entered for "212" may be stored and returned (through C<get_rules> for example) as "122"; in a grouping ruleset, these are equivalent, bu +t will of course be different for explcit rulesets. For any number of colors, the first color is assumed to be the 'dead' state. That is, if during determination of the next state, the automata runs into a situation that has not been specified by the rules, the cell will be set to the 'dead' state. In addition, this is used by the C<ends> prefernece setting, C<edges>. =over =item C<new>( [<size>], [<radius>] [<colors>], [<color_rep>], [<rules> +], [<options>] ) Creates a new automata. The following arguments can be passed to C<new>: =over =item C<size> (Default: 100) The size of the automata. =item C<radius> (Default: 1) The radius that the cell will 'see' to determine the next state. Thus, each rule will involve (2*radius + 1) cells centered on the one to be changed. =item C<colors> (Default: 2) The number of colors or states that a cell can take =item C<color_rep> (Default: "AB") The character representation of the colors/states of the cell. This will not only be used to set and get the state of cells, but also used for the ruleset. Color 0 will be associated with the first character, Color 1 with the second, and so forth. If C<<colors>> is greater than 26, you must give an argument for C<<color_rep>>, as by default, the first 26 characters will be assigned starting from A.to Z. =item C<rules> ( Default: {} ) A reference to a hash containing the rules. See c<set_rule> below for more details on this. =item C<options> ( Default: { ruletype => 'GROUPED', ends => 'EDGES' } + ) A reference to a hash containing options for the automata. See C<set_options> for specifics on this. =back =item C<set_rule>( <state_array> || <state_string>, <new_state> ) Adds a new rule or changes an existing rule. This function returns un +def if the rule was failed to be added. =over =item C<state_array> A reference to an array of characters that represents the state. This must be at least (2*radius+1) elements long; extra elements are droppe +d from the array. If any array elements are not in the color representa +tion (see C<new>), this function will return undef as noted above. =item C<state_string> A string of characters that represents the state. This is handled sim +ilarly to C<state_array> =item C<new_state> A character that represents the new state that the cell should be set to if this rule is activated. This character should in the color representation (see C<new>). =back =item C<set_rules>( <ruleset> ) Adds or updates (as appropriate) a number of rules at one time. Returns the number of rules that were added from this function. =over =item C<ruleset> A hash or reference to a hash, where the keys are either the same as the C<state_array> or C<state_string> given above, and the values are the C<new_state> values associated with each state. =back =item C<get_rule>( <state_array> || <state_string> ) Returns the C<new_state> that is associated with the given state. C<state_array> and C<state_string> are in the same format as in C<set_rule>. =item C<get_rules> Returns the current ruleset from the automata as a hash. Keys are in the same format as C<state_string> from C<set_rule>, values are the associated C<new_state>s. =item C<clear_rules> Empties the ruleset of all rules. =item C<set_cell>( <pos>, <color> ) Sets the cell at the given position Cpos> to the color C<color>. Note + that both C<pos> and C<color> must fall within the appropriate boundar +ies, otherwise this function will return undef. =item C<set_cells>( <pos>, <color_state_string> || <color_state_array> + ) Sets a consecutive block of cells using a given input of color states. =over =item C<pos> The position where the setting should start. =item C<color_state_string> A string composed of the various color representations that is to be u +sed. =item C<color_state_array> An array or a reference to an array of the various color representatio +ns that are to be set. Note that if an array (not a reference to one) is passed that is only composed of one element, it will be assume that this is a C<color_state_string>. =back =item C<get_cell>( <pos> ) Returns the color state of the cell at the given position C<pos>. =item C<get_cells>( [<start>], [<length>] ) Returns the color states of the cells. If in scalar mode, this will r +eturn the states as a string. If in scalar mode, an array will be returns. + By default, this will return the values for all cells. =over =item C<start> ( Default: 0 ) The starting position of which cells' values should be returned. The +return value includes this specific cell's value. =item C<length> ( Default: from C<start> to end of cell list ) The length of cells starting from the C<start> position to be returned +. If not specified, will return all cells starting from C<start> to the end of the list. =back =item C<set_size>( <size> ) Sets the number of cells to be used in the automata. B<The current ce +ll state is cleared to the 'dead' color value>. =item C<get_size> Returns the current number of cells in the automata. =item C<set_radius>( <size> ) Sets the radius that should be used in determining the next state. B<This will call the function C<clear_rules>, due to the nature of thi +s change>. =item C<get_radius>( <size> ) Returns the current radius. =item C<set_colors>( <number> [<color_rep>] ) Sets the number of colors to be used in the automata. B<This will call the function C<clear_rules>, due to the nature of this change>. =over =item C<number> The number of colors to be used. If the number of colors is larger th +an the previous color values, B<and> C<color_rep> is unspecified, this function will issue a C<die>. If the number of colors is equal or les +s than the previous value, and C<color_rep> is unspecified, the old colo +r representation will be used. =item C<color_rep> The new color representation to be used. See C<new> for more details. + Note that this must be at least as long as the number of colors given, otherwise.this function will die. =back =item C<get_colors> Returns the number of colors for the automata. =item C<get_color_representation> Returns the color representation. If in scalar context, this will be +returned as a string, while if in array context, this will be returned as an ar +ray. =item C<set_preferences>( <prefs> ) Sets the preferences for the automata. =over =item C<prefs> A hash or a reference to a hash. The keys that are recognized are as follows: =over =item C<ruletype> - Recongized values: grouped | explicit Determines how the ruleset should be used, as a grouped (where only quantity of the various cells matter), or explicit (where position and number both matter). =item C<ends> - Recongized values: edges | mirrors | warps Determined how cells near the end should behave. If 'edges', any spaces that would be outside the block of cells are considered as empty, otherwise represented by the first color state. If 'mirrors', a mirror copy of the cells starting one back from the edge are made. If 'warps', the edges are assumed to warp to the other side of the automata and taken from there. For example, given this 3 color automata, with a radius of 3: AABCBABCAC In considering the first cell on the left, each C<ends> value would produce a rule look-up as follows: edges: AAAAABC mirrors: CBAAABC warps: CACAABC =back =back =item C<get_prefs> Returns the preferences for the automata as a hash. Keys are each of +the preference keys given above, with their associated values. =item C<process>( [<number>] ) Processes the given number of steps in automata. =over =item C<number> ( Default: 1 ) Number of steps to perform. =back =back =head1 HISTORY $Date: 2001/07/05 20:37:34 $ $Log: 1D.pm,v $ Revision 0.01 2001/07/05 20:37:34 mneylon Initial Release =head1 AUTHOR This package was written by Michael K. Neylon =head1 COPYRIGHT Copyright 2001 by Michael K. Neylon =head1 LICENSE Permission is hereby granted, free of charge, to any person obtaining +a copy of this software and associated documentation files (the "Softwar +e"), to deal in the Software without restriction, including without limitat +ion the rights to use, copy, modify, merge, publish, distribute, sublicens +e, and/or sell copies of the Software, and to permit persons to whom the Software is furnished to do so, subject to the following conditions: The above copyright notice and this permission notice shall be include +d in all copies or substantial portions of the Software. THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRES +S OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILIT +Y, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHAL +L THE AUTHOR BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. =cut 42;

In reply to Cellular::Automata::1D by Masem

Title:
Use:  <p> text here (a paragraph) </p>
and:  <code> code here </code>
to format your post; it's "PerlMonks-approved HTML":



  • Posts are HTML formatted. Put <p> </p> tags around your paragraphs. Put <code> </code> tags around your code and data!
  • Titles consisting of a single word are discouraged, and in most cases are disallowed outright.
  • Read Where should I post X? if you're not absolutely sure you're posting in the right place.
  • Please read these before you post! —
  • Posts may use any of the Perl Monks Approved HTML tags:
    a, abbr, b, big, blockquote, br, caption, center, col, colgroup, dd, del, div, dl, dt, em, font, h1, h2, h3, h4, h5, h6, hr, i, ins, li, ol, p, pre, readmore, small, span, spoiler, strike, strong, sub, sup, table, tbody, td, tfoot, th, thead, tr, tt, u, ul, wbr
  • You may need to use entities for some characters, as follows. (Exception: Within code tags, you can put the characters literally.)
            For:     Use:
    & &amp;
    < &lt;
    > &gt;
    [ &#91;
    ] &#93;
  • Link using PerlMonks shortcuts! What shortcuts can I use for linking?
  • See Writeup Formatting Tips and other pages linked from there for more info.
  • Log In?
    Username:
    Password:

    What's my password?
    Create A New User
    Chatterbox?
    and all is quiet...

    How do I use this? | Other CB clients
    Other Users?
    Others chanting in the Monastery: (5)
    As of 2017-12-16 03:34 GMT
    Sections?
    Information?
    Find Nodes?
    Leftovers?
      Voting Booth?
      What programming language do you hate the most?




















      Results (448 votes). Check out past polls.

      Notices?