http://www.perlmonks.org?node_id=1197296

in reply to High Performance Game of Life

Unfortunately, method calling in Perl is expensive. The following change to Organism.pm will run two times faster simply by inlining is_alive.

Before:

```sub is_alive {
my \$self = shift;
return 0 + exists \$self->{Cells}->{ join ':', @_ };
}

# Return the list of dead cells surrounding a cell
my ( \$self, \$x, \$y ) = @_;
( (join ':', \$x - 1, \$y - 1) x !\$self->is_alive(\$x - 1, \$y - 1),
(join ':', \$x - 1, \$y    ) x !\$self->is_alive(\$x - 1, \$y    ),
(join ':', \$x - 1, \$y + 1) x !\$self->is_alive(\$x - 1, \$y + 1),
(join ':', \$x    , \$y - 1) x !\$self->is_alive(\$x    , \$y - 1),
(join ':', \$x    , \$y + 1) x !\$self->is_alive(\$x    , \$y + 1),
(join ':', \$x + 1, \$y - 1) x !\$self->is_alive(\$x + 1, \$y - 1),
(join ':', \$x + 1, \$y    ) x !\$self->is_alive(\$x + 1, \$y    ),
(join ':', \$x + 1, \$y + 1) x !\$self->is_alive(\$x + 1, \$y + 1) );
}

sub get_num_live {
my ( \$self, \$x, \$y ) = @_;
\$self->is_alive( \$x - 1, \$y - 1 )
+ \$self->is_alive( \$x - 1, \$y     )
+ \$self->is_alive( \$x - 1, \$y + 1 )
+ \$self->is_alive( \$x    , \$y - 1 )
+ \$self->is_alive( \$x    , \$y + 1 )
+ \$self->is_alive( \$x + 1, \$y - 1 )
+ \$self->is_alive( \$x + 1, \$y     )
+ \$self->is_alive( \$x + 1, \$y + 1 );
}

After:

```# Return the list of dead cells surrounding a cell
my ( \$cells, \$x0, \$y0 ) = ( shift->{Cells}, @_ );
my ( \$x1, \$x2, \$y1, \$y2 ) = ( \$x0 - 1, \$x0 + 1, \$y0 - 1, \$y0 + 1 );
( ( "\$x1:\$y1" ) x !( 0 + exists \$cells->{ "\$x1:\$y1" } ),
( "\$x1:\$y0" ) x !( 0 + exists \$cells->{ "\$x1:\$y0" } ),
( "\$x1:\$y2" ) x !( 0 + exists \$cells->{ "\$x1:\$y2" } ),
( "\$x0:\$y1" ) x !( 0 + exists \$cells->{ "\$x0:\$y1" } ),
( "\$x0:\$y2" ) x !( 0 + exists \$cells->{ "\$x0:\$y2" } ),
( "\$x2:\$y1" ) x !( 0 + exists \$cells->{ "\$x2:\$y1" } ),
( "\$x2:\$y0" ) x !( 0 + exists \$cells->{ "\$x2:\$y0" } ),
( "\$x2:\$y2" ) x !( 0 + exists \$cells->{ "\$x2:\$y2" } ) );
}

sub get_num_live {
my ( \$cells, \$x0, \$y0 ) = ( shift->{Cells}, @_ );
my ( \$x1, \$x2, \$y1, \$y2 ) = ( \$x0 - 1, \$x0 + 1, \$y0 - 1, \$y0 + 1 );
( 0 + exists \$cells->{ "\$x1:\$y1" } )
+ ( 0 + exists \$cells->{ "\$x1:\$y0" } )
+ ( 0 + exists \$cells->{ "\$x1:\$y2" } )
+ ( 0 + exists \$cells->{ "\$x0:\$y1" } )
+ ( 0 + exists \$cells->{ "\$x0:\$y2" } )
+ ( 0 + exists \$cells->{ "\$x2:\$y1" } )
+ ( 0 + exists \$cells->{ "\$x2:\$y0" } )
+ ( 0 + exists \$cells->{ "\$x2:\$y2" } );
}

Regards, Mario

Replies are listed 'Best First'.
Re^2: High Performance Game of Life
by eyepopslikeamosquito (Archbishop) on Aug 12, 2017 at 09:32 UTC

Very instructive.

In C++, it was faster not to attempt anything like that with temporary variables (I tried), but instead to just leave the duplicated values and let the optimizer do it for you. Plus, of course, function call overhead can be eliminated via inline functions and macros.

In Perl, on the other hand, the compiler must run very fast, and doesn't attempt many of the optimizations of a C++ compiler run at high optimization levels.

On my laptop, the following shaves 4 seconds from one-time stringification per key.

