package Organism;
use strict;
sub count { 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} };
}
sub tick {
my $self = shift;
my $cells = $self->{Cells};
my ( $k1, $k2, $k3, $k4, $k5, $k6, $k7, $k8,
$x0, $x1, $x2, $y0, $y1, $y2, %newcells );
for my $c (keys %{ $cells }) {
# Get the (up to 8) dead cells surrounding the cell
( $x0, $y0 ) = unpack 'i2', $c;
( $x1, $x2, $y1, $y2 ) = ( $x0 - 1, $x0 + 1, $y0 - 1, $y0 + 1 );
my @zcells = (
($k1 = pack 'i2', $x1, $y1) x !exists($cells->{$k1}),
($k2 = pack 'i2', $x1, $y0) x !exists($cells->{$k2}),
($k3 = pack 'i2', $x1, $y2) x !exists($cells->{$k3}),
($k4 = pack 'i2', $x0, $y1) x !exists($cells->{$k4}),
($k5 = pack 'i2', $x0, $y2) x !exists($cells->{$k5}),
($k6 = pack 'i2', $x2, $y1) x !exists($cells->{$k6}),
($k7 = pack 'i2', $x2, $y0) x !exists($cells->{$k7}),
($k8 = pack 'i2', $x2, $y2) x !exists($cells->{$k8}) );
# Check the live cell (next line equivalent to nlive==2 || nlive
+==3)
@zcells == 5 || @zcells == 6 and $newcells{$c} = undef;
# Check the dead cells
for my $z (@zcells) {
( $x0, $y0 ) = unpack 'i2', $z;
( $x1, $x2, $y1, $y2 ) = ( $x0 - 1, $x0 + 1, $y0 - 1, $y0 + 1
+ );
exists($cells->{pack 'i2', $x1, $y1})
+ exists($cells->{pack 'i2', $x1, $y0})
+ exists($cells->{pack 'i2', $x1, $y2})
+ exists($cells->{pack 'i2', $x0, $y1})
+ exists($cells->{pack 'i2', $x0, $y2})
+ exists($cells->{pack 'i2', $x2, $y1})
+ exists($cells->{pack 'i2', $x2, $y0})
+ exists($cells->{pack 'i2', $x2, $y2}) == 3 and $newcells{$z
+} = undef;
}
}
$self->{Cells} = \%newcells;
}
sub new {
my $class = shift;
my %init_self = ( Cells => {} );
bless \%init_self, $class;
}
1;
Update: Minor stylistic edits were made to Organism.pm above.
Note that changing the main loop above from:
for my $c (keys %{ $cells }) {
to:
while ( my ($c) = each %{ $cells } ) {
uses less memory - though I couldn't measure any difference in speed.
Update: This one is shorter, but a bit slower:
sub tick {
my $self = shift;
my $cells = $self->{Cells};
my ( $k1, $k2, $k3, $k4, $k5, $k6, $k7, $k8,
$x0, $x1, $x2, $y0, $y1, $y2 );
%{$cells} = map {
( $x0, $y0 ) = unpack 'i2', $_;
( $x1, $x2, $y1, $y2 ) = ( $x0 - 1, $x0 + 1, $y0 - 1, $y0 + 1 );
my @zcells = (
($k1 = pack 'i2', $x1, $y1) x !exists($cells->{$k1}),
($k2 = pack 'i2', $x1, $y0) x !exists($cells->{$k2}),
($k3 = pack 'i2', $x1, $y2) x !exists($cells->{$k3}),
($k4 = pack 'i2', $x0, $y1) x !exists($cells->{$k4}),
($k5 = pack 'i2', $x0, $y2) x !exists($cells->{$k5}),
($k6 = pack 'i2', $x2, $y1) x !exists($cells->{$k6}),
($k7 = pack 'i2', $x2, $y0) x !exists($cells->{$k7}),
($k8 = pack 'i2', $x2, $y2) x !exists($cells->{$k8}) );
($_, undef) x (@zcells == 5 || @zcells == 6),
map { ( $x0, $y0 ) = unpack 'i2', $_;
( $x1, $x2, $y1, $y2 ) = ( $x0 - 1, $x0 + 1, $y0 - 1, $y0 +
+1 );
($_, undef) x ( exists($cells->{pack 'i2', $x1, $y1})
+ exists($cells->{pack 'i2', $x1, $y0})
+ exists($cells->{pack 'i2', $x1, $y2})
+ exists($cells->{pack 'i2', $x0, $y1})
+ exists($cells->{pack 'i2', $x0, $y2})
+ exists($cells->{pack 'i2', $x2, $y1})
+ exists($cells->{pack 'i2', $x2, $y0})
+ exists($cells->{pack 'i2', $x2, $y2}) == 3 ) } @zcells
} keys %{$cells};
}
as is this one:
sub tick {
my $self = shift;
my $cells = $self->{Cells};
my ( $k1, $k2, $k3, $k4, $k5, $k6, $k7, $k8,
$x0, $x1, $x2, $y0, $y1, $y2 );
my %newcells;
@newcells{map {
( $x0, $y0 ) = unpack 'i2', $_;
( $x1, $x2, $y1, $y2 ) = ( $x0 - 1, $x0 + 1, $y0 - 1, $y0 + 1 );
my @zcells = (
($k1 = pack 'i2', $x1, $y1) x !exists($cells->{$k1}),
($k2 = pack 'i2', $x1, $y0) x !exists($cells->{$k2}),
($k3 = pack 'i2', $x1, $y2) x !exists($cells->{$k3}),
($k4 = pack 'i2', $x0, $y1) x !exists($cells->{$k4}),
($k5 = pack 'i2', $x0, $y2) x !exists($cells->{$k5}),
($k6 = pack 'i2', $x2, $y1) x !exists($cells->{$k6}),
($k7 = pack 'i2', $x2, $y0) x !exists($cells->{$k7}),
($k8 = pack 'i2', $x2, $y2) x !exists($cells->{$k8}) );
($_) x (@zcells == 5 || @zcells == 6),
map { ( $x0, $y0 ) = unpack 'i2', $_;
( $x1, $x2, $y1, $y2 ) = ( $x0 - 1, $x0 + 1, $y0 - 1, $y0 +
+1 );
($_) x ( exists($cells->{pack 'i2', $x1, $y1})
+ exists($cells->{pack 'i2', $x1, $y0})
+ exists($cells->{pack 'i2', $x1, $y2})
+ exists($cells->{pack 'i2', $x0, $y1})
+ exists($cells->{pack 'i2', $x0, $y2})
+ exists($cells->{pack 'i2', $x2, $y1})
+ exists($cells->{pack 'i2', $x2, $y0})
+ exists($cells->{pack 'i2', $x2, $y2}) == 3 ) } @zcells
} keys %{$cells} } = undef;
$self->{Cells} = \%newcells;
}
I'm guessing they are slower because the list of cells used in the hash slice
contains many duplicate dead cells.
Update: Changing:
my @zcells = (
($k1 = pack 'i2', $x1, $y1) x !exists($cells->{$k1}),
($k2 = pack 'i2', $x1, $y0) x !exists($cells->{$k2}),
($k3 = pack 'i2', $x1, $y2) x !exists($cells->{$k3}),
($k4 = pack 'i2', $x0, $y1) x !exists($cells->{$k4}),
($k5 = pack 'i2', $x0, $y2) x !exists($cells->{$k5}),
($k6 = pack 'i2', $x2, $y1) x !exists($cells->{$k6}),
($k7 = pack 'i2', $x2, $y0) x !exists($cells->{$k7}),
($k8 = pack 'i2', $x2, $y2) x !exists($cells->{$k8}) );
to:
my @zcells = grep( !exists($cells->{$_}),
pack('i2', $x1, $y1),
pack('i2', $x1, $y0),
pack('i2', $x1, $y2),
pack('i2', $x0, $y1),
pack('i2', $x0, $y2),
pack('i2', $x2, $y1),
pack('i2', $x2, $y0),
pack('i2', $x2, $y2) );
was slightly slower.
This one was also slower:
sub tick {
my $self = shift;
my $cells = $self->{Cells};
my ( $k1, $k2, $k3, $k4, $k5, $k6, $k7, $k8,
$x0, $x1, $x2, $y0, $y1, $y2, $z, %newcells );
for my $c (keys %{ $cells }) {
# Get the (up to 8) dead cells surrounding the cell
( $x0, $y0 ) = unpack 'i2', $c;
( $x1, $x2, $y1, $y2 ) = ( $x0 - 1, $x0 + 1, $y0 - 1, $y0 + 1 );
my @zcells = (
($x1, $y1, $k1 = pack 'i2', $x1, $y1) x !exists($cells->{$k1}
+),
($x1, $y0, $k2 = pack 'i2', $x1, $y0) x !exists($cells->{$k2}
+),
($x1, $y2, $k3 = pack 'i2', $x1, $y2) x !exists($cells->{$k3}
+),
($x0, $y1, $k4 = pack 'i2', $x0, $y1) x !exists($cells->{$k4}
+),
($x0, $y2, $k5 = pack 'i2', $x0, $y2) x !exists($cells->{$k5}
+),
($x2, $y1, $k6 = pack 'i2', $x2, $y1) x !exists($cells->{$k6}
+),
($x2, $y0, $k7 = pack 'i2', $x2, $y0) x !exists($cells->{$k7}
+),
($x2, $y2, $k8 = pack 'i2', $x2, $y2) x !exists($cells->{$k8}
+) );
# Check the live cell (next line equivalent to nlive==2 || nlive
+==3)
@zcells == 15 || @zcells == 18 and $newcells{$c} = undef;
# Check the dead cells
while (@zcells) {
( $x0, $y0, $z ) = splice @zcells, 0, 3;
( $x1, $x2, $y1, $y2 ) = ( $x0 - 1, $x0 + 1, $y0 - 1, $y0 + 1
+ );
exists($cells->{pack 'i2', $x1, $y1})
+ exists($cells->{pack 'i2', $x1, $y0})
+ exists($cells->{pack 'i2', $x1, $y2})
+ exists($cells->{pack 'i2', $x0, $y1})
+ exists($cells->{pack 'i2', $x0, $y2})
+ exists($cells->{pack 'i2', $x2, $y1})
+ exists($cells->{pack 'i2', $x2, $y0})
+ exists($cells->{pack 'i2', $x2, $y2}) == 3 and $newcells{$z
+} = undef;
}
}
$self->{Cells} = \%newcells;
}
|