So close...

BioNrd has asked for the wisdom of the Perl Monks concerning the following question:

Ok Monks...

I have updated the code with some comments. I hope that helps with the interpretation. I am sorry about that. It is clear in my mind...but none of you are in there to figure out what this garbage means.

#Randomly generate a population of plants, and breeds and dies. is the
+ purpose of this mess...
use Data::Dumper;
use warnings;
$popCt=1;
$seed = 20;
$germrate = .5;
$removal = 15;
$iteration = 20;

for (1 .. $popCt) 
{
    my ($refToArrA, $refToArrB, $refToArrC, $refToArrD) = makeArrays()
+; #creates a list of individuals, and chormosomes
        
    $counter++;
    &gener( $refToArrA, $refToArrB, $refToArrC, $refToArrD ); #creates
+ the storage hash
    
#    print Data::Dumper->Dumpxs([\%HoH], [q{*HoH}]);
}

for (1 .. $iteration) {
&births();
&death();
}

print Data::Dumper->Dumpxs([\%HoH], [q{*HoH}]);

#no work is needed here, this works like I want
sub makeArrays
{


    $lower = 10;

    $upper = 20;
    
    
    my @chroma;
    my @chromb;
    my $ranpop;
    
    $ranpop = int rand($upper - $lower + 1) + $lower;
    my @arrA = ( 1 .. $ranpop );
    my @arrD = (1 .. $ranpop );

    my $limiter = 50;
    my @holda;
    my @holdb;
    while ($ranpop) 
    {
        my $genea = int rand ($limiter);
        push(@holda, $genea);    
        my $geneb = int rand ($limiter);
        push(@holdb, $geneb);
        $ranpop--;
    }
    my @arrB = ( @holda );
    my @arrC = ( @holdb );
    return \@arrA, \@arrB, \@arrC, \@arrD;
}
#this is also working
sub gener
{
    my ( $refToArrA, $refToArrB, $refToArrC, $refToArrD ) = @_;
    my @newind = @$refToArrA;
    my @newchroma = @$refToArrB;
    my @newchromb = @$refToArrC;
    my @newholder = @$refToArrD;
    for my $pop ( 1 .. $popCt )
    {
        $HoH{$counter} =
    {
        holder => [@newholder],
        individual  => [ @newind ],
        chromasome1 => [ @newchroma ],
        chromasome2 => [ @newchromb ],
    };
    }
}

