Update: pack 'i2' is more efficient than pack 'ii'
Organism.pm optimized with pack/unpack 'i2' and inlining critical paths.
package Organism;
use strict;
use warnings;
use feature 'state';
sub count {
return scalar keys %{ shift->{Cells} };
}
# Input a list of [ x, y ] coords
sub insert_cells {
my $cells = shift->{Cells};
for my $r (@_) { $cells->{ pack 'i2', @{$r} } = undef }
}
# Return sorted list of cells in the Organism.
# Used for verification and testing the state of the organism.
sub get_live_cells {
sort { $a->[0] <=> $b->[0] || $a->[1] <=> $b->[1] }
map { [ unpack 'i2', $_ ] }
keys %{ shift->{Cells} };
}
# Return the list of dead cells surrounding a cell
sub get_dead_cells {
my ( $cells, $x0, $y0 ) = ( shift->{Cells}, @_ );
my ( $x1, $x2, $y1, $y2 ) = ( $x0 - 1, $x0 + 1, $y0 - 1, $y0 + 1 );
state ( $k1, $k2, $k3, $k4, $k5, $k6, $k7, $k8 );
( ( $k1 = pack 'i2', $x1, $y1 ) x !( 0 + exists $cells->{ $k1 } ),
( $k2 = pack 'i2', $x1, $y0 ) x !( 0 + exists $cells->{ $k2 } ),
( $k3 = pack 'i2', $x1, $y2 ) x !( 0 + exists $cells->{ $k3 } ),
( $k4 = pack 'i2', $x0, $y1 ) x !( 0 + exists $cells->{ $k4 } ),
( $k5 = pack 'i2', $x0, $y2 ) x !( 0 + exists $cells->{ $k5 } ),
( $k6 = pack 'i2', $x2, $y1 ) x !( 0 + exists $cells->{ $k6 } ),
( $k7 = pack 'i2', $x2, $y0 ) x !( 0 + exists $cells->{ $k7 } ),
( $k8 = pack 'i2', $x2, $y2 ) x !( 0 + exists $cells->{ $k8 } ) )
+;
}
sub tick {
my $self = shift;
my $cells = $self->{Cells};
my %new_cells;
for my $c (keys %{ $cells }) {
# Get the (up to 8) dead cells surrounding the cell
my @zcells = $self->get_dead_cells( unpack 'i2', $c );
# Check the live cell
# Note: next line equivalent to nlive == 2 || nlive == 3
@zcells == 5 || @zcells == 6 and $new_cells{$c} = undef;
# Check the dead cells
for my $z (@zcells) {
state ( $x0, $x1, $x2, $y0, $y1, $y2 );
( $x0, $y0 ) = unpack 'i2', $z;
( $x1, $x2, $y1, $y2 ) = ( $x0 - 1, $x0 + 1, $y0 - 1, $y0 + 1
+ );
# Get num live
( ( 0 + exists $cells->{ pack 'i2', $x1, $y1 } )
+ ( 0 + exists $cells->{ pack 'i2', $x1, $y0 } )
+ ( 0 + exists $cells->{ pack 'i2', $x1, $y2 } )
+ ( 0 + exists $cells->{ pack 'i2', $x0, $y1 } )
+ ( 0 + exists $cells->{ pack 'i2', $x0, $y2 } )
+ ( 0 + exists $cells->{ pack 'i2', $x2, $y1 } )
+ ( 0 + exists $cells->{ pack 'i2', $x2, $y0 } )
+ ( 0 + exists $cells->{ pack 'i2', $x2, $y2 } )
) == 3 and $new_cells{$z} = undef;
}
}
$self->{Cells} = \%new_cells;
}
sub new {
my $class = shift;
my %init_self = ( Cells => {} );
bless \%init_self, $class;
}
1;
Regards, Mario
-
Are you posting in the right place? Check out Where do I post X? to know for sure.
-
Posts may use any of the Perl Monks Approved HTML tags. Currently these include the following:
<code> <a> <b> <big>
<blockquote> <br /> <dd>
<dl> <dt> <em> <font>
<h1> <h2> <h3> <h4>
<h5> <h6> <hr /> <i>
<li> <nbsp> <ol> <p>
<small> <strike> <strong>
<sub> <sup> <table>
<td> <th> <tr> <tt>
<u> <ul>
-
Snippets of code should be wrapped in
<code> tags not
<pre> tags. In fact, <pre>
tags should generally be avoided. If they must
be used, extreme care should be
taken to ensure that their contents do not
have long lines (<70 chars), in order to prevent
horizontal scrolling (and possible janitor
intervention).
-
Want more info? How to link
or How to display code and escape characters
are good places to start.