laziness, impatience, and hubris PerlMonks

### Re^17: High Performance Game of Life (updated - results)

by tybalt89 (Monsignor)
 on Aug 15, 2017 at 22:06 UTC Need Help??

New entry.

Hey, it passes all the tests :)

hehehe

```package Organism;

# based on http://perlmonks.org/?node_id=1197284

use strict;
use warnings;

sub count
{
return shift->{config}[0] =~ tr/1//;
}

# Input a list of [ x, y ] coords
sub insert_cells
{
my \$extra = 3;
my \$self = shift;
my \$xl = my \$xh = \$_[0][0]; # find cell limits
my \$yl = my \$yh = \$_[0][1];
for (@_)
{
my (\$x, \$y) = @\$_;
\$xl > \$x and \$xl = \$x;
\$xh < \$x and \$xh = \$x;
\$yl > \$y and \$yl = \$y;
\$yh < \$y and \$yh = \$y;
}
my \$xoffset = \$xl - \$extra; # get sizes and insert live cells
my \$w = \$xh - \$xl + 2 * \$extra;
my \$yoffset = \$yl - \$extra;
my \$h = \$yh - \$yl + 2 * \$extra;
my \$grid = '0' x \$w x \$h;
for (@_)
{
my (\$x, \$y) = @\$_;
substr \$grid, \$x - \$xoffset + (\$y - \$yoffset) * \$w, 1, '1';
}
\$self->{config} = [ \$grid, \$w, \$h, \$xoffset, \$yoffset ];
}

# Return sorted list of cells in the Organism.
# Used for verification and testing the state of the organism.
sub get_live_cells
{
my \$self = shift;
my ( \$grid, \$w, \$h, \$xoffset, \$yoffset ) = @{ \$self->{config} };
my @cells;
push @cells, [ \$-[0] % \$w + \$xoffset, int( \$-[0] / \$w ) + \$yoffset ]
while \$grid =~ /1/g;
sort { \$a->[0] <=> \$b->[0] || \$a->[1] <=> \$b->[1] } @cells;
}

sub tick
{
my \$self = shift;
my ( \$grid, \$w, \$h ) = @{ \$self->{config} };
my \$all = '0' x (\$w + 1) . \$grid;
my \$sum = \$all =~ tr/1/2/r;
( \$sum |= substr \$all, \$_ ) =~ tr/1357/2468/ for
1, 2, \$w, \$w + 2, \$w * 2, \$w * 2 + 1, \$w * 2 + 2; # other 7 neighb
+ors
\$grid = substr \$grid | \$sum, 0, \$w * \$h;
\$self->{config}[0] = \$grid =~ tr/1-9/000011100/r; # dead or alive
}

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

1;

Replies are listed 'Best First'.
Re^18: High Performance Game of Life (updated - results)
by marioroy (Prior) on Aug 16, 2017 at 03:57 UTC

Hi tybalt89,

Wow! Your new entry runs faster than C++. Also, memory consumption is less than 500 MB ;-)

```\$ perl createblinker.pl 500000 -900000 100 >x.tmp 2>y.tmp
\$ g++ -o tbench1 -std=c++11 -Wall -O3 tbench1.cpp

\$ time ./tbench1 x.tmp 2
cell count at start = 1500000
run benchmark for 2 ticks
cell count at end = 1500000
time taken 4 secs

real  0m5.240s   mem 139 MB
user  0m5.149s
sys   0m0.085s

\$ time /opt/perl-5.26.0/bin/perl -I. tbench1.pl x.tmp 2
cell count at start = 1500000
run benchmark for 2 ticks
cell count at end = 1500000
time taken: 1 secs

real  0m3.482s   mem 492 MB
user  0m3.242s
sys   0m0.233s

Micro-optimization may be a subjective matter. At this level, one may want to for 2%.

I've replaced 3 multiplications ( \$w * 2 ) with ( \$w << 1 ).

```( \$sum |= substr \$all, \$_ ) =~ tr/1357/2468/ for
1, 2, \$w, \$w + 2, (\$w << 1), (\$w << 1) + 1, (\$w << 1) + 2; # other 7
+ neighbors
```\$ time /opt/perl-5.26.0/bin/perl -I. tbench1.pl x.tmp 2
cell count at start = 1500000
run benchmark for 2 ticks
cell count at end = 1500000
time taken: 1 secs

