Re^6: 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;
[download]

Update: Minor stylistic edits were made to Organism.pm above. Note that changing the main loop above from:

for my $c (keys %{ $cells }) {
[download]

to:

while ( my ($c) = each %{ $cells } ) {
[download]

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};
}
[download]

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;
}
[download]

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})  );
[download]

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) );
[download]

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;
}
[download]

Comment on Re^6: High Performance Game of Life Select or Download Code

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; [download]	[reply] [d/l]
Re^8: High Performance Game of Life by marioroy (Priest) on Aug 13, 2017 at 18:11 UTC
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; [download] Regards, Mario	[reply] [d/l]
Re^9: High Performance Game of Life by eyepopslikeamosquito (Chancellor) on Aug 13, 2017 at 21:55 UTC
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 ); } [download] with the command line: `prove tgol.t` [download] 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. [download] 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.	[reply] [d/l] [select]
Re^10: High Performance Game of Life by marioroy (Priest) on Aug 13, 2017 at 22:07 UTC
Re^11: High Performance Game of Life (updated) by marioroy (Priest) on Aug 14, 2017 at 14:39 UTC
Some notes below your chosen depth have not been shown here
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; [download] Regards, Mario	[reply] [d/l]


good chemistry is complicated, and a little bit messy -LW
	PerlMonks