I've updated Organism.pm to automatically detect the integer
size perl was built with and use 32 x 32 tiles for a 32-bit
perl and 64 x 64 tiles for a 64-bit perl.
You can override this by editing Organism.pm
and manually setting $TILE_SIZE_FULL to 32 or 64.
I've tested with an old 32-bit Perl 5.8.6 and it works for me.
As you might expect, Organism.pm runs a bit slower (and uses more memory)
with 32-bit ints -- but not by much.
As for memory use, the maximum Windows Private Bytes used for the three
million cell case by each process was:
package Organism;
use strict;
use warnings;
# ----------------------------------------------------------------
# The Universe is modelled as a set of overlapping tiles.
# For background, see http://conwaylife.com/wiki/Life128_and_vlife
# We use a simple scheme of 64 x 64 tiles (60 x 60 core) with
# conventional tiling (each tile has eight neighbours).
# Note: alternatively 32 x 32 (28 x 28 core) can be used with 32-bit i
+ntegers.
# Note that this was chosen for simplicity; more efficient schemes
# are available, such as the "brick wall tiling" used by Goucher
# in later versions (apgmera, version 3)
#
# This code is loosely based on apgnano (version 2) but advances
# one tick at a time (rather than advancing two at a time)
# and does not attempt to use universe history.
# This was to keep the implementation short.
#
# ----------------------------------------------------------------
# SQUARE TILE
# Note: if using 64 x 64 square tiles, perl must be built with 64-bit
+integers
# Choose tile size (32 or 64) automatically based on perl integer size
+:
use Config;
my $TILE_SIZE_FULL = $Config{ivsize} < 8 ? 32 : 64;
# ... or manually override by editing the next line
# $TILE_SIZE_FULL = 32; # manually set to 32 or 64
warn __PACKAGE__, ": using $TILE_SIZE_FULL x $TILE_SIZE_FULL tiles\n";
my $BM_MIDDLE = 0x3ffffffc;
my $BM_LEFT = 0xfffffffc;
my $BM_RIGHT = 0x3fffffff;
my $BM_OUTER = 0xc0000003;
my $BM_LEFTMIDDLE = 0x30000000;
my $BM_RIGHTMIDDLE = 0x0000000c;
if ($TILE_SIZE_FULL == 64) {
no warnings qw(portable overflow);
$BM_MIDDLE = 0x3ffffffffffffffc;
$BM_LEFT = 0xfffffffffffffffc;
$BM_RIGHT = 0x3fffffffffffffff;
$BM_OUTER = 0xc000000000000003;
$BM_LEFTMIDDLE = 0x3000000000000000;
$BM_RIGHTMIDDLE = 0x000000000000000c;
}
my $BORDER_WIDTH = 2;
my $BORDER_WIDTH_P1 = $BORDER_WIDTH + 1;
my $TILE_SIZE_FULL_M1 = $TILE_SIZE_FULL - 1;
my $TILE_SIZE_MBD = $TILE_SIZE_FULL - $BORDER_WIDTH;
my $TILE_SIZE_MBD_M1 = $TILE_SIZE_MBD - 1;
my $TILE_SIZE_CORE = $TILE_SIZE_FULL - 2 * $BORDER_WIDTH;
my $TILE_SIZE_CORE_P1 = $TILE_SIZE_CORE + 1;
# Neighbours are numbered clockwise starting with the one directly abo
+ve
my $NUM_NEIGH = 8;
my $NEIGH_TOP = 0;
my $NEIGH_TOP_RIGHT = 1;
my $NEIGH_RIGHT = 2;
my $NEIGH_BOTTOM_RIGHT = 3;
my $NEIGH_BOTTOM = 4;
my $NEIGH_BOTTOM_LEFT = 5;
my $NEIGH_LEFT = 6;
my $NEIGH_TOP_LEFT = 7;
# Note that the i ^ 4 trick sets i to the opposite one, that is:
# 0 > 4 (TOP > BOTTOM)
# 1 > 5 (TOP RIGHT > BOTTOM LEFT)
# 2 > 6 (RIGHT > LEFT)
# 3 > 7 (BOTTOM RIGHT > TOP LEFT)
# 4 > 0 (BOTTOM > TOP)
# 5 > 1 (BOTTOM LEFT > TOP RIGHT)
# 6 > 2 (LEFT > RIGHT)
# 7 > 3 (TOP LEFT > BOTTOM RIGHT)
# The functions starting with st_ manipulate
# a simple $TILE_SIZE_FULL x $TILE_SIZE_FULL square tile bitmap.
# Note that x and y must be in 0..$TILE_SIZE_FULL-1 range.
# $row is a ref to an array of 64 unsigned 64-bit ints.
# Note: $row can alternatively be an array of 32 unsigned 32-bit ints.
# The value in row[] bitmap is 0 (dead) or 1 (alive).
sub st_getcellval {
my ($row, $x, $y) = @_;
my $mk = 1 << ($TILE_SIZE_FULL_M1 - $x);
return $row->[$y] & $mk ? 1 : 0;
}
sub st_setcellval {
my ($row, $x, $y, $v) = @_;
my $mk = 1 << ($TILE_SIZE_FULL_M1 - $x);
if ($v) { $row->[$y] |= $mk; } else { $row->[$y] &= ~$mk; }
}
sub st_insertcells {
my $row = shift;
for my $r (@_) { st_setcellval($row, $r->[0], $r->[1], 1) }
}
# Used for verification and unit testing of st_tiletick
sub st_getlivecells {
my $row = shift;
my @cells;
for my $y (0 .. $TILE_SIZE_FULL_M1) {
next unless $row->[$y];
for my $x (0 .. $TILE_SIZE_FULL_M1) {
st_getcellval($row, $x, $y) and push @cells, [ $x, $y ];
}
}
sort { $a->[0] <=> $b->[0] || $a->[1] <=> $b->[1] } @cells;
}
# Advance the interior of square tile by one tick.
# Return a two element list:
# [0] : 1 if square tile changed, else 0.
# [1] : neighbour flags (see NEIGH flags above)
# indicates which neighbours need to be updated
sub st_tiletick {
my $row = shift;
my $neigh = 0;
my $bigdiff = 0;
my @carry = (0) x $TILE_SIZE_FULL;
my @parity = (0) x $TILE_SIZE_FULL;
my @diff = (0) x $TILE_SIZE_FULL;
my ( $aa, $bb, $p, $q, $r, $s, $bit0, $bit1, $bit2 );
my $top = 0;
my $bottom = $TILE_SIZE_FULL_M1;
while ($top < $TILE_SIZE_FULL_M1 && $row->[$top] == 0) { ++$top }
while ($bottom > 0 && $row->[$bottom] == 0) { --$bottom }
if ($top > $bottom) { return ( 0, $neigh ) }
for my $i ($top .. $bottom) {
$aa = $row->[$i] >> 1;
$bb = $row->[$i] << 1;
$q = $aa ^ $bb;
$parity[$i] = $q ^ $row->[$i];
$carry[$i] = ($q & $row->[$i]) | ($aa & $bb);
}
--$top; ++$bottom;
if ($top < 1) { $top = 1 }
if ($bottom > $TILE_SIZE_MBD) { $bottom = $TILE_SIZE_MBD }
for my $i ($top .. $bottom) {
$aa = $parity[$i-1];
$bb = $parity[$i+1];
$q = $aa ^ $bb;
$bit0 = $q ^ $parity[$i];
$r = ($q & $parity[$i]) | ($aa & $bb);
$aa = $carry[$i-1];
$bb = $carry[$i+1];
$q = $aa ^ $bb;
$p = $q ^ $carry[$i];
$s = ($q & $carry[$i]) | ($aa & $bb);
$bit1 = $p ^ $r;
$bit2 = $s ^ ($p & $r);
$p = ($bit0 & $bit1 & ~$bit2) | ($bit2 & ~$bit1 & ~$bit0 & $row-
+>[$i]);
$diff[$i] = ($row->[$i] ^ $p) & $BM_MIDDLE;
$bigdiff |= $diff[$i];
$row->[$i] = ($p & $BM_MIDDLE) | ($row->[$i] & ~$BM_MIDDLE);
}
$aa = $diff[$BORDER_WIDTH] | $diff[$BORDER_WIDTH_P1];
$bb = $diff[$TILE_SIZE_CORE] | $diff[$TILE_SIZE_CORE_P1];
if ($bigdiff) {
if ($bigdiff & $BM_LEFTMIDDLE) { $neigh |= 1 << $NEIGH_LEFT }
if ($bigdiff & $BM_RIGHTMIDDLE) { $neigh |= 1 << $NEIGH_RIGHT }
}
if ($aa) {
$neigh |= 1 << $NEIGH_TOP;
if ($aa & $BM_LEFTMIDDLE) { $neigh |= 1 << $NEIGH_TOP_LEFT }
if ($aa & $BM_RIGHTMIDDLE) { $neigh |= 1 << $NEIGH_TOP_RIGHT }
}
if ($bb) {
$neigh |= 1 << $NEIGH_BOTTOM;
if ($bb & $BM_LEFTMIDDLE) { $neigh |= 1 << $NEIGH_BOTTOM_LEFT }
if ($bb & $BM_RIGHTMIDDLE) { $neigh |= 1 << $NEIGH_BOTTOM_RIGHT
+}
}
my $changed = ($bigdiff != 0) ? 1 : 0;
return ( $changed, $neigh );
}
# See perlmonks.org, node_id: 1199987
# Inline this popcount function below
# sub popcount { sprintf('%b', shift) =~ tr/1// }
# ----------------------------------------------------------------
# ORGANISM
sub count {
my $self = shift;
my $tiles = $self->{Tiles};
my $cnt = 0;
for my $k (keys %{$tiles}) {
my $row = $tiles->{$k}->{Row};
for my $y ($BORDER_WIDTH .. $TILE_SIZE_MBD_M1) {
next unless $row->[$y];
# $cnt += popcount($row->[$y] & $BM_MIDDLE);
$cnt += sprintf('%b', $row->[$iy] & $BM_MIDDLE) =~ tr/1//;
}
}
return $cnt;
}
# Input a list of [ x, y ] coords
sub insert_cells {
my $self = shift;
for my $r (@_) { $self->setcell($r->[0], $r->[1], 1) }
}
# Used for verification and testing the state of the organism
sub get_live_cells {
my $self = shift;
my $tiles = $self->{Tiles};
my @cells;
for my $k (keys %{$tiles}) {
my $sqt = $tiles->{$k};
for my $y ($BORDER_WIDTH .. $TILE_SIZE_MBD_M1) {
next unless $sqt->{Row}->[$y];
for my $x ($BORDER_WIDTH .. $TILE_SIZE_MBD_M1) {
if (st_getcellval($sqt->{Row}, $x, $y)) {
push @cells,
[$TILE_SIZE_CORE * $sqt->{Tx} + $x - $BORDER_WIDTH,
$TILE_SIZE_CORE * $sqt->{Ty} + $y - $BORDER_WIDTH];
}
}
}
}
sort { $a->[0] <=> $b->[0] || $a->[1] <=> $b->[1] } @cells;
}
sub get_neighbour {
my $self = shift;
my $sqt = shift;
my $i = shift;
unless ($sqt->{Neighbours}->[$i]) {
my $x = $sqt->{Tx};
my $y = $sqt->{Ty};
if ($i >= $NEIGH_TOP_RIGHT && $i <= $NEIGH_BOTTOM_RIGHT) { ++
+$x }
if ($i >= $NEIGH_BOTTOM_RIGHT && $i <= $NEIGH_BOTTOM_LEFT) { ++
+$y }
if ($i >= $NEIGH_BOTTOM_LEFT && $i <= $NEIGH_TOP_LEFT) { --
+$x }
if ($i == $NEIGH_TOP_LEFT || $i <= $NEIGH_TOP_RIGHT) { --
+$y }
my $tiles = $self->{Tiles};
my $k = pack 'i2', $x, $y;
unless (exists $tiles->{$k}) {
$tiles->{$k} = {
Row => [ (0) x $TILE_SIZE_FULL ],
Tx => $x,
Ty => $y,
Updateflags => 0,
Neighbours => [],
};
}
$sqt->{Neighbours}->[$i] = $tiles->{$k};
}
return $sqt->{Neighbours}->[$i];
}
# Alert the neighbour that its neighbour (the original tile) has chang
+ed
sub update_neighbour {
my $self = shift;
my $sqt = shift;
my $i = shift;
if ($self->get_neighbour($sqt, $i)->{Updateflags} == 0) {
push @{$self->{Modified}}, $self->get_neighbour($sqt, $i);
}
$self->get_neighbour($sqt, $i)->{Updateflags} |= 1 << ($i ^ 4);
}
# Update the relevant portions of the boundary (a 64-by-64 square
# with the central 60-by-60 square removed) by copying data from
# the interiors (the 60-by-60 central squares) of the neighbours.
# Only perform this copying when necessary.
# Note: alternatively: 32-by-32 with central 28-by-28.
sub update_boundary {
my $self = shift;
my $sqt = shift;
my $temp_modified = $self->{TempModified};
if ( $sqt->{Updateflags} & (1 << $NEIGH_TOP) ) {
my $n = $self->get_neighbour($sqt, $NEIGH_TOP);
$sqt->{Row}->[0] = ($n->{Row}->[$TILE_SIZE_CORE] & $BM_MIDDLE) |
+ ($sqt->{Row}->[0] & $BM_OUTER);
$sqt->{Row}->[1] = ($n->{Row}->[$TILE_SIZE_CORE_P1] & $BM_MIDDLE
+) | ($sqt->{Row}->[1] & $BM_OUTER);
}
if ( $sqt->{Updateflags} & (1 << $NEIGH_TOP_LEFT) ) {
my $n = $self->get_neighbour($sqt, $NEIGH_TOP_LEFT);
$sqt->{Row}->[0] = (($n->{Row}->[$TILE_SIZE_CORE] & $BM_MIDDLE)
+<< $TILE_SIZE_CORE) | ($sqt->{Row}->[0] & $BM_RIGHT);
$sqt->{Row}->[1] = (($n->{Row}->[$TILE_SIZE_CORE_P1] & $BM_MIDDL
+E) << $TILE_SIZE_CORE) | ($sqt->{Row}->[1] & $BM_RIGHT);
}
if ( $sqt->{Updateflags} & (1 << $NEIGH_TOP_RIGHT) ) {
my $n = $self->get_neighbour($sqt, $NEIGH_TOP_RIGHT);
$sqt->{Row}->[0] = (($n->{Row}->[$TILE_SIZE_CORE] & $BM_MIDDLE)
+>> $TILE_SIZE_CORE) | ($sqt->{Row}->[0] & $BM_LEFT);
$sqt->{Row}->[1] = (($n->{Row}->[$TILE_SIZE_CORE_P1] & $BM_MIDDL
+E) >> $TILE_SIZE_CORE) | ($sqt->{Row}->[1] & $BM_LEFT);
}
if ( $sqt->{Updateflags} & (1 << $NEIGH_BOTTOM) ) {
my $n = $self->get_neighbour($sqt, $NEIGH_BOTTOM);
$sqt->{Row}->[$TILE_SIZE_MBD] = ($n->{Row}->[$BORDER_WIDTH] & $B
+M_MIDDLE) | ($sqt->{Row}->[$TILE_SIZE_MBD] & $BM_OUTER);
$sqt->{Row}->[$TILE_SIZE_FULL_M1] = ($n->{Row}->[3] & $BM_MIDDLE
+) | ($sqt->{Row}->[$TILE_SIZE_FULL_M1] & $BM_OUTER);
}
if ( $sqt->{Updateflags} & (1 << $NEIGH_BOTTOM_LEFT) ) {
my $n = $self->get_neighbour($sqt, $NEIGH_BOTTOM_LEFT);
$sqt->{Row}->[$TILE_SIZE_MBD] = (($n->{Row}->[$BORDER_WIDTH] & $
+BM_MIDDLE) << $TILE_SIZE_CORE) | ($sqt->{Row}->[$TILE_SIZE_MBD] & $BM
+_RIGHT);
$sqt->{Row}->[$TILE_SIZE_FULL_M1] = (($n->{Row}->[3] & $BM_MIDDL
+E) << $TILE_SIZE_CORE) | ($sqt->{Row}->[$TILE_SIZE_FULL_M1] & $BM_RIG
+HT);
}
if ( $sqt->{Updateflags} & (1 << $NEIGH_BOTTOM_RIGHT) ) {
my $n = $self->get_neighbour($sqt, $NEIGH_BOTTOM_RIGHT);
$sqt->{Row}->[$TILE_SIZE_MBD] = (($n->{Row}->[$BORDER_WIDTH] & $
+BM_MIDDLE) >> $TILE_SIZE_CORE) | ($sqt->{Row}->[$TILE_SIZE_MBD] & $BM
+_LEFT);
$sqt->{Row}->[$TILE_SIZE_FULL_M1] = (($n->{Row}->[3] & $BM_MIDDL
+E) >> $TILE_SIZE_CORE) | ($sqt->{Row}->[$TILE_SIZE_FULL_M1] & $BM_LEF
+T);
}
if ( $sqt->{Updateflags} & (1 << $NEIGH_LEFT) ) {
my $n = $self->get_neighbour($sqt, $NEIGH_LEFT);
for my $i ($BORDER_WIDTH .. $TILE_SIZE_MBD_M1) {
$sqt->{Row}->[$i] = (($n->{Row}->[$i] & $BM_MIDDLE) << $TILE_
+SIZE_CORE) | ($sqt->{Row}->[$i] & $BM_RIGHT);
}
}
if ( $sqt->{Updateflags} & (1 << $NEIGH_RIGHT) ) {
my $n = $self->get_neighbour($sqt, $NEIGH_RIGHT);
for my $i ($BORDER_WIDTH .. $TILE_SIZE_MBD_M1) {
$sqt->{Row}->[$i] = (($n->{Row}->[$i] & $BM_MIDDLE) >> $TILE_
+SIZE_CORE) | ($sqt->{Row}->[$i] & $BM_LEFT);
}
}
$sqt->{Updateflags} = 0;
push @{$temp_modified}, $sqt;
}
# Advance the interior of the tile by one generation.
sub update_tile {
my $self = shift;
my $modified = $self->{Modified};
my $sqt = shift;
my ($update_flag, $neigh) = st_tiletick($sqt->{Row});
if ($update_flag) {
if ($sqt->{Updateflags} == 0) { push @{$modified}, $sqt }
$sqt->{Updateflags} |= 1 << $NUM_NEIGH;
}
for my $i (0 .. $NUM_NEIGH - 1) {
if ($neigh & (1 << $i)) { $self->update_neighbour($sqt, $i) }
}
}
sub tick {
my $self = shift;
my $modified = $self->{Modified};
my $temp_modified = $self->{TempModified};
while (@{$modified}) {
$self->update_boundary(pop @{$modified});
}
while (@{$temp_modified}) {
$self->update_tile(pop @{$temp_modified});
}
}
sub updatecell {
my $self = shift;
my $sqt = shift;
my $x = shift;
my $y = shift;
if ($sqt->{Updateflags} == 0) { push @{$self->{Modified}}, $sqt }
$sqt->{Updateflags} |= 1 << $NUM_NEIGH;
if ($y <= $BORDER_WIDTH_P1) { $self->update_neighbour($sqt, $NEIGH_
+TOP) }
if ($y >= $TILE_SIZE_CORE) { $self->update_neighbour($sqt, $NEIGH_B
+OTTOM) }
if ($x <= $BORDER_WIDTH_P1) {
$self->update_neighbour($sqt, $NEIGH_LEFT);
if ($y <= $BORDER_WIDTH_P1) { $self->update_neighbour($sqt, $NEI
+GH_TOP_LEFT) }
if ($y >= $TILE_SIZE_CORE) { $self->update_neighbour($sqt, $NEIG
+H_BOTTOM_LEFT) }
}
if ($x >= $TILE_SIZE_CORE) {
$self->update_neighbour($sqt, $NEIGH_RIGHT);
if ($y <= $BORDER_WIDTH_P1) { $self->update_neighbour($sqt, $NEI
+GH_TOP_RIGHT) }
if ($y >= $TILE_SIZE_CORE) { $self->update_neighbour($sqt, $NEIG
+H_BOTTOM_RIGHT) }
}
}
sub setcell {
my $self = shift;
my $x = shift;
my $y = shift;
my $state = shift;
my $tiles = $self->{Tiles};
my $ox = $x % $TILE_SIZE_CORE;
my $oy = $y % $TILE_SIZE_CORE;
if ($ox < 0) { $ox += $TILE_SIZE_CORE }
if ($oy < 0) { $oy += $TILE_SIZE_CORE }
my $tx = ($x - $ox) / $TILE_SIZE_CORE;
my $ty = ($y - $oy) / $TILE_SIZE_CORE;
my $k = pack 'i2', $tx, $ty;
unless (exists $tiles->{$k}) {
$tiles->{$k} = {
Row => [ (0) x $TILE_SIZE_FULL ],
Tx => $tx,
Ty => $ty,
Updateflags => 0,
Neighbours => [],
};
}
my $xx = $ox + $BORDER_WIDTH;
my $yy = $oy + $BORDER_WIDTH;
st_setcellval($tiles->{$k}->{Row}, $xx, $yy, $state);
$self->updatecell($tiles->{$k}, $xx, $yy);
}
sub getcellval {
my $self = shift;
my $x = shift;
my $y = shift;
my $tiles = $self->{Tiles};
my $ox = $x % $TILE_SIZE_CORE;
my $oy = $y % $TILE_SIZE_CORE;
if ($ox < 0) { $ox += $TILE_SIZE_CORE }
if ($oy < 0) { $oy += $TILE_SIZE_CORE }
my $tx = ($x - $ox) / $TILE_SIZE_CORE;
my $ty = ($y - $oy) / $TILE_SIZE_CORE;
my $k = pack 'i2', $tx, $ty;
exists $tiles->{$k} or return 0;
return st_getcellval( $tiles->{$k}->{Row},
$ox + $BORDER_WIDTH,
$oy + $BORDER_WIDTH );
}
sub new {
my $class = shift;
my %init_self = ( Tiles => {}, Modified => [], TempModified => [] )
+;
bless \%init_self, $class;
}
1;
Update: For cheap thrills, I tried bigint with 128-bit integers.
Very few changes needed to the code, just:
use bigint;
$TILE_SIZE_FULL = 128;
if ($TILE_SIZE_FULL == 128) {
no warnings qw(portable overflow);
$BM_MIDDLE = 0x3ffffffffffffffffffffffffffffffc;
$BM_LEFT = 0xfffffffffffffffffffffffffffffffc;
$BM_RIGHT = 0x3fffffffffffffffffffffffffffffff;
$BM_OUTER = 0xc0000000000000000000000000000003;
$BM_LEFTMIDDLE = 0x30000000000000000000000000000000;
$BM_RIGHTMIDDLE = 0x0000000000000000000000000000000c;
}
It appeared to work fine, but was super slow, as you might expect.
Update: Tried to clarify the code a bit by introducing
a new coordinate mapping function get_tile_coords() and
its converse get_cell_coords() (plus some other minor improvements).
package Organism;
use strict;
use warnings;
# ----------------------------------------------------------------
# The Universe is modelled as a set of overlapping tiles.
# For background, see http://conwaylife.com/wiki/Life128_and_vlife
# We use a simple scheme of 64 x 64 tiles (60 x 60 core) with
# conventional tiling (each tile has eight neighbours).
# Note: alternatively 32 x 32 (28 x 28 core) can be used with 32-bit i
+ntegers.
# Note that this was chosen for simplicity; more efficient schemes
# are available, such as the "brick wall tiling" used by Goucher
# in later versions (apgmera, version 3)
#
# This code is loosely based on apgnano (version 2) but advances
# one tick at a time (rather than advancing two at a time)
# and does not attempt to use universe history.
# This was to keep the implementation short.
#
# ----------------------------------------------------------------
# SQUARE TILE
# Note: if using 64 x 64 square tiles, perl must be built with 64-bit
+integers
# Choose tile size (32 or 64) automatically based on perl integer size
+:
use Config;
my $TILE_SIZE_FULL = $Config{ivsize} < 8 ? 32 : 64;
# ... or manually override by editing the next line
# $TILE_SIZE_FULL = 32; # manually set to 32 or 64
warn __PACKAGE__, ": using $TILE_SIZE_FULL x $TILE_SIZE_FULL tiles\n";
my $BM_MIDDLE = 0x3ffffffc;
my $BM_LEFT = 0xfffffffc;
my $BM_RIGHT = 0x3fffffff;
my $BM_OUTER = 0xc0000003;
my $BM_LEFTMIDDLE = 0x30000000;
my $BM_RIGHTMIDDLE = 0x0000000c;
my $BM_FMT = '%032b';
if ($TILE_SIZE_FULL == 64) {
no warnings qw(portable overflow);
$BM_MIDDLE = 0x3ffffffffffffffc;
$BM_LEFT = 0xfffffffffffffffc;
$BM_RIGHT = 0x3fffffffffffffff;
$BM_OUTER = 0xc000000000000003;
$BM_LEFTMIDDLE = 0x3000000000000000;
$BM_RIGHTMIDDLE = 0x000000000000000c;
$BM_FMT = '%064b';
}
my $BORDER_WIDTH = 2;
my $BORDER_WIDTH_P1 = $BORDER_WIDTH + 1;
my $TILE_SIZE_FULL_M1 = $TILE_SIZE_FULL - 1;
my $TILE_SIZE_MBD = $TILE_SIZE_FULL - $BORDER_WIDTH;
my $TILE_SIZE_MBD_M1 = $TILE_SIZE_MBD - 1;
my $TILE_SIZE_CORE = $TILE_SIZE_FULL - 2 * $BORDER_WIDTH;
my $TILE_SIZE_CORE_P1 = $TILE_SIZE_CORE + 1;
# Neighbours are numbered clockwise starting with the one directly abo
+ve
my $NUM_NEIGH = 8;
my $NEIGH_TOP = 0;
my $NEIGH_TOP_RIGHT = 1;
my $NEIGH_RIGHT = 2;
my $NEIGH_BOTTOM_RIGHT = 3;
my $NEIGH_BOTTOM = 4;
my $NEIGH_BOTTOM_LEFT = 5;
my $NEIGH_LEFT = 6;
my $NEIGH_TOP_LEFT = 7;
# Note that the i ^ 4 trick sets i to the opposite one, that is:
# 0 > 4 (TOP > BOTTOM)
# 1 > 5 (TOP RIGHT > BOTTOM LEFT)
# 2 > 6 (RIGHT > LEFT)
# 3 > 7 (BOTTOM RIGHT > TOP LEFT)
# 4 > 0 (BOTTOM > TOP)
# 5 > 1 (BOTTOM LEFT > TOP RIGHT)
# 6 > 2 (LEFT > RIGHT)
# 7 > 3 (TOP LEFT > BOTTOM RIGHT)
# The functions starting with st_ manipulate
# a simple $TILE_SIZE_FULL x $TILE_SIZE_FULL square tile bitmap.
# Note that $x and $y must be in 0..$TILE_SIZE_FULL-1 range.
# $row is a ref to an array of 64 unsigned 64-bit ints.
# Note: $row can alternatively be an array of 32 unsigned 32-bit ints.
# The value in row[] bitmap is 0 (dead) or 1 (alive).
sub st_getcellval {
my ($row, $x, $y) = @_;
# my $mask = 1 << ($TILE_SIZE_FULL_M1 - $x);
# return $row->[$y] & $mask ? 1 : 0;
$row->[$y] & ( 1 << ($TILE_SIZE_FULL_M1 - $x) );
}
sub st_setcellval {
my ($row, $x, $y, $v) = @_;
my $mask = 1 << ($TILE_SIZE_FULL_M1 - $x);
if ($v) { $row->[$y] |= $mask; } else { $row->[$y] &= ~$mask; }
}
sub st_insertcells {
my $row = shift;
for my $r (@_) { st_setcellval($row, $r->[0], $r->[1], 1) }
}
# Used for verification and unit testing of st_tiletick
sub st_getlivecells {
my $row = shift;
my @cells;
for my $y (0 .. $TILE_SIZE_FULL_M1) {
next unless $row->[$y];
for my $x (0 .. $TILE_SIZE_FULL_M1) {
st_getcellval($row, $x, $y) and push @cells, [ $x, $y ];
}
}
sort { $a->[0] <=> $b->[0] || $a->[1] <=> $b->[1] } @cells;
}
# Advance the interior of square tile by one tick.
# Return a two element list:
# [0] : 1 if square tile changed, else 0.
# [1] : neighbour flags (see NEIGH flags above)
# indicates which neighbours need to be updated
sub st_tiletick {
my $row = shift;
my $neigh = 0;
my $bigdiff = 0;
my @carry = (0) x $TILE_SIZE_FULL;
my @parity = (0) x $TILE_SIZE_FULL;
my @diff = (0) x $TILE_SIZE_FULL;
my ( $aa, $bb, $p, $q, $r, $s, $bit0, $bit1, $bit2 );
my $top = 0;
my $bottom = $TILE_SIZE_FULL_M1;
while ($top < $TILE_SIZE_FULL_M1 && $row->[$top] == 0) { ++$top }
while ($bottom > 0 && $row->[$bottom] == 0) { --$bottom }
if ($top > $bottom) { return ( 0, $neigh ) }
for my $i ($top .. $bottom) {
$aa = $row->[$i] >> 1;
$bb = $row->[$i] << 1;
$q = $aa ^ $bb;
$parity[$i] = $q ^ $row->[$i];
$carry[$i] = ($q & $row->[$i]) | ($aa & $bb);
}
--$top; ++$bottom;
if ($top < 1) { $top = 1 }
if ($bottom > $TILE_SIZE_MBD) { $bottom = $TILE_SIZE_MBD }
for my $i ($top .. $bottom) {
$aa = $parity[$i-1];
$bb = $parity[$i+1];
$q = $aa ^ $bb;
$bit0 = $q ^ $parity[$i];
$r = ($q & $parity[$i]) | ($aa & $bb);
$aa = $carry[$i-1];
$bb = $carry[$i+1];
$q = $aa ^ $bb;
$p = $q ^ $carry[$i];
$s = ($q & $carry[$i]) | ($aa & $bb);
$bit1 = $p ^ $r;
$bit2 = $s ^ ($p & $r);
$p = ($bit0 & $bit1 & ~$bit2) | ($bit2 & ~$bit1 & ~$bit0 & $row-
+>[$i]);
$diff[$i] = ($row->[$i] ^ $p) & $BM_MIDDLE;
$bigdiff |= $diff[$i];
$row->[$i] = ($p & $BM_MIDDLE) | ($row->[$i] & ~$BM_MIDDLE);
}
$aa = $diff[$BORDER_WIDTH] | $diff[$BORDER_WIDTH_P1];
$bb = $diff[$TILE_SIZE_CORE] | $diff[$TILE_SIZE_CORE_P1];
if ($bigdiff) {
if ($bigdiff & $BM_LEFTMIDDLE) { $neigh |= 1 << $NEIGH_LEFT }
if ($bigdiff & $BM_RIGHTMIDDLE) { $neigh |= 1 << $NEIGH_RIGHT }
}
if ($aa) {
$neigh |= 1 << $NEIGH_TOP;
if ($aa & $BM_LEFTMIDDLE) { $neigh |= 1 << $NEIGH_TOP_LEFT }
if ($aa & $BM_RIGHTMIDDLE) { $neigh |= 1 << $NEIGH_TOP_RIGHT }
}
if ($bb) {
$neigh |= 1 << $NEIGH_BOTTOM;
if ($bb & $BM_LEFTMIDDLE) { $neigh |= 1 << $NEIGH_BOTTOM_LEFT }
if ($bb & $BM_RIGHTMIDDLE) { $neigh |= 1 << $NEIGH_BOTTOM_RIGHT
+}
}
my $changed = ($bigdiff != 0) ? 1 : 0;
return ( $changed, $neigh );
}
# Note: mapping of x (cell) to tx (tile) is:
# x tx
# ---------- --
# ...
# -121..-180 -3
# -61..-120 -2
# -1..-60 -1
# 0.. 59 0
# 60..119 1
# 120..179 2
# ...
# Ditto for y (cell) to ty (tile).
# Input cell (x, y). Return (tx, ty, ix, iy)
# (tx, ty) : Tile coords
# (ix, iy) : x, y coords inside tile
sub get_tile_coords {
my ( $x, $y ) = @_;
my $ox = $x % $TILE_SIZE_CORE;
my $oy = $y % $TILE_SIZE_CORE;
if ($ox < 0) { $ox += $TILE_SIZE_CORE }
if ($oy < 0) { $oy += $TILE_SIZE_CORE }
my $tx = ($x - $ox) / $TILE_SIZE_CORE;
my $ty = ($y - $oy) / $TILE_SIZE_CORE;
my $ix = $ox + $BORDER_WIDTH;
my $iy = $oy + $BORDER_WIDTH;
return ( $tx, $ty, $ix, $iy );
}
# Converse of get_tile_coords
# Input (tx, ty, ix, iy). Return cell (x, y)
sub get_cell_coords {
my ( $tx, $ty, $ix, $iy ) = @_;
my $x = $TILE_SIZE_CORE * $tx + $ix - $BORDER_WIDTH;
my $y = $TILE_SIZE_CORE * $ty + $iy - $BORDER_WIDTH;
return ( $x, $y );
}
# See perlmonks.org, node_id: 1199987
# Inline this popcount function below
# sub popcount { sprintf('%b', shift) =~ tr/1// }
# ----------------------------------------------------------------
# ORGANISM
# Input a list of [ x, y ] coords
sub insert_cells {
my $self = shift;
for my $r (@_) { $self->setcell($r->[0], $r->[1], 1) }
}
# Used for verification and testing the state of the organism
sub count {
my $self = shift;
my $tiles = $self->{Tiles};
my $cnt = 0;
for my $sqt (values %{$tiles}) {
my $row = $sqt->{Row};
for my $iy ($BORDER_WIDTH .. $TILE_SIZE_MBD_M1) {
next unless $row->[$iy];
# $cnt += popcount($row->[$iy] & $BM_MIDDLE);
$cnt += sprintf('%b', $row->[$iy] & $BM_MIDDLE) =~ tr/1//;
}
}
return $cnt;
}
# Used for verification and testing the state of the organism
sub get_live_cells {
my $self = shift;
my $tiles = $self->{Tiles};
my @cells;
for my $sqt (values %{$tiles}) {
my $row = $sqt->{Row};
my $tx = $sqt->{Tx};
my $ty = $sqt->{Ty};
for my $iy ($BORDER_WIDTH .. $TILE_SIZE_MBD_M1) {
my $rowval = $row->[$iy];
next unless $rowval;
for my $ix ($BORDER_WIDTH .. $TILE_SIZE_MBD_M1) {
# next unless st_getcellval($row, $ix, $iy);
next unless $rowval & ( 1 << ($TILE_SIZE_FULL_M1 - $ix) );
push @cells,
[ $TILE_SIZE_CORE * $tx + $ix - $BORDER_WIDTH,
$TILE_SIZE_CORE * $ty + $iy - $BORDER_WIDTH ];
}
# my @biton = split //, sprintf($BM_FMT, $rowval & $BM_MIDDLE
+);
# for my $ix ( grep($biton[$_], 0 .. $#biton) )
# {
# push @cells,
# [ $TILE_SIZE_CORE * $tx + $ix - $BORDER_WIDTH,
# $TILE_SIZE_CORE * $ty + $iy - $BORDER_WIDTH ];
# }
}
}
sort { $a->[0] <=> $b->[0] || $a->[1] <=> $b->[1] } @cells;
}
sub get_neighbour {
my $self = shift;
my $sqt = shift;
my $i = shift;
unless ($sqt->{Neighbours}->[$i]) {
my $tx = $sqt->{Tx};
my $ty = $sqt->{Ty};
if ($i >= $NEIGH_TOP_RIGHT && $i <= $NEIGH_BOTTOM_RIGHT) { ++
+$tx }
if ($i >= $NEIGH_BOTTOM_RIGHT && $i <= $NEIGH_BOTTOM_LEFT) { ++
+$ty }
if ($i >= $NEIGH_BOTTOM_LEFT && $i <= $NEIGH_TOP_LEFT) { --
+$tx }
if ($i == $NEIGH_TOP_LEFT || $i <= $NEIGH_TOP_RIGHT) { --
+$ty }
my $tiles = $self->{Tiles};
my $k = pack 'i2', $tx, $ty;
unless (exists $tiles->{$k}) {
$tiles->{$k} = {
Row => [ (0) x $TILE_SIZE_FULL ],
Tx => $tx,
Ty => $ty,
Updateflags => 0,
Neighbours => [],
};
}
$sqt->{Neighbours}->[$i] = $tiles->{$k};
}
return $sqt->{Neighbours}->[$i];
}
# Alert the neighbour that its neighbour (the original tile) has chang
+ed
sub update_neighbour {
my $self = shift;
my $sqt = shift;
my $i = shift;
if ($self->get_neighbour($sqt, $i)->{Updateflags} == 0) {
push @{$self->{Modified}}, $self->get_neighbour($sqt, $i);
}
$self->get_neighbour($sqt, $i)->{Updateflags} |= 1 << ($i ^ 4);
}
# Update the relevant portions of the boundary (a 64-by-64 square
# with the central 60-by-60 square removed) by copying data from
# the interiors (the 60-by-60 central squares) of the neighbours.
# Only perform this copying when necessary.
# Note: alternatively: 32-by-32 with central 28-by-28.
sub update_boundary {
my $self = shift;
my $sqt = shift;
my $temp_modified = $self->{TempModified};
if ( $sqt->{Updateflags} & (1 << $NEIGH_TOP) ) {
my $n = $self->get_neighbour($sqt, $NEIGH_TOP);
$sqt->{Row}->[0] = ($n->{Row}->[$TILE_SIZE_CORE] & $BM_MIDDLE) |
+ ($sqt->{Row}->[0] & $BM_OUTER);
$sqt->{Row}->[1] = ($n->{Row}->[$TILE_SIZE_CORE_P1] & $BM_MIDDLE
+) | ($sqt->{Row}->[1] & $BM_OUTER);
}
if ( $sqt->{Updateflags} & (1 << $NEIGH_TOP_LEFT) ) {
my $n = $self->get_neighbour($sqt, $NEIGH_TOP_LEFT);
$sqt->{Row}->[0] = (($n->{Row}->[$TILE_SIZE_CORE] & $BM_MIDDLE)
+<< $TILE_SIZE_CORE) | ($sqt->{Row}->[0] & $BM_RIGHT);
$sqt->{Row}->[1] = (($n->{Row}->[$TILE_SIZE_CORE_P1] & $BM_MIDDL
+E) << $TILE_SIZE_CORE) | ($sqt->{Row}->[1] & $BM_RIGHT);
}
if ( $sqt->{Updateflags} & (1 << $NEIGH_TOP_RIGHT) ) {
my $n = $self->get_neighbour($sqt, $NEIGH_TOP_RIGHT);
$sqt->{Row}->[0] = (($n->{Row}->[$TILE_SIZE_CORE] & $BM_MIDDLE)
+>> $TILE_SIZE_CORE) | ($sqt->{Row}->[0] & $BM_LEFT);
$sqt->{Row}->[1] = (($n->{Row}->[$TILE_SIZE_CORE_P1] & $BM_MIDDL
+E) >> $TILE_SIZE_CORE) | ($sqt->{Row}->[1] & $BM_LEFT);
}
if ( $sqt->{Updateflags} & (1 << $NEIGH_BOTTOM) ) {
my $n = $self->get_neighbour($sqt, $NEIGH_BOTTOM);
$sqt->{Row}->[$TILE_SIZE_MBD] = ($n->{Row}->[$BORDER_WIDTH] & $B
+M_MIDDLE) | ($sqt->{Row}->[$TILE_SIZE_MBD] & $BM_OUTER);
$sqt->{Row}->[$TILE_SIZE_FULL_M1] = ($n->{Row}->[3] & $BM_MIDDLE
+) | ($sqt->{Row}->[$TILE_SIZE_FULL_M1] & $BM_OUTER);
}
if ( $sqt->{Updateflags} & (1 << $NEIGH_BOTTOM_LEFT) ) {
my $n = $self->get_neighbour($sqt, $NEIGH_BOTTOM_LEFT);
$sqt->{Row}->[$TILE_SIZE_MBD] = (($n->{Row}->[$BORDER_WIDTH] & $
+BM_MIDDLE) << $TILE_SIZE_CORE) | ($sqt->{Row}->[$TILE_SIZE_MBD] & $BM
+_RIGHT);
$sqt->{Row}->[$TILE_SIZE_FULL_M1] = (($n->{Row}->[3] & $BM_MIDDL
+E) << $TILE_SIZE_CORE) | ($sqt->{Row}->[$TILE_SIZE_FULL_M1] & $BM_RIG
+HT);
}
if ( $sqt->{Updateflags} & (1 << $NEIGH_BOTTOM_RIGHT) ) {
my $n = $self->get_neighbour($sqt, $NEIGH_BOTTOM_RIGHT);
$sqt->{Row}->[$TILE_SIZE_MBD] = (($n->{Row}->[$BORDER_WIDTH] & $
+BM_MIDDLE) >> $TILE_SIZE_CORE) | ($sqt->{Row}->[$TILE_SIZE_MBD] & $BM
+_LEFT);
$sqt->{Row}->[$TILE_SIZE_FULL_M1] = (($n->{Row}->[3] & $BM_MIDDL
+E) >> $TILE_SIZE_CORE) | ($sqt->{Row}->[$TILE_SIZE_FULL_M1] & $BM_LEF
+T);
}
if ( $sqt->{Updateflags} & (1 << $NEIGH_LEFT) ) {
my $n = $self->get_neighbour($sqt, $NEIGH_LEFT);
for my $i ($BORDER_WIDTH .. $TILE_SIZE_MBD_M1) {
$sqt->{Row}->[$i] = (($n->{Row}->[$i] & $BM_MIDDLE) << $TILE_
+SIZE_CORE) | ($sqt->{Row}->[$i] & $BM_RIGHT);
}
}
if ( $sqt->{Updateflags} & (1 << $NEIGH_RIGHT) ) {
my $n = $self->get_neighbour($sqt, $NEIGH_RIGHT);
for my $i ($BORDER_WIDTH .. $TILE_SIZE_MBD_M1) {
$sqt->{Row}->[$i] = (($n->{Row}->[$i] & $BM_MIDDLE) >> $TILE_
+SIZE_CORE) | ($sqt->{Row}->[$i] & $BM_LEFT);
}
}
$sqt->{Updateflags} = 0;
push @{$temp_modified}, $sqt;
}
# Advance the interior of the tile by one generation.
sub update_tile {
my $self = shift;
my $modified = $self->{Modified};
my $sqt = shift;
my ($update_flag, $neigh) = st_tiletick($sqt->{Row});
if ($update_flag) {
if ($sqt->{Updateflags} == 0) { push @{$modified}, $sqt }
$sqt->{Updateflags} |= 1 << $NUM_NEIGH;
}
for my $i (0 .. $NUM_NEIGH - 1) {
if ($neigh & (1 << $i)) { $self->update_neighbour($sqt, $i) }
}
}
sub tick {
my $self = shift;
my $modified = $self->{Modified};
my $temp_modified = $self->{TempModified};
while (@{$modified}) {
$self->update_boundary(pop @{$modified});
}
while (@{$temp_modified}) {
$self->update_tile(pop @{$temp_modified});
}
}
sub updatecell {
my $self = shift;
my $sqt = shift;
my $ix = shift;
my $iy = shift;
if ($sqt->{Updateflags} == 0) { push @{$self->{Modified}}, $sqt }
$sqt->{Updateflags} |= 1 << $NUM_NEIGH;
if ($iy <= $BORDER_WIDTH_P1) { $self->update_neighbour($sqt, $NEIGH
+_TOP) }
if ($iy >= $TILE_SIZE_CORE) { $self->update_neighbour($sqt, $NEIGH_
+BOTTOM) }
if ($ix <= $BORDER_WIDTH_P1) {
$self->update_neighbour($sqt, $NEIGH_LEFT);
if ($iy <= $BORDER_WIDTH_P1) { $self->update_neighbour($sqt, $NE
+IGH_TOP_LEFT) }
if ($iy >= $TILE_SIZE_CORE) { $self->update_neighbour($sqt, $NEI
+GH_BOTTOM_LEFT) }
}
if ($ix >= $TILE_SIZE_CORE) {
$self->update_neighbour($sqt, $NEIGH_RIGHT);
if ($iy <= $BORDER_WIDTH_P1) { $self->update_neighbour($sqt, $NE
+IGH_TOP_RIGHT) }
if ($iy >= $TILE_SIZE_CORE) { $self->update_neighbour($sqt, $NEI
+GH_BOTTOM_RIGHT) }
}
}
sub setcell {
my $self = shift;
my $x = shift;
my $y = shift;
my $state = shift;
my $tiles = $self->{Tiles};
my ( $tx, $ty, $ix, $iy ) = get_tile_coords($x, $y);
my $k = pack 'i2', $tx, $ty;
unless (exists $tiles->{$k}) {
$tiles->{$k} = {
Row => [ (0) x $TILE_SIZE_FULL ],
Tx => $tx,
Ty => $ty,
Updateflags => 0,
Neighbours => [],
};
}
st_setcellval($tiles->{$k}->{Row}, $ix, $iy, $state);
$self->updatecell($tiles->{$k}, $ix, $iy);
}
sub getcellval {
my $self = shift;
my $x = shift;
my $y = shift;
my $tiles = $self->{Tiles};
my ( $tx, $ty, $ix, $iy ) = get_tile_coords($x, $y);
my $k = pack 'i2', $tx, $ty;
exists $tiles->{$k} or return 0;
return st_getcellval( $tiles->{$k}->{Row}, $ix, $iy );
}
sub new {
my $class = shift;
my %init_self = ( Tiles => {}, Modified => [], TempModified => [] )
+;
bless \%init_self, $class;
}
1;
Along with an associated
tdumpxy.pl test program to help clarify the mapping:
# tdumpxy.pl - Test mapping of Cell x,y to Tile tx,ty
use strict;
use warnings;
use Organism;
for my $x ( -100 .. 100 ) {
for my $y ( -100 .. 100 ) {
my ( $tx, $ty, $ix, $iy ) = Organism::get_tile_coords($x, $y);
my ( $nx, $ny ) = Organism::get_cell_coords($tx, $ty, $ix, $iy);
warn "x=$x y=$y: tx=$tx ty=$ty ix=$ix iy=$iy: nx=$nx ny=$ny\n";
$x == $nx or die "oops x";
$y == $ny or die "oops y";
}
}
Updated: Changed popcount() function above based on How to do popcount (aka Hamming weight) in Perl (popcount References)