real  0m3.420s   mem 492 MB
user  0m3.203s
sys   0m0.205s

Regards, Mario

Re^18: High Performance Game of Life (updated - results)
by eyepopslikeamosquito (Archbishop) on Aug 16, 2017 at 13:09 UTC

Thanks for the new test.

Here's my "new entry" fixed to pass it.

```package Organism;

# based on http://perlmonks.org/?node_id=1197284

use strict;
use warnings;

sub count
{
return shift->{config}[0] =~ tr/1//;
}

# Input a list of [ x, y ] coords
sub insert_cells
{
my \$extra = 3;
my \$self = shift;
my \$xl = my \$xh = \$_[0][0]; # find cell limits
my \$yl = my \$yh = \$_[0][1];
for (@_)
{
my (\$x, \$y) = @\$_;
\$xl > \$x and \$xl = \$x;
\$xh < \$x and \$xh = \$x;
\$yl > \$y and \$yl = \$y;
\$yh < \$y and \$yh = \$y;
}
my \$xoffset = \$xl - \$extra; # get sizes and insert live cells
my \$w = \$xh - \$xl + 2 * \$extra;
my \$yoffset = \$yl - \$extra;
my \$h = \$yh - \$yl + 2 * \$extra;
my \$grid = '0' x \$w x \$h;
for (@_)
{
my (\$x, \$y) = @\$_;
substr \$grid, \$x - \$xoffset + (\$y - \$yoffset) * \$w, 1, '1';
}
\$self->{config} = [ \$grid, \$w, \$h, \$xoffset, \$yoffset ];
}

# Return sorted list of cells in the Organism.
# Used for verification and testing the state of the organism.
sub get_live_cells
{
my \$self = shift;
my ( \$grid, \$w, \$h, \$xoffset, \$yoffset ) = @{ \$self->{config} };
my @cells;
push @cells, [ \$-[0] % \$w + \$xoffset, int( \$-[0] / \$w ) + \$yoffset ]
while \$grid =~ /1/g;
sort { \$a->[0] <=> \$b->[0] || \$a->[1] <=> \$b->[1] } @cells;
}

sub tick
{
my \$self = shift;
my ( \$grid, \$w, \$h, \$xoffset, \$yoffset ) = @{ \$self->{config} };
# expand
\$grid = join '00', '0' x (\$w + 1), unpack("(a\$w)*", \$grid), '0' x (\$
+w + 1);
\$w += 2;
\$h += 2;
\$xoffset--;
\$yoffset--;
# now get new generation
my \$all = '0' x (\$w + 1) . \$grid;
my \$sum = \$all =~ tr/1/2/r;
( \$sum |= substr \$all, \$_ ) =~ tr/1357/2468/ for
1, 2, \$w, \$w + 2, \$w * 2, \$w * 2 + 1, \$w * 2 + 2; # other 7 neighb
+ors
\$grid = substr \$grid | \$sum, 0, \$w * \$h;
\$self->{config} = [ \$grid =~ tr/1-9/000011100/r, \$w, \$h, \$xoffset, \$
+yoffset ];
}

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

1;

Tweak a couple of lines and add only 5 new ones and it's fixed. I really love perl!

tybalt89++ Look at Perl go ;-)

```\$ perl createblinker.pl 500000 -900000 100 >x.tmp 2>y.tmp

\$ time /opt/perl-5.26.0/bin/perl -I. tbench1.pl x.tmp 2
cell count at start = 1500000
run benchmark for 2 ticks
cell count at end = 1500000
time taken: 1 secs

real  0m3.618s
user  0m3.363s
sys   0m0.235s

Last night, I ran with a small sample and displayed \$grid everywhere to understand the code. It's clever.

Regards, Mario

Create A New User
Domain Nodelet?
Node Status?
node history
Node Type: note [id://1197467]
help
Chatterbox?
and the web crawler heard nothing...

How do I use this?Last hourOther CB clients
Other Users?
Others examining the Monastery: (6)
As of 2024-09-17 14:34 GMT
Sections?
Information?
Find Nodes?
Leftovers?
Voting Booth?
The PerlMonks site front end has:

Results (22 votes). Check out past polls.

Notices?
 • erzuuli ‥ 🛈The London Perl and Raku Workshop takes place on 26th Oct 2024. If your company depends on Perl, please consider sponsoring and/or attending.