Beefy Boxes and Bandwidth Generously Provided by pair Networks
Problems? Is your data what you think it is?
 
PerlMonks  

comment on
( [id://3333]=superdoc: 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;
    }
}

[download]
#!/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;
    }
}

[download]

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

In reply to simple game of life by new hand by glycine

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


  • 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.
Log In?
Username:
Password:

What's my password?
Create A New User
Domain Nodelet?

www.com | www.net | www.org
Chatterbox?
and the web crawler heard nothing...

How do I use this? • Last hour • Other CB clients
Other Users?
Others imbibing at the Monastery: (4)
As of 2024-04-19 12:06 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    No recent polls found