Algorithm-Evolutionary-Simple

 view release on metacpan or  search on metacpan

lib/Algorithm/Evolutionary/Simple.pm  view on Meta::CPAN

}

sub single_generation {
  my $population = shift || croak "No population";
  my $fitness_of = shift || croak "No fitness cache";
  my $total_fitness = shift;
  if ( !$total_fitness ) {
    map( $total_fitness += $fitness_of->{$_}, @$population);
  }
  my $population_size = @{$population};
  my @best = rnkeytop { $fitness_of->{$_} } 2 => @$population; # Extract elite
  my @reproductive_pool = get_pool_roulette_wheel( $population, $fitness_of, 
						   $population_size, $total_fitness ); # Reproduce
  my @offspring = produce_offspring( \@reproductive_pool, $population_size - 2 ); #Obtain offspring
  unshift( @offspring, @best ); #Insert elite at the beginning
  @offspring; # return
}

"010101"; # Magic true value required at end of module
__END__

=head1 NAME

Algorithm::Evolutionary::Simple - Run a simple, canonical evolutionary algorithm in Perl

lib/Algorithm/Evolutionary/Simple.pm  view on Meta::CPAN

  use Algorithm::Evolutionary::Simple qw( random_chromosome max_ones max_ones_fast
					get_pool_roulette_wheel get_pool_binary_tournament produce_offspring single_generation);

  my @population;
  my %fitness_of;
  for (my $i = 0; $i < $number_of_strings; $i++) {
   $population[$i] = random_chromosome( $length);
   $fitness_of{$population[$i]} = max_ones( $population[$i] );
  }

  my @best;
  my $generations=0;
  do {
    my @pool;
    if ( $generations % 2 == 1 ) {
      get_pool_roulette_wheel( \@population, \%fitness_of, $number_of_strings );
    } else {
     get_pool_binary_tournament( \@population, \%fitness_of, $number_of_strings );
    }
    my @new_pop = produce_offspring( \@pool, $number_of_strings/2 );
    for my $p ( @new_pop ) {
        if ( !$fitness_of{$p} ) {
	   $fitness_of{$p} = max_ones( $p );
	}
    }
    @best = rnkeytop { $fitness_of{$_} } $number_of_strings/2 => @population;
    @population = (@best, @new_pop);
    print "Best so far $best[0] with fitness $fitness_of{$best[0]}\n";
  } while ( ( $generations++ < $number_of_generations ) and ($fitness_of{$best[0]} != $length ));


=head1 DESCRIPTION

Assorted functions needed by an evolutionary algorithm, mainly for demos and simple clients.


=head1 INTERFACE 

=head2 random_chromosome( $length )

lib/Algorithm/Evolutionary/Simple.pm  view on Meta::CPAN

Faster implementation of max_ones.

=head2 spin($wheel, $slots )

Mainly for internal use, $wheel has the normalized probability, and
  $slots the number of individuals to return.

=head2 single_generation( $population_arrayref, $fitness_of_hashref )

Applies all steps to arrive to a new generation, except
evaluation. Keeps the two best for the next generation.

=head2 get_pool_roulette_wheel( $population_arrayref, $fitness_of_hashref, $how_many_I_need )

Obtains a pool of new chromosomes using fitness_proportional selection


=head2 get_pool_binary_tournament( $population_arrayref, $fitness_of_hashref, $how_many_I_need )

Obtains a pool of new chromosomes using binary tournament, a greedier method.

script/simple-EA.pl  view on Meta::CPAN

  $population[$i] = random_chromosome( $length);
  $fitness_of{$population[$i]} = max_ones( $population[$i] );
}

my $get_pool;
if ( $pool eq "roulette" ) {
  $get_pool = \&get_pool_roulette_wheel;
}   else {
  $get_pool = \&get_pool_binary_tournament;
}
my @best;
my $generations=0;
do {
    my @pool = $get_pool->( \@population, \%fitness_of, $number_of_strings );
    my @new_pop = produce_offspring( \@pool, $number_of_strings/2 );
    for my $p ( @new_pop ) {
	if ( !$fitness_of{$p} ) {
	    $fitness_of{$p} = max_ones( $p );
	}
    }
    @best = rnkeytop { $fitness_of{$_} } $number_of_strings/2 => @population;
    @population = (@best, @new_pop);
    print "Best so far $best[0] with fitness $fitness_of{$best[0]}\n";	 
} while ( ( $generations++ < $number_of_generations ) and ($fitness_of{$best[0]} != $length ));



__END__

=head1 NAME

simple-EA.pl - A simple evolutionary algorithm that uses the functions in the library

t/01.functions.t  view on Meta::CPAN

is ( scalar( @new_pop), $number_of_strings, "New population generation");

map( $fitness_of{$_}?$fitness_of{$_}:($fitness_of{$_} = max_ones( $_)), @new_pop );
$total_fitness = 0;
map( $total_fitness += $fitness_of{$_}, @new_pop );
throws_ok { single_generation() } qr/No/, "No population exception";
throws_ok { single_generation( \@new_pop ) } qr/fitness/, "No fitness exception";

my @newest_pop = single_generation( \@new_pop, \%fitness_of, $total_fitness );
my @old_best = rnkeytop { $fitness_of{$_} } 1 => @new_pop; # Extract elite
map( $fitness_of{$_}?$fitness_of{$_}:($fitness_of{$_} = max_ones( $_)), @newest_pop );
my @new_best = rnkeytop { $fitness_of{$_} } 1 => @newest_pop; # Extract elite
is ( $fitness_of{$new_best[0]} >= $fitness_of{$old_best[0]}, 1, 
     "Improving fitness $fitness_of{$new_best[0]} >= $fitness_of{$old_best[0]}" );

throws_ok { get_pool_binary_tournament() } qr/No/, "Population check";
throws_ok { get_pool_binary_tournament(\@population) } qr/stuff/, "Fitness check";
throws_ok { get_pool_binary_tournament(\@population, \%fitness_of) } qr/population/, "Population size check";
@pool = get_pool_binary_tournament( \@population, \%fitness_of, $number_of_strings );

is ( scalar( @pool ), $number_of_strings, "Pool generation" );

@new_pop = produce_offspring( \@pool, $number_of_strings );