Beefy Boxes and Bandwidth Generously Provided by pair Networks
Keep It Simple, Stupid
 
PerlMonks  

simple game of life by new hand

by glycine (Initiate)
on Sep 08, 2019 at 09:42 UTC ( #11105833=CUFP: print w/replies, xml ) Need Help??

hello! when I first read some things about game of life, it let me amazing. some days ago, suddenly, I find maybe I can make one by my self with perl! although there are a lot of game of life on the internet, wrote by Rust, c++, java... but I think it will be a interesting practice, so I write this :) ( Conway's Game of Life on the Wiki: Conway's Game of Life )

this code can't be expand to other rules of cell automata, and have a lot of pointless subroutine.

here is code:

new: after roboticus give me advice, I change the name of variables and subroutines, delete a bug, so, here is new version.

I know that using OOP is better, but I am still learning about this, um... I will try it...

#!/usr/bin/perl use strict; use warnings; use Getopt::Long; use Data::Dumper; ######################################################### #I use a hash for my board, store these live/light cell site #for example a key 7-2 mean there is a live cell at 7-2 site on the bo +ard #so, first I write a subroutine for light some cells, input a array re +ference #this array comtain a site list sub light_cell { my $live_cells = shift; my $board = shift; for my $f (@{$live_cells}) { $board->{$f} = 42; } } sub around_cells { my $site = shift; my $size = shift; my ($x,$y) = split '-',$site; my @cells_site; my $first = 42; for my $x_value ($x, $x+1, $x-1) { for my $y_value ($y, $y+1, $y-1) { if ($x_value > 0 and $y_value > 0 and $x_value <= $size an +d $y_value <= $size) { if ($first) { undef $first; next; } my $value = join '-',$x_value,$y_value; push @cells_site, $value; } } } return \@cells_site; } #then I write some subroutine for computing in every turns #the name of this subroutine is live_cells, it use 'for keys' to trave +rse all live cell(a key) #and use another subroutine, around_cells, to get cells around this ce +ll #finally create a new hash, use same strategy to store site #add 1 to value of every cells around this live cell,and calculate whi +ch cells will be light in next turn(return a array reference) #e.g., if value higher than 4, the cell should die sub live_cells { my $board = shift; my $size = shift; my %life; my @live_cells; for my $f (keys %{$board}) { my $sites = around_cells($f,$size); for my $add (@{$sites}) { if (not exists $life{$add}) { $life{$add} = 1 } else { $life{$add}++ } } } for my $n (keys %life) { if ($life{$n} < 4) { push @white,$n if $life{$n} == 3; push @white,$n if $life{$n} == 2 and exists $world->{$n}; } } return (\@live_cells,\%life); } #this subroutine control next turn coming, input board information int +o live cells #get live_cells list with array reference #then undef the board hash, use light_cell to set live cell in next tu +rn sub next_turn { my $board = shift; my $size = shift; my ($live_cells,$model) = live_cells($board,$size); undef %{$board}; #darkness light($live_cells,$board); return $model; } #print the board and now number of turns to screen sub show_board { my $size = shift; my $board = shift; for my $x (1...$size) { print $x,"\t"; for my $y (1...$size) { my $allo = join '-',$x,$y; if (exists $board->{$allo}) { print 'O ' } else { print '. ' } } print "\n" } } #only use for debug, you can use this to see how number change in the +board, these decide cell live/die sub show_model { my $size = shift; my $world = shift; for my $x (1...$size) { print $x,"\t"; for my $y (1...$size) { my $allo = join '-',$x,$y; if (exists $world->{$allo}) { print $world->{$allo},' ' } else { print '. ' } } print "\n" } print "\n" } #return a random integer sub rand_int { my $region = shift; my $out = int (rand $region); return $out; } #here work for create a random start condition before game start sub random_start_set { my $size = shift; my $number = shift; my %out; for my $f (1...$number) { my ($x,$y) = (rand_int($size),rand_int($size)); my $site = join '-',$x+1,$y+1; if (not exists $out{$site}) { $out{$site} = 42; } else { redo } } my @out = keys %out; print "number: ",scalar @out,"\n"; return \@out; } #compare two hashes, if they are same, return 1 sub hash_key_comp { my ($h1, $h2) = @_; my $equal = (keys %{$h1}) <=> (keys %{$h2}); if ($equal == 0) { for my $f (keys %{$h1}) { if (not exists $h2->{$f}) { return 0; } } } else { return 0 } return 1 } ######################################################### #here I set some options: -s for board size, -t for turns number, -w f +or live cells before game start #-w set sleep parameter between every turns, let user have time to dri +nk tea:) #-e times of restart game, e.g, -e 5 will let game run 5 times with sa +me set my %world; my $size = 10; my $turns = 5; my $creature = 25; my $speed = 0; my $exp = 1; GetOptions( 'size|s=i' => \$size, 'turn|t=i' => \$turns, 'live|w=i' => \$creature, 'speed|r=i' => \$speed, 'exp|e=i' => \$exp) or die $!; my $log; open $log,'>>','log_file' or die $!; #so now, it is work, and if same pattern exist on board over 3 turns, +program will automatically stop. for my $cen (1...$exp) { undef %world; my $live = random_start_set($size,$creature); light_cell($live,\%world); show_board($size,\%world); print "\n\t\t0\n\n"; sleep $speed; my @pre; for (1...$turns) { my $model = twilight(\%world,$size); push @pre, $model; show_world($size,\%world); print "\n\t\t$_\n\n"; if ($#pre > 3) { my $stop = hash_key_comp($pre[0],$pre[-1]); if ($stop == 1) { print $log $cen,"\t",scalar keys %{$pre[0]},"\n"; last; } shift @pre; } sleep $speed; } }
#!/usr/bin/perl use strict; use warnings; use Getopt::Long; use Data::Dumper; ######################################################### #I use a hash for my board, store these live/light cell site #for example a key 7-2 mean there is a live cell at 7-2 site on the bo +ard #so, first I write a subroutine for light some cells, input a array re +ference #this array comtain a site list sub light { my $sparkle = shift; my $world = shift; for my $f (@{$sparkle}) { $world->{$f} = 42; } } #then I write some subroutine for computing in every turns #the name of this subroutine is tomorrow, it use 'for keys' to travers +e all live cell(a key) #and use another subroutine, friends, to get cells around this cell #finally create a new hash, use same strategy to store site #add 1 to value of every cells around this live cell #then undef the board hash, use hash create before and rules of game o +f life #to make sure how many cells should be light (return a array reference +) #e.g., if value higher than 4, the cell should die sub friends { my $site = shift; my $size = shift; my ($x,$y) = split '-',$site; my @friendship; my $first = 42; for my $x_value ($x, $x+1, $x-1) { for my $y_value ($y, $y+1, $y-1) { if ($x_value > 0 and $y_value > 0 and $x_value <= $size an +d $y_value <= $size) { if ($first) { undef $first; next; } my $value = join '-',$x_value,$y_value; push @friendship, $value; } } } return \@friendship; } sub tomorrow { my $world = shift; my $size = shift; my %life; my @white; for my $f (keys %{$world}) { my $magic = friends($f,$size); for my $add (@{$magic}) { if (not exists $life{$add}) { $life{$add} = 1 } else { $life{$add}++ } } } for my $n (keys %life) { if ($life{$n} < 4) { push @white,$n if $life{$n} == 3; push @white,$n if $life{$n} == 2 and exists $world->{$n}; } } return (\@white,\%life); } sub twilight { my $world = shift; my $size = shift; my ($shine,$model) = tomorrow($world,$size); undef %{$world}; #darkness light($shine,$world); return $model; } #this subroutine work for print conditions of board to screen sub show_world { my $size = shift; my $world = shift; for my $x (1...$size) { print $x,"\t"; for my $y (1...$size) { my $allo = join '-',$x,$y; if (exists $world->{$allo}) { print 'O ' } else { print '. ' } } print "\n" } } sub show_model { my $size = shift; my $world = shift; for my $x (1...$size) { print $x,"\t"; for my $y (1...$size) { my $allo = join '-',$x,$y; if (exists $world->{$allo}) { print $world->{$allo},' ' } else { print '. ' } } print "\n" } print "\n" } #here work for create a random start condition before game start #I isolate the part of rand from subroutine sub lucky { my $region = shift; my $out = int (rand $region); return $out; } sub magical_map { my $size = shift; my $number = shift; my %out; for my $f (1...$number) { my ($x,$y) = (lucky($size),lucky($size)); my $site = join '-',$x+1,$y+1; if (not exists $out{$site}) { $out{$site} = 42; } else { redo } } my @out = keys %out; print "number: ",scalar @out,"\n"; return \@out; } #this subroutine just let me make main part more clean sub hash_key_comp { my ($h1, $h2) = @_; my $equal = (keys %{$h1}) <=> (keys %{$h2}); if ($equal == 0) { for my $f (keys %{$h1}) { if (not exists $h2->{$f}) { return 0; } } } else { return 0 } return 1 } ######################################################### #here I set some options: -s for board size, -t for turns number, -w f +or live cells before game start #-w set sleep parameter between every turns, let user have time to dri +nk tea:) my %world; my $size = 10; my $turns = 5; my $creature = 25; my $speed = 0; my $exp = 1; GetOptions( 'size|s=i' => \$size, 'turn|t=i' => \$turns, 'live|w=i' => \$creature, 'speed|r=i' => \$speed, 'exp|e=i' => \$exp) or die $!; #so now, it is work, and if same pattern exist on board over 3 turns, +program will automatically stop. my $log; open $log,'>>','log_file' or die $!; my $today = qx@date@; for my $cen (1...$exp) { my $live = magical_map($size,$creature); light($live,\%world); show_world($size,\%world); print "\n\t\t0\n\n"; sleep $speed; my @pre; for (1...$turns) { my $model = twilight(\%world,$size); push @pre, $model; show_world($size,\%world); print "\n\t\t$_\n\n"; if ($#pre > 3) { my $stop = hash_key_comp($pre[0],$pre[-1]); if ($stop == 1) { print $log $cen,"\t",scalar keys %{$pre[0]},"\n"; last; } shift @pre; } sleep $speed; } }

