File Coverage

blib/lib/Algorithm/Genetic/Diploid/Gene.pm
Criterion Covered Total %
statement 24 24 100.0
branch 3 4 75.0
condition n/a
subroutine 8 8 100.0
pod 5 5 100.0
total 40 41 97.5


line stmt bran cond sub pod time code
1             package Algorithm::Genetic::Diploid::Gene;
2 2     2   11 use strict;
  2         4  
  2         68  
3 2     2   10 use Algorithm::Genetic::Diploid::Base;
  2         3  
  2         41  
4 2     2   10 use base 'Algorithm::Genetic::Diploid::Base';
  2         5  
  2         652  
5              
6             =head1 NAME
7              
8             Algorithm::Genetic::Diploid::Gene - a gene with an expressible function
9              
10             =head1 METHODS
11              
12             =over
13              
14             =item new
15              
16             Constructor takes named arguments, sets a default value of 1 for the weight
17              
18             =cut
19              
20             sub new {
21             shift->SUPER::new(
22 100     100 1 734 'weight' => 1,
23             @_,
24             );
25             }
26              
27             =item function
28              
29             The gene function is a subroutine ref that results in a gene product (representing some
30             component of fitness) based on environmental input
31              
32             =cut
33              
34             sub function {
35 5000     5000 1 5305 my $self = shift;
36 5000         10542 $self->make_function;
37             }
38              
39             =item express
40              
41             A gene is expressed based on environmental input, upon which a gene product is returned
42              
43             =cut
44              
45             sub express {
46 5000     5000 1 6998 my ( $self, $env ) = @_;
47 5000         11187 return $self->function->($env);
48             }
49              
50             =item mutate
51              
52             Re-weights the gene in proportion to the mutation rate
53              
54             =cut
55              
56             sub mutate {
57 6070     6070 1 11177 my ( $self, $func ) = @_;
58 6070         20016 my $mu = $self->experiment->mutation_rate;
59 6070         19246 my $scale = rand($mu) - $mu / 2 + 1;
60 6070         23736 my $weight = $self->weight;
61 6070         32478 $self->weight( $weight * $scale );
62 6070 50       14932 $self->function( $func ) if $func;
63 6070         27348 return $self;
64             }
65              
66             =item weight
67              
68             Getter and setter for the weight of this gene product in the total phenotype
69              
70             =cut
71              
72             sub weight {
73 27142     27142 1 69309 my $self = shift;
74 27142 100       61805 $self->{'weight'} = shift if @_;
75 27142         107918 return $self->{'weight'};
76             }
77              
78             =back
79              
80             =cut
81              
82             1;