Beefy Boxes and Bandwidth Generously Provided by pair Networks
good chemistry is complicated,
and a little bit messy -LW
 
PerlMonks  

Re^6: High Performance Game of Life

by eyepopslikeamosquito (Chancellor)
on Aug 13, 2017 at 05:46 UTC ( #1197326=note: print w/replies, xml ) Need Help??


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

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.

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

Replies are listed 'Best First'.
Re^7: High Performance Game of Life
by tybalt89 (Priest) on Aug 13, 2017 at 16:50 UTC

    Try this. Notably faster on my machine that is horribly slower than yours.

    package Organism; use strict; # use warnings; 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} }; } sub tick { my $self = shift; my $cells = $self->{Cells}; my ( $k1, $k2, $k3, $k4, $k5, $k6, $k7, $k8, $x0, $x1, $x2, $y0, $y1, $y2, %new_cells, %dead_cells ); 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 ); $dead_cells{$_}++ for 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 # Note: next line equivalent to nlive == 2 || nlive == 3 @zcells == 5 || @zcells == 6 and $new_cells{$c} = undef; } $dead_cells{$_} == 3 and $new_cells{$_} = undef for keys %dead_cell +s; $self->{Cells} = \%new_cells; } sub new { my $class = shift; my %init_self = ( Cells => {} ); bless \%init_self, $class; } 1;

      Hi tybalt89. The optimization is awesome.

      Update 1: Bit-manipulation will not work when $y is negative. See this post. I assumed that $y was always positive from testing using the initial test script.

      Update 2: See this post for a version that maps two integers into one integer successfully.

      I tried bit-manipulation by mapping $x and $y into $n. 16-bits is enough to hold $y.

      package Organism; use strict; # use warnings; sub _pack { my ( $x, $y ) = @_; $x < 0 ? -(abs($x) << 16 | $y) : $x << 16 | $y; } sub _unpack { my ( $n ) = @_; return $n < 0 ? ( -( abs($n) >> 16 ), abs($n) & 0xFFFF ) : ( $n >> 16 , $n & 0xFFFF ); } 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 @{$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 $_ ] } 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, %new_cells, %dead_cells ); for my $c (keys %{ $cells }) { # Get the (up to 8) dead cells surrounding the cell ( $x0, $y0 ) = $c < 0 ? ( -( abs($c) >> 16 ), abs($c) & 0xFFFF ) : ( $c >> 16 , $c & 0xFFFF ); ( $x1, $x2, $y1, $y2 ) = ( $x0 - 1, $x0 + 1, $y0 - 1, $y0 + 1 ); $dead_cells{$_}++ for my @zcells = ( ($k1 = $x1 < 0 ? -(abs($x1) << 16 | $y1) : $x1 << 16 | $y1) x + !(exists $cells->{$k1}), ($k2 = $x1 < 0 ? -(abs($x1) << 16 | $y0) : $x1 << 16 | $y0) x + !(exists $cells->{$k2}), ($k3 = $x1 < 0 ? -(abs($x1) << 16 | $y2) : $x1 << 16 | $y2) x + !(exists $cells->{$k3}), ($k4 = $x0 < 0 ? -(abs($x0) << 16 | $y1) : $x0 << 16 | $y1) x + !(exists $cells->{$k4}), ($k5 = $x0 < 0 ? -(abs($x0) << 16 | $y2) : $x0 << 16 | $y2) x + !(exists $cells->{$k5}), ($k6 = $x2 < 0 ? -(abs($x2) << 16 | $y1) : $x2 << 16 | $y1) x + !(exists $cells->{$k6}), ($k7 = $x2 < 0 ? -(abs($x2) << 16 | $y0) : $x2 << 16 | $y0) x + !(exists $cells->{$k7}), ($k8 = $x2 < 0 ? -(abs($x2) << 16 | $y2) : $x2 << 16 | $y2) x + !(exists $cells->{$k8}) ); # Check the live cell # Note: next line equivalent to nlive == 2 || nlive == 3 @zcells == 5 || @zcells == 6 and $new_cells{$c} = undef; } $dead_cells{$_} == 3 and $new_cells{$_} = undef for keys %dead_cell +s; $self->{Cells} = \%new_cells; } sub new { my $class = shift; my %init_self = ( Cells => {} ); bless \%init_self, $class; } 1;

      Regards, Mario

        You need to run the following little test to catch any errors with negative x and y values before firing off any benchmarks:

        # tgol.t - Simple blinker test of Conway Game of Life Organism class use strict; use warnings; use Organism; use Test::More; my $nblinks = 5; my $ntests = ( $nblinks + 1 ) * 3; plan tests => $ntests; sub test_one { my $org = shift; # Organism handle my $desc = shift; # Test description my $expected = shift; # Array ref of (sorted) expected cells my $nexpected = @{$expected}; my $ncells = $org->count(); my @cells = $org->get_live_cells(); cmp_ok( $ncells, '==', $nexpected, "$desc cell count ($ncells)" ); cmp_ok( scalar(@cells), '==', $nexpected, "$desc cell array count" +); is_deeply( \@cells, $expected, "$desc cell array" ); } # Blinker pattern my @blinker1 = ( [ -101, -100 ], [ -100, -100 ], [ -99, -100 ], [ -101, 100 ], [ -100, 100 ], [ -99, 100 ], [ -1, 0 ], [ 0, 0 ], [ 1, 0 ], [ 99, -100 ], [ 100, -100 ], [ 101, -100 ], [ 99, 100 ], [ 100, 100 ], [ 101, 100 ], ); my @blinker2 = ( [ -100, -99 ], [ -100, -100 ], [ -100, -101 ], [ -100, 99 ], [ -100, 100 ], [ -100, 101 ], [ 0, -1 ], [ 0, 0 ], [ 0, 1 ], [ 100, -99 ], [ 100, -100 ], [ 100, -101 ], [ 100, 99 ], [ 100, 100 ], [ 100, 101 ], ); my @sblinker1 = sort { $a->[0] <=> $b->[0] || $a->[1] <=> $b->[1] } @b +linker1; my @sblinker2 = sort { $a->[0] <=> $b->[0] || $a->[1] <=> $b->[1] } @b +linker2; # Initialization my $org = Organism->new(); $org->insert_cells(@blinker1); test_one( $org, "initial", \@sblinker1 ); # Pattern should just blink back and forth for my $i ( 1 .. $nblinks ) { $org->tick(); test_one( $org, "blinker $i", $i % 2 ? \@sblinker2 : \@sblinker1 ); }
        with the command line:
        prove tgol.t
        Unfortunately, your latest effort fails this test on my machine as shown below:
        # Failed test 'initial cell count (11)' # at tgol.t line 17. # got: 11 # expected: 15 # Failed test 'initial cell array count' # at tgol.t line 18. # got: 11 # expected: 15 # Failed test 'initial cell array' # at tgol.t line 19. # Structures begin differing at: # $got->[0][0] = '-281474976710655' # $expected->[0][0] = '-101' # Failed test 'blinker 1 cell count (10)' # at tgol.t line 17. # got: 10 # expected: 15 # Failed test 'blinker 1 cell array count' # at tgol.t line 18. # got: 10 # expected: 15 # Failed test 'blinker 1 cell array' # at tgol.t line 19. # Structures begin differing at: # $got->[0][0] = '-281474976710655' # $expected->[0][0] = '-100' # Failed test 'blinker 2 cell count (11)' # at tgol.t line 17. # got: 11 # expected: 15 # Failed test 'blinker 2 cell array count' # at tgol.t line 18. # got: 11 # expected: 15 # Failed test 'blinker 2 cell array' # at tgol.t line 19. # Structures begin differing at: # $got->[0][0] = '-281474976710655' # $expected->[0][0] = '-101' # Failed test 'blinker 3 cell count (9)' # at tgol.t line 17. # got: 9 # expected: 15 # Failed test 'blinker 3 cell array count' # at tgol.t line 18. # got: 9 # expected: 15 # Failed test 'blinker 3 cell array' # at tgol.t line 19. # Structures begin differing at: # $got->[0][1] = '99' # $expected->[0][1] = '-101' # Failed test 'blinker 4 cell count (9)' # at tgol.t line 17. # got: 9 # expected: 15 # Failed test 'blinker 4 cell array count' # at tgol.t line 18. # got: 9 # expected: 15 # Failed test 'blinker 4 cell array' # at tgol.t line 19. # Structures begin differing at: # $got->[0][1] = '100' # $expected->[0][1] = '-100' # Failed test 'blinker 5 cell count (8)' # at tgol.t line 17. # got: 8 # expected: 15 # Failed test 'blinker 5 cell array count' # at tgol.t line 18. # got: 8 # expected: 15 # Failed test 'blinker 5 cell array' # at tgol.t line 19. # Structures begin differing at: # $got->[0][1] = '99' # $expected->[0][1] = '-101' # Looks like you failed 18 tests of 18.

        I left this tgol.t test program out of the root node because it was already way too long ... then forgot about it. Sorry 'bout that. Update: I've now remedied my oversight by adding the tgol.t test program above to the root node.

Re^7: High Performance Game of Life
by marioroy (Priest) on Aug 13, 2017 at 10:31 UTC

    Update 1: Bit-manipulation will not work when $y is negative. See this post. I assumed that $y was always positive from testing using the initial test script.

    Update 2: See this post for a version that maps two integers into one integer successfully.

    For a last attempt in reaching 10x, I tried combining two integers into one via bit-manipulation. Having to support ($x) being negative made bit-manipulation more complicated. However, it runs as fast as pack('ii').

    This was an exercise and nothing more. I thought why not try bit-shifting the two integers into one.

    package Organism; use strict; # use warnings; sub _pack { my ( $x, $y ) = @_; $x < 0 ? -(abs($x) << 32 | $y) : $x << 32 | $y; } sub _unpack { my ( $n ) = @_; return $n < 0 ? ( -( abs($n) >> 32 ), abs($n) & 0xFFFFFFFF ) : ( $n >> 32 , $n & 0xFFFFFFFF ); } 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 @{$r} } = undef } } # 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 $_ ] } 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, %new_cells ); for my $c (keys %{ $cells }) { # Get the (up to 8) dead cells surrounding the cell ( $x0, $y0 ) = $c < 0 ? ( -( abs($c) >> 32 ), abs($c) & 0xFFFFFFFF ) : ( $c >> 32 , $c & 0xFFFFFFFF ); ( $x1, $x2, $y1, $y2 ) = ( $x0 - 1, $x0 + 1, $y0 - 1, $y0 + 1 ); my @zcells = ( ($k1 = $x1 < 0 ? -(abs($x1) << 32 | $y1) : $x1 << 32 | $y1) x + !(exists $cells->{$k1}), ($k2 = $x1 < 0 ? -(abs($x1) << 32 | $y0) : $x1 << 32 | $y0) x + !(exists $cells->{$k2}), ($k3 = $x1 < 0 ? -(abs($x1) << 32 | $y2) : $x1 << 32 | $y2) x + !(exists $cells->{$k3}), ($k4 = $x0 < 0 ? -(abs($x0) << 32 | $y1) : $x0 << 32 | $y1) x + !(exists $cells->{$k4}), ($k5 = $x0 < 0 ? -(abs($x0) << 32 | $y2) : $x0 << 32 | $y2) x + !(exists $cells->{$k5}), ($k6 = $x2 < 0 ? -(abs($x2) << 32 | $y1) : $x2 << 32 | $y1) x + !(exists $cells->{$k6}), ($k7 = $x2 < 0 ? -(abs($x2) << 32 | $y0) : $x2 << 32 | $y0) x + !(exists $cells->{$k7}), ($k8 = $x2 < 0 ? -(abs($x2) << 32 | $y2) : $x2 << 32 | $y2) x + !(exists $cells->{$k8}) ); # 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) { ( $x0, $y0 ) = $z < 0 ? ( -( abs($z) >> 32 ), abs($z) & 0xFFFFFFFF ) : ( $z >> 32 , $z & 0xFFFFFFFF ); ( $x1, $x2, $y1, $y2 ) = ( $x0 - 1, $x0 + 1, $y0 - 1, $y0 + 1 + ); # Get num live ( ( exists $cells->{ $x1 < 0 ? -(abs($x1) << 32 | $y1) : $x +1 << 32 | $y1 } ) + ( exists $cells->{ $x1 < 0 ? -(abs($x1) << 32 | $y0) : $x +1 << 32 | $y0 } ) + ( exists $cells->{ $x1 < 0 ? -(abs($x1) << 32 | $y2) : $x +1 << 32 | $y2 } ) + ( exists $cells->{ $x0 < 0 ? -(abs($x0) << 32 | $y1) : $x +0 << 32 | $y1 } ) + ( exists $cells->{ $x0 < 0 ? -(abs($x0) << 32 | $y2) : $x +0 << 32 | $y2 } ) + ( exists $cells->{ $x2 < 0 ? -(abs($x2) << 32 | $y1) : $x +2 << 32 | $y1 } ) + ( exists $cells->{ $x2 < 0 ? -(abs($x2) << 32 | $y0) : $x +2 << 32 | $y0 } ) + ( exists $cells->{ $x2 < 0 ? -(abs($x2) << 32 | $y2) : $x +2 << 32 | $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

Log In?
Username:
Password:

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

How do I use this? | Other CB clients
Other Users?
Others meditating upon the Monastery: (4)
As of 2018-09-20 06:27 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?
    Eventually, "covfefe" will come to mean:













    Results (173 votes). Check out past polls.

    Notices?
    • (Sep 10, 2018 at 22:53 UTC) Welcome new users!