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...
-
Are you posting in the right place? Check out Where do I post X? to know for sure.
-
Posts may use any of the Perl Monks Approved HTML tags. Currently these include the following:
<code> <a> <b> <big>
<blockquote> <br /> <dd>
<dl> <dt> <em> <font>
<h1> <h2> <h3> <h4>
<h5> <h6> <hr /> <i>
<li> <nbsp> <ol> <p>
<small> <strike> <strong>
<sub> <sup> <table>
<td> <th> <tr> <tt>
<u> <ul>
-
Snippets of code should be wrapped in
<code> tags not
<pre> tags. In fact, <pre>
tags should generally be avoided. If they must
be used, extreme care should be
taken to ensure that their contents do not
have long lines (<70 chars), in order to prevent
horizontal scrolling (and possible janitor
intervention).
-
Want more info? How to link
or How to display code and escape characters
are good places to start.
|
|