Syntactic Confectionery Delight PerlMonks

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

by eyepopslikeamosquito (Archbishop)
 on Aug 16, 2017 at 13:09 UTC Need Help??

Hey, it passes all the tests :)
Not any more. Nice try, especially given how old your PC is, but you've been exposed by my new and improved anti-tybalt89 tgol3.t test program.

• Comment on Re^18: High Performance Game of Life (updated - results)

Replies are listed 'Best First'.
Re^19: High Performance Game of Life (updated - results)
by tybalt89 (Monsignor) on Aug 16, 2017 at 14:16 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://1197498]
help
Chatterbox?
and the web crawler heard nothing...

How do I use this?Last hourOther CB clients
Other Users?
Others browsing the Monastery: (3)
As of 2024-09-09 19:07 GMT
Sections?
Information?
Find Nodes?
Leftovers?
Voting Booth?

No recent polls found

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.