thanks you for read this! p.s., I try to use readmore, but I don't know it if work in preview...

Replies are listed 'Best First'.
Re: simple game of life by new hand
by roboticus (Chancellor) on Sep 09, 2019 at 20:53 UTC

    glycine:

    Just a few random notes on your implementation of Life:

    In order to make code readable, naming is important. I found your code a little more difficult to understand than necessary, due to your subroutine names. If you revisit your program a few years from now, you may find the same difficulty. While having "interesting" names can be fun when programming is your hobby, it will be less so when you start coding with other people. Ideally, when you're reading code, you'd know pretty much what a subroutine does (in context) when you see the name of it. Once I read the implementation of magical_map() and lucky() and saw how they were used, I could tell what they were for. But that cost an extra couple of minutes.

    You might want to read about object-oriented programming in perl, too. You're passing $world as a parameter to several functions, and in some cases that's a clue that you might have a natural class you could use. I'd consider making a World class, and then make light(), tomorrow(), twilight() and show_world() member functions for the class. Then you can make a constructor for your class that puts the size and cells in a hash so you don't have to pass the $size around all the time, too.
    Something like:

    { package World; # Build a brand new world sub new { my ($class, $size) = @_; return bless { size=>$size, cells=>{ } }, $class; } sub light { my $world = shift; my $sparkle = shift; . . . } sub tomorrow { my $world = shift; my $size = $world->{size}; # Don't need to pass it as an arg! . . . } sub show_world { my $world = shift; my $size = $world->{size}; . . . } }

    Then you can use it like this:

    my $world; for my $cen (1...$exp) { $world = World->new(); my $live = magical_map($size, $creature); $world->light($live); $world->show_world(); . . . }

    Now that I look at it a bit more, I'd suggest making magical_map be your constructor function, and pulling it into your class, too.

    You don't use show_model() anywhere, so you may want to delete it. You don't use $today, either, so you could delete that, too. You nearly never use your log file, so you might consider either deleting it, or using it a bit more. In fact, you could add the date to the $log file, along with the parameters you used when you ran it, if you cared to do so.

    Finally, I also found a bug in your code: When you're using the "-exp" option to do multiple life runs, the final result of the previous run is mixed in with the new initial board. You can fix it by clearing %world somewhere before calling light() the first time. I'd just do %world=(); immediately after the top-level for() statement.

    Overall, it's a nifty little program. It's always interesting to me to see how other people approach a task I'm already familiar with. Sometimes you can offer helpful suggestions, and sometimes you can learn new ways to do things. You used a list of strings to encode the active cells, which is interesting in that it can let you have arbitrary board sizes without having to allocate a large rectangular array.

    One thing I've seen in various Life implementations which you could try is to make the playing surface a "torus" such that the top and bottom are stitched together, as is the left and right border. That way, if you have a glider show up, it can fly off one border and have it wrap around and come in on the opposite side. To do so, is just a simple modification of your friends() function.

    ...roboticus

    When your only tool is a hammer, all problems look like your thumb.

      you are right, I had changed the name of subroutines and variables. and qx/date/ actually useless... thank you find the bug!

      I'm still learning about OOP perl, thank you for indicate this is good example to use OOP, I will rewrite it after.

      circular marginal is a interesting idea! when you find some big/beautiful pattern the wall is so annoying. infinite board maybe a good choice, but it need a dynamic display...

      have a nice day :)