sub births {
    my @holder =  @{$HoH{$counter}{'holder'}};
    my @ind = @{$HoH{$counter}{'individual'}};
    my @chroma = @{$HoH{$counter}{'chromasome1'}};
    my @chromb = @{$HoH{$counter}{'chromasome2'}};


    my $random = int rand $seed;    #randomly generate a number of see
+d that will be made in 1 generation            
    my $birth = int $random * $germrate; #only some of those seeds wil
+l germinate (survive)
    for (1 .. $birth) {
    
        srand;
        my $ender = $holder[$#holder];
        
        my $ranmom = (int rand $ender);
               #Picking the chroma and b from mom and dad to later rec
+ombine to make a seedling (offspring/new plant)
        my $moma = $chroma[$ranmom];
        my $momb = $chromb[$ranmom];

        my $randad = (int rand $ender);
        my $dada = $chroma[$randad];
        my $dadb = $chromb[$randad];
            
        $ender++;
        push @ind, $ender; #add new seedling to list
        push @holder, $ender; #this is explained below
        
#this creates a new seedling, with genetic material from mother and fa
+ther plants

        my $selector = int(rand(2)) + 1;
        if ($selector == 1) {    
                 push @chroma, $dada;
                     push @chromb, $momb;
        } else {
             push @chroma, $moma;
                     push @chromb, $dadb;
        }
    }
        
              #here I update the hash to keep everything straight.
                $HoH{$counter}{'holder'} = [@holder];
        $HoH{$counter}{'chromasome1'} = [@chroma];
        $HoH{$counter}{'chromasome2'} = [@chromb];
        $HoH{$counter}{'individual'} = [@ind];
}




sub death {
    my @holder = @{$HoH{$counter}{'holder'}};
    my @ind = @{$HoH{$counter}{'individual'}};
    my @chroma = @{$HoH{$counter}{'chromasome1'}};
    my @chromb = @{$HoH{$counter}{'chromasome2'}};

       #Randomly select a number of individuals to be removed from the
+ population
    my $bottle = int rand $removal;
    

#select a list of individuals from the holder list...
#I added this list b/c the ind list tends to get out of order...
#and later in the code I needed a list in order...so I guess not sure.
    for ( 1 .. $bottle ) {
        ($ranpop = splice(@holder, int rand(@holder), 1));
        push @killed, $ranpop;
#I now have a list of killed plants
    }
#This is picking the last value in the holder 
#to then create a new holder list 
#with the correct number of elements as plants that survive
    my $lastval = $holder[$#holder];
    @holder = (1 .. $lastval);
    

#Here I need to remove the killed plants from the chroma
#and chromb lists otherwise they are in the list and do not
#have a corresponding individual which was already removed above.
#ie. (the list shifts out of place).
#I need to maintain IND1-chroma1-chromb1, orentation in the  lists tha
+t I have.
#There maybe a better way to do this...but this is how I tried to atta
+ck the problem 

    while (@killed) {
        my $lastkill = $killed[$#killed];
        my $removed = $lastkill - 1;

        splice (@chroma, $removed, 1);
        splice (@chromb, $removed, 1);
        splice (@ind, $removed, 1);
#This is where the problem is
#the lists somehow get out of sync, and I am splicing in the 
#wrong place...

        pop @killed;
    }
    $HoH{$counter}{'holder'} = [@holder];
    $HoH{$counter}{'chromasome1'} = [@chroma];
    $HoH{$counter}{'chromasome2'} = [@chromb];
    $HoH{$counter}{'individual'} = [@ind];
}
[download]

This runs...and forgive me for not using strict I still can't understand it (it really would help me I gotta figure I am trying honest I am)...BUT! I can not have all those undef's in output. They need to be actual values.

I think (big assumption) that it all boils down to the splice at the end of sub death. As the population changes (birth and death) the splice point becomes nonvalid for some references, which I am assuming creates the undef.

I have tried other options to try to shift the reference to the end of the ref and pop it or to the front and shift it. I cant get it to work properly no matter what I try.

Thanks for anything anyone can offer!

Comment on So close... Download Code

Replies are listed 'Best First'.
Re: So close... by moritz (Cardinal) on Nov 07, 2007 at 22:22 UTC
Your code is quite hard to read, partly because you name the variables after the kind of data structure they hold. It is easier to read if you name them according to what they mean. When I execute your code, I get warnings like this: `splice() offset past end of array at foo.pl line 146. splice() offset past end of array at foo.pl line 147. splice() offset past end of array at foo.pl line 158.` [download] (line numbers may differ from yours a bit). It basically means that you try to delete an array element that doesn't exist. Which means that at some point the logic that calculates the index `$removed` is incorrect. Maybe you could just write a few lines of comment to each function to describe in your own words what it should do, then we can compare that to what it does. A few suggestions regarding your code: sub makeArrays { $lower = 10; $upper = 20; my @chroma; my @chromb; my $ranpop; $ranpop = int rand($upper - $lower + 1) + $lower; # @arrA and @arrD hold the same values, and # aren't modified - why do you need them both? # what is their purpose? my @arrA = ( 1 .. $ranpop ); my @arrD = (1 .. $ranpop ); my $limiter = 50; # you can write that shorter: # my @holda = map { int rand($limiter)} 1 .. $randpop; # my @holdb = map { int rand($limiter)} 1 .. $randpop; my @holda; my @holdb; while ($ranpop) { my $genea = int rand ($limiter); push(@holda, $genea); my $geneb = int rand ($limiter); push(@holdb, $geneb); $ranpop--; } # there's no need to copy these arrays # you can return \@holda and \@holdb directly. my @arrB = ( @holda ); my @arrC = ( @holdb ); return \@arrA, \@arrB, \@arrC, \@arrD; } [download] You tend to create way too many unnecessary variables that do nothing but clutter up your code (and possibly slow it down): `my $childa = $dada; my $childb = $momb; push @chroma, $childa; push @chromb, $childb;` [download] you can write that as `push @chroma, $dada; push @chromb, $momb;` [download]	[reply] [d/l] [select]
Re: So close... by toolic (Bishop) on Nov 07, 2007 at 22:16 UTC
I do not know the solution to your problem, but I added a print to your death sub: `print "removed=$removed, ", scalar @chroma, "\n"; splice (@chroma, $removed, 1);` [download] This gives you more info about why you get the splice warnings. You can also add `use diagnostics;` which explains your splice warning in more detail: `splice() offset past end of array at foo.pl line 154 (#1) (W misc) You attempted to specify an offset that was past the end +of the array passed to splice(). Splicing will instead commence at th +e end of the array, rather than past it. If this isn't what you want, tr +y explicitly pre-extending the array by assigning $#array = $offset. + See perlfunc/splice.` [download] Hope this helps.	[reply] [d/l] [select]
Re: So close... by GrandFather (Saint) on Nov 11, 2007 at 08:52 UTC
I may have completely misunderstood what you are trying to do with this code, but if what I think you are doing is near enough right then you would be much better to use an array of hash than your current data structure. Consider: use strict; use warnings; use constant popCt => 10; use constant seed => 20; use constant germrate => .5; use constant removal => 8; use constant iterations => 20; main (); sub main { my @garden; my $id = 1; # Create first generation push @garden, individual (\$id) for 1 .. popCt; for ( 1 .. iterations ) { # Process a generation births (\$id, \@garden); death (\@garden); } print "$_->{id}: $_->{chrom1}, $_->{chrom1}\n" for @garden; } sub individual { my ($id, $chrom1, $chrom2) = @_; use constant limiter => 50; $chrom1 = int rand(limiter) unless defined $chrom1; $chrom2 = int rand(limiter) unless defined $chrom2; return {chrom1 => $chrom1, chrom2 => $chrom2, id => $$id++}; } sub births { my ($id, $garden) = @_; my $birth = germrate * rand seed; my $parents = @$garden; for ( 1 .. $birth ) { my $ranmom = int rand $parents; my $mom1 = $garden->[$ranmom]{chrom1}; my $mom2 = $garden->[$ranmom]{chrom2}; my $randad = int rand $parents; my $dad1 = $garden->[$randad]{chrom1}; my $dad2 = $garden->[$randad]{chrom2}; # Creates new seedling with genes from parents plants if (int rand 2) { push @$garden, individual ($id, $dad1, $mom2); } else { push @$garden, individual ($id, $mom1, $dad2); } } } sub death { my ($garden) = @_; # Generate number of individuals to remove my $remove = int rand removal; # Avoid killing more than half the population $remove = @$garden / 2 if $remove >= @$garden / 2; splice @$garden, int rand (@$garden), 1 for 1 .. $remove; } [download] Prints (for one run): `1: 44, 44 26: 32, 32 40: 44, 44 46: 44, 44 50: 44, 44 55: 6, 6 58: 44, 44 61: 6, 6 66: 6, 6 68: 44, 44 69: 6, 6 70: 6, 6 71: 6, 6 72: 6, 6 73: 6, 6 75: 32, 32 79: 6, 6 80: 6, 6 81: 6, 6 83: 6, 6 84: 44, 44 85: 32, 32 86: 6, 6 88: 6, 6` [download] Note that I tweaked the constants a little and avoided killing off the entire population which is somewhat different than my understanding of your original code, but makes for a more interesting outcome in most cases. Perl is environmentally friendly - it saves trees	[reply] [d/l] [select]
Re: So close... by BioNrd (Monk) on Nov 08, 2007 at 14:39 UTC
I think I fixed my problem. You both were right in that it was splicing past the last element. I figured out why. It had to do with this line of code. `my $lastval = $holder[$#holder]; @holder = (1 .. $lastval);` [download] The last element in the array was not the length of the array!!!! Therefore it was creating a new array that was too long...and splicing on that the next generation!!! `$num_of_elements = scalar @holder; @holder = (1 .. $num_of_elements);` [download] fixes the problem! WOW this is a great feeling having fixed it! Is this how you monks feel every day?	[reply] [d/l] [select]