```# Return the list of dead cells surrounding a cell
my ( \$cells, \$x0, \$y0 ) = ( shift->{Cells}, @_ );
my ( \$x1, \$x2, \$y1, \$y2 ) = ( \$x0 - 1, \$x0 + 1, \$y0 - 1, \$y0 + 1 );
my ( \$k1, \$k2, \$k3, \$k4, \$k5, \$k6, \$k7, \$k8 );

( ( \$k1 = "\$x1:\$y1" ) x !( 0 + exists \$cells->{ \$k1 } ),
( \$k2 = "\$x1:\$y0" ) x !( 0 + exists \$cells->{ \$k2 } ),
( \$k3 = "\$x1:\$y2" ) x !( 0 + exists \$cells->{ \$k3 } ),
( \$k4 = "\$x0:\$y1" ) x !( 0 + exists \$cells->{ \$k4 } ),
( \$k5 = "\$x0:\$y2" ) x !( 0 + exists \$cells->{ \$k5 } ),
( \$k6 = "\$x2:\$y1" ) x !( 0 + exists \$cells->{ \$k6 } ),
( \$k7 = "\$x2:\$y0" ) x !( 0 + exists \$cells->{ \$k7 } ),
( \$k8 = "\$x2:\$y2" ) x !( 0 + exists \$cells->{ \$k8 } ) );
}

To not allocate the key variables each time, another 2 seconds reduction is possible with the state feature.

```use feature 'state';

# Return the list of dead cells surrounding a cell
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 = "\$x1:\$y1" ) x !( 0 + exists \$cells->{ \$k1 } ),
( \$k2 = "\$x1:\$y0" ) x !( 0 + exists \$cells->{ \$k2 } ),
( \$k3 = "\$x1:\$y2" ) x !( 0 + exists \$cells->{ \$k3 } ),
( \$k4 = "\$x0:\$y1" ) x !( 0 + exists \$cells->{ \$k4 } ),
( \$k5 = "\$x0:\$y2" ) x !( 0 + exists \$cells->{ \$k5 } ),
( \$k6 = "\$x2:\$y1" ) x !( 0 + exists \$cells->{ \$k6 } ),
( \$k7 = "\$x2:\$y0" ) x !( 0 + exists \$cells->{ \$k7 } ),
( \$k8 = "\$x2:\$y2" ) x !( 0 + exists \$cells->{ \$k8 } ) );
}

Regards, Mario

Here is Organism.pm modified to use pack/unpack, plus slight optimization applied to insert_cells.

```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 'ii', @{\$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 'ii', \$_ ] }
keys %{ shift->{Cells} };
}

# Return the list of dead cells surrounding a cell
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 'ii', \$x1, \$y1 ) x !( 0 + exists \$cells->{ \$k1 } ),
( \$k2 = pack 'ii', \$x1, \$y0 ) x !( 0 + exists \$cells->{ \$k2 } ),
( \$k3 = pack 'ii', \$x1, \$y2 ) x !( 0 + exists \$cells->{ \$k3 } ),
( \$k4 = pack 'ii', \$x0, \$y1 ) x !( 0 + exists \$cells->{ \$k4 } ),
( \$k5 = pack 'ii', \$x0, \$y2 ) x !( 0 + exists \$cells->{ \$k5 } ),
( \$k6 = pack 'ii', \$x2, \$y1 ) x !( 0 + exists \$cells->{ \$k6 } ),
( \$k7 = pack 'ii', \$x2, \$y0 ) x !( 0 + exists \$cells->{ \$k7 } ),
( \$k8 = pack 'ii', \$x2, \$y2 ) x !( 0 + exists \$cells->{ \$k8 } ) )
+;
}

sub get_num_live {
my ( \$cells, \$x0, \$y0 ) = ( shift->{Cells}, @_ );
my ( \$x1, \$x2, \$y1, \$y2 ) = ( \$x0 - 1, \$x0 + 1, \$y0 - 1, \$y0 + 1 );

( 0 + exists \$cells->{ pack 'ii', \$x1, \$y1 } )
+ ( 0 + exists \$cells->{ pack 'ii', \$x1, \$y0 } )
+ ( 0 + exists \$cells->{ pack 'ii', \$x1, \$y2 } )
+ ( 0 + exists \$cells->{ pack 'ii', \$x0, \$y1 } )
+ ( 0 + exists \$cells->{ pack 'ii', \$x0, \$y2 } )
+ ( 0 + exists \$cells->{ pack 'ii', \$x2, \$y1 } )
+ ( 0 + exists \$cells->{ pack 'ii', \$x2, \$y0 } )
+ ( 0 + exists \$cells->{ pack 'ii', \$x2, \$y2 } );
}

sub tick {
my \$self = shift;
my %new_cells;
for my \$c (keys %{ \$self->{Cells} }) {
# Get the (up to 8) dead cells surrounding the cell
my @zcells = \$self->get_dead_cells( unpack 'ii', \$c );

# Check the live cell
# Note: next line equivalent to nlive == 2 || nlive == 3
@zcells == 5 || @zcells == 6 and \$new_cells{\$c} = undef;

for my \$z (@zcells) {
\$self->get_num_live( unpack 'ii', \$z ) == 3 and \$new_cells{\$z
+} = undef;
}
}
\$self->{Cells} = \%new_cells;
}

sub new {
my \$class = shift;
my %init_self = ( Cells => {} );
bless \%init_self, \$class;
}

1;