Re: simple game of life by new hand
by roboticus (Chancellor) on Sep 08, 2019 at 22:29 UTC

    glycine:

    Neat! I'll have to play with it a little bit. I have a couple minor comments about your post. (Not your code yet, as I haven't looked it over yet.)

    First: thanks for using code tags, but you only need code tags at the *start* and *end* of each chunk of code. That way, a multiline chunk of code will get a "download" link, making it easier for people to get your code to try it out. Something like this:

    <code>
    sub foo {
    print "hi!\n";
    }

    foo();
    </code>

    Doing so will make your code look like this:

    sub foo { print "hi!\n"; } foo();

    Second: I've tried the readmore tags on a "top level" post like you did, and found that they don't really do much at this level. It seems that they're more useful for responses.

    I'll post a few notes for you after I've tried your code and looked it over.

    ...roboticus

    When your only tool is a hammer, all problems look like your thumb.

      I've tried the readmore tags on a "top level" post like you did, and found that they don't really do much at this level.

      Actually they're really important at the top level, because they have effect when viewing the section, in this case Cool Uses for Perl.

      I reckon we are the only monastery ever to have a dungeon stuffed with 16,000 zombies.

      thanks for your help! I had modified this article. I have no knowledge about html... I am so confuse, I even write a script to finish this stupid operator... p.s., about readmore, I use it just because I think my code is too long to exist at page.

Re: simple game of life by new hand
by eyepopslikeamosquito (Chancellor) on Sep 10, 2019 at 20:15 UTC
Re: simple game of life by new hand
by bliako (Vicar) on Sep 12, 2019 at 08:43 UTC

    glycine, I second roboticus's suggestion for converting the data structures of your program to objects. (btw your first program complains about undeclared variables).

    Your choice of the game of life as a starting application is good. It opens up a lot of possibilities - all realised through Perl and CPAN modules:

    • Explore Curses and Term::Animation as a way to draw on text-based terminals. See for example my favourite: Ascii Acquarium by robobunny.
    • Explore drawing your game of life output onto a series of png/jpeg files using GD which you can then put together as an animation video or write directly to an animated GIF using GD::Image::AnimatedGif
    • Explore parallelism by creating an asynchronous game of life, as in Asynchronous_cellular_automaton . For this you can use Perl's threads or use a module such as MCE which also offers a nice way to share data between your threads using MCE::Shared. The author marioroy is regularly in the Monastery.
    • Convert your script to CGI (using CGI or modern -- which may not work on basic free-hosting sites -- alternatives CGI::Alternatives) and host it to a free web-hosting server for anyone to use.

    bw, bliako

    edit: removed unwanted underline

Log In?
Username:
Password:

What's my password?
Create A New User
Node Status?
node history
Node Type: CUFP [id://11105833]
Approved by haukex
Front-paged by haukex
help
Chatterbox?
and the web crawler heard nothing...

How do I use this? | Other CB clients
Other Users?
Others chanting in the Monastery: (9)
As of 2019-09-17 10:34 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?
    The room is dark, and your next move is ...












    Results (207 votes). Check out past polls.

    Notices?