Beefy Boxes and Bandwidth Generously Provided by pair Networks
Don't ask to ask, just ask
 
PerlMonks  

Re^3: High Performance Game of Life

by marioroy (Prior)
on Aug 12, 2017 at 10:25 UTC ( [id://1197302]=note: print w/replies, xml ) Need Help??


in reply to Re^2: High Performance Game of Life
in thread High Performance Game of Life

Hi eyepopslikeamosquito,

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

# 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 ); 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 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 = "$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

Replies are listed 'Best First'.
Re^4: High Performance Game of Life
by marioroy (Prior) on Aug 12, 2017 at 17:38 UTC

    Hi eyepopslikeamosquito,

    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 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 '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; # Check the dead cells 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;

    Regards, Mario

      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

        Thanks Mario! Shaved a couple more seconds:

        • Inlined get_dead_cells()
        • Got rid of state (didn't seem to make it any faster)
        • Switched off warnings (admittedly this didn't make much, if any, difference)
        • Some other minor tweaks
        See "Mario improvements" entries in "Benchmark Results" section of root node for speed comparison with original Organism.pm.

        Note: The code below is the fastest version of the Perl GOL code in this node.

        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; }

Log In?
Username:
Password:

What's my password?
Create A New User
Domain Nodelet?
Node Status?
node history
Node Type: note [id://1197302]
help
Chatterbox?
and the web crawler heard nothing...

How do I use this?Last hourOther CB clients
Other Users?
Others chilling in the Monastery: (3)
As of 2025-06-22 02:17 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    No recent polls found

    Notices?
    erzuuliAnonymous Monks are no longer allowed to use Super Search, due to an excessive use of this resource by robots.