Beefy Boxes and Bandwidth Generously Provided by pair Networks
laziness, impatience, and hubris
 
PerlMonks  

comment on

( [id://3333]=superdoc: print w/replies, xml ) Need Help??
Please excuse me if this has already been posted -- I searched Perlmonks for mention of this program, and I was surprised that it's not here (surely it must be here!). IF it is here, then my apologies; and in fact, if 'youse guys' can maybe turn this exercise into a GOLF I think the results might be very cool.

Anyway, I implemented CGoL using the old version 5.6.1 on our Unix boxes, but testing it with PuTTY I see that the `clear` command doesn't seem to work (strange...).

The code initializes the matrix from __DATA__, but you can delete the stuff after __DATA__ and just hand it an input pattern from <>.

One way to speed up this code is to allow two more states, called 'newborn' and 'dying'. Newborns, belonging to a transitional state, are not counted as 'alive' (so there are no spurious additional births), and dying cells can be marked but not yet removed from the board (so they can still contribute toward the overall game state for the current epoch). Finally, once all births and deaths are thus marked, another loop can iterate over the birthlist, setting their states to 'alive', and loop over the deathlist, setting their states to 'dead'. All that to avoid rebuilding the grid each time... is it worth the extra effort?
#!/usr/bin/perl -w use strict; =head1 life.pl name : life.pl desc : Conway's Game of Life syntax : life.pl [delay] SYNTAX This script implements CGoL. There is one optional runtime argument; namely, the delay between iterations ('epochs'). THEORY CGoL essentially is a cellular automaton. The playing grid is a 2D matrix of cells with 2 possible states: alive or dead. Cell state is dependent upon the 8 neighbors adjacent to the cell, and the following three rules: (1) A cell with exactly 3 live neighbors becomes alive. (2) A live cell with 2 or 3 live neighbors remains alive. (3) All other cells die. INITIAL GRID The starting pattern is specified in the __DATA__ section at the end of this script. If there are no lines after __DATA__, then input is read from stdin. The length of the first line determines the number of columns in the grid, and of course the number of lines determine the number of rows in the grid. Initial 'live' cells are denoted by x's; initial dead cells are anything else (internally, dead cells are identified by the space character, but the logic is tailored to treat anything 'not-alive' as dead). GRID CAVEAT The grid wraps around. This means cells on the boundary can affect other cells on opposite boundaries. =cut my $delay = shift || 1; my $alive = 'x'; my $dead = ' '; my @grid = (); my $rows = 0; my $cols = 0; # # Read the grid... # my @in = <DATA>; @in = <> unless @in; foreach( @in ) { chomp; my @cells = split( '', $_ ); my $col = 0; foreach( @cells ) { $grid[ $rows ][ $col ] = $_; $col++; } $cols = $col if $col > $cols; $rows++; } # # Now fill in the grid... # for( my $r=0; $r<$rows; $r++ ) { for( my $c=0; $c<$cols; $c++ ) { $grid[ $r ][ $c ] = $dead unless $grid[ $r ][ $c ]; } } print "$rows Rows, $cols Cols\n"; my $epochs = 0; # # Now loop forever! # { `clear`; &show; $epochs++; sleep $delay; my @newgrid = &copy( @grid ); for( my $r=0; $r<$rows; $r++ ) { for( my $c=0; $c<$cols; $c++ ) { my $cell = $grid[ $r ][ $c ]; my $neighbors = &countNeighbors( $r, $c ); # print "($r,$c) $cell => $neighbors\n"; # # If a cell has exactly 3 live neighbors, # then this is a live cell. # $newgrid[ $r ][ $c ] = $alive if $neighbors == 3; # # If a cell has 2 or 3 live neighbors, # then this cell remains alive if it is alive. # next if $neighbors == 2 || $neighbors == 3; # # rule: all other cells die. # $newgrid[ $r ][ $c ] = $dead; } } @grid = @newgrid; redo; } sub show { foreach( @grid ) { if ( $_ ) { my @row = @{$_}; print join( "", @row ); } print "\n"; } my $dashes = '-' x ($cols/2 - length( $epochs )); print "$dashes $epochs $dashes\n"; } sub copy { my @grid = @_; my @newgrid = (); for( my $r=0; $r<$rows; $r++ ) { for( my $c=0; $c<$cols; $c++ ) { $newgrid[ $r ][ $c ] = $grid[ $r ][ $c ]; } } return @newgrid; } sub countNeighbors { my ($r, $c) = @_; my $count = 0; $count += isAlive( $r-1, $c-1 ); $count += isAlive( $r-1, $c ); $count += isAlive( $r-1, $c+1 ); $count += isAlive( $r, $c-1 ); $count += isAlive( $r, $c+1 ); $count += isAlive( $r+1, $c-1 ); $count += isAlive( $r+1, $c ); $count += isAlive( $r+1, $c+1 ); return $count; } sub isAlive { my ($r, $c) = @_; return 1 if $grid[ $r ][ $c ] && $grid[ $r ][ $c ] eq $alive; return 0; } __DATA__ -first row- x xxx x last row

In reply to Conway's Game of Life by rje

Title:
Use:  <p> text here (a paragraph) </p>
and:  <code> code here </code>
to format your post, it's "PerlMonks-approved HTML":



  • Posts are HTML formatted. Put <p> </p> tags around your paragraphs. Put <code> </code> tags around your code and data!
  • Titles consisting of a single word are discouraged, and in most cases are disallowed outright.
  • Read Where should I post X? if you're not absolutely sure you're posting in the right place.
  • Please read these before you post! —
  • Posts may use any of the Perl Monks Approved HTML tags:
    a, abbr, b, big, blockquote, br, caption, center, col, colgroup, dd, del, div, dl, dt, em, font, h1, h2, h3, h4, h5, h6, hr, i, ins, li, ol, p, pre, readmore, small, span, spoiler, strike, strong, sub, sup, table, tbody, td, tfoot, th, thead, tr, tt, u, ul, wbr
  • You may need to use entities for some characters, as follows. (Exception: Within code tags, you can put the characters literally.)
            For:     Use:
    & &amp;
    < &lt;
    > &gt;
    [ &#91;
    ] &#93;
  • Link using PerlMonks shortcuts! What shortcuts can I use for linking?
  • See Writeup Formatting Tips and other pages linked from there for more info.
  • Log In?
    Username:
    Password:

    What's my password?
    Create A New User
    Domain Nodelet?
    Chatterbox?
    and the web crawler heard nothing...

    How do I use this?Last hourOther CB clients
    Other Users?
    Others about the Monastery: (2)
    As of 2024-07-20 00:02 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.