AI-Genetic-Pro
view release on metacpan - search on metacpan
view release on metacpan or search on metacpan
NAME
AI::Genetic::Pro - Efficient genetic algorithms for professional
purpose with support for multiprocessing.
SYNOPSIS
use AI::Genetic::Pro;
sub fitness {
my ($ga, $chromosome) = @_;
return oct('0b' . $ga->as_string($chromosome));
}
sub terminate {
my ($ga) = @_;
my $result = oct('0b' . $ga->as_string($ga->getFittest));
return $result == 4294967295 ? 1 : 0;
}
my $ga = AI::Genetic::Pro->new(
-fitness => \&fitness, # fitness function
-terminate => \&terminate, # terminate function
-type => 'bitvector', # type of chromosomes
-population => 1000, # population
lib/AI/Genetic/Pro.pm view on Meta::CPAN
_init
));
#=======================================================================
# Additional modules
use constant STORABLE => 'Storable';
use constant GD => 'GD::Graph::linespoints';
#=======================================================================
my $_Cache = { };
my $_temp_chromosome;
#=======================================================================
sub new {
my ( $class, %args ) = ( shift, @_ );
#-------------------------------------------------------------------
my %opts = map { if(ref $_){$_}else{ /^-?(.*)$/o; $1 }} @_;
my $self = bless \%opts, $class;
#-------------------------------------------------------------------
$AI::Genetic::Pro::Array::Type::Native = 1 if $self->native;
#-------------------------------------------------------------------
lib/AI/Genetic/Pro/Chromosome.pm view on Meta::CPAN
package AI::Genetic::Pro::Chromosome;
$AI::Genetic::Pro::Chromosome::VERSION = '1.009';
use warnings;
use strict;
use List::Util qw(shuffle first);
use List::MoreUtils qw(first_index);
use Tie::Array::Packed;
#use Math::Random qw(random_uniform_integer);
#=======================================================================
sub new {
my ($class, $data, $type, $package, $length) = @_;
my @genes;
tie @genes, $package if $package;
if($type eq q/bitvector/){
#@genes = random_uniform_integer(scalar @$data, 0, 1); # this is fastest, but uses more memory
@genes = map { rand > 0.5 ? 1 : 0 } 0..$length; # this is faster
#@genes = split(q//, unpack("b*", rand 99999), $#$data + 1); # slow
}elsif($type eq q/combination/){
lib/AI/Genetic/Pro/Crossover/Distribution.pm view on Meta::CPAN
random_uniform_integer
random_normal
random_beta
random_binomial
random_chi_square
random_exponential
random_poisson
);
use List::MoreUtils qw(first_index);
#=======================================================================
sub new {
my ($class, $type, @params) = @_;
bless {
type => $type,
params => \@params,
}, $class;
}
#=======================================================================
sub run {
my ($self, $ga) = @_;
my ($chromosomes, $parents, $crossover) = ($ga->chromosomes, $ga->_parents, $ga->crossover);
my ($fitness, $_fitness) = ($ga->fitness, $ga->_fitness);
my $high = scalar @{$chromosomes->[0]};
my @children;
#-------------------------------------------------------------------
while(my $elders = shift @$parents){
my @elders = unpack 'I*', $elders;
lib/AI/Genetic/Pro/Crossover/OX.pm view on Meta::CPAN
package AI::Genetic::Pro::Crossover::OX;
$AI::Genetic::Pro::Crossover::OX::VERSION = '1.009';
use warnings;
use strict;
use List::MoreUtils qw(first_index);
#use Data::Dumper; $Data::Dumper::Sortkeys = 1;
#=======================================================================
sub new { bless \$_[0], $_[0]; }
#=======================================================================
sub save_fitness {
my ($self, $ga, $idx) = @_;
$ga->_fitness->{$idx} = $ga->fitness->($ga, $ga->chromosomes->[$idx]);
return $ga->chromosomes->[$idx];
}
#=======================================================================
sub run {
my ($self, $ga) = @_;
my ($chromosomes, $parents, $crossover) = ($ga->chromosomes, $ga->_parents, $ga->crossover);
my ($fitness, $_fitness) = ($ga->fitness, $ga->_fitness);
my @children;
#-------------------------------------------------------------------
while(my $elders = shift @$parents){
my @elders = unpack 'I*', $elders;
unless(scalar @elders){
lib/AI/Genetic/Pro/Crossover/PMX.pm view on Meta::CPAN
package AI::Genetic::Pro::Crossover::PMX;
$AI::Genetic::Pro::Crossover::PMX::VERSION = '1.009';
use warnings;
use strict;
use List::MoreUtils qw(indexes);
#use Data::Dumper; $Data::Dumper::Sortkeys = 1;
#=======================================================================
sub new { bless \$_[0], $_[0]; }
#=======================================================================
sub dup {
my ($ar) = @_;
my %seen;
my @dup = grep { if($seen{$_}){ 1 }else{ $seen{$_} = 1; 0} } @$ar;
return \@dup if @dup;
return;
}
#=======================================================================
sub run {
my ($self, $ga) = @_;
my ($chromosomes, $parents, $crossover) = ($ga->chromosomes, $ga->_parents, $ga->crossover);
my ($fitness, $_fitness) = ($ga->fitness, $ga->_fitness);
my @children;
#-------------------------------------------------------------------
while(my $elders = shift @$parents){
my @elders = unpack 'I*', $elders;
unless(scalar @elders){
lib/AI/Genetic/Pro/Crossover/Points.pm view on Meta::CPAN
package AI::Genetic::Pro::Crossover::Points;
$AI::Genetic::Pro::Crossover::Points::VERSION = '1.009';
use warnings;
use strict;
use List::MoreUtils qw(first_index);
#use Data::Dumper; $Data::Dumper::Sortkeys = 1;
#=======================================================================
sub new { bless { points => $_[1] ? $_[1] : 1 }, $_[0]; }
#=======================================================================
sub run {
my ($self, $ga) = @_;
my ($chromosomes, $parents, $crossover) = ($ga->chromosomes, $ga->_parents, $ga->crossover);
my ($fitness, $_fitness) = ($ga->fitness, $ga->_fitness);
my @children;
#-------------------------------------------------------------------
while(my $elders = shift @$parents){
my @elders = unpack 'I*', $elders;
unless(scalar @elders){
lib/AI/Genetic/Pro/Crossover/PointsAdvanced.pm view on Meta::CPAN
package AI::Genetic::Pro::Crossover::PointsAdvanced;
$AI::Genetic::Pro::Crossover::PointsAdvanced::VERSION = '1.009';
use warnings;
use strict;
use List::MoreUtils qw(first_index);
#use Data::Dumper; $Data::Dumper::Sortkeys = 1;
#use AI::Genetic::Pro::Array::PackTemplate;
#=======================================================================
sub new { bless { points => $_[1] ? $_[1] : 1 }, $_[0]; }
#=======================================================================
sub run {
my ($self, $ga) = @_;
my ($chromosomes, $parents, $crossover) = ($ga->chromosomes, $ga->_parents, $ga->crossover);
my ($fitness, $_fitness) = ($ga->fitness, $ga->_fitness);
#-------------------------------------------------------------------
while(my $elders = shift @$parents){
my @elders = unpack 'I*', $elders;
unless(scalar @elders){
push @$chromosomes, $chromosomes->[$elders[0]];
lib/AI/Genetic/Pro/Crossover/PointsBasic.pm view on Meta::CPAN
package AI::Genetic::Pro::Crossover::PointsBasic;
$AI::Genetic::Pro::Crossover::PointsBasic::VERSION = '1.009';
use warnings;
use strict;
use List::MoreUtils qw(first_index);
#use Data::Dumper; $Data::Dumper::Sortkeys = 1;
#=======================================================================
sub new { bless { points => $_[1] ? $_[1] : 1 }, $_[0]; }
#=======================================================================
sub run {
my ($self, $ga) = @_;
my ($chromosomes, $parents, $crossover) = ($ga->chromosomes, $ga->_parents, $ga->crossover);
my ($fitness, $_fitness) = ($ga->fitness, $ga->_fitness);
my @children;
#-------------------------------------------------------------------
while(my $elders = shift @$parents){
my @elders = unpack 'I*', $elders;
unless(scalar @elders){
lib/AI/Genetic/Pro/Crossover/PointsSimple.pm view on Meta::CPAN
package AI::Genetic::Pro::Crossover::PointsSimple;
$AI::Genetic::Pro::Crossover::PointsSimple::VERSION = '1.009';
use warnings;
use strict;
use List::MoreUtils qw(first_index);
#use Data::Dumper; $Data::Dumper::Sortkeys = 1;
#=======================================================================
sub new { bless { points => $_[1] ? $_[1] : 1 }, $_[0]; }
#=======================================================================
sub run {
my ($self, $ga) = @_;
my ($chromosomes, $parents, $crossover) = ($ga->chromosomes, $ga->_parents, $ga->crossover);
my ($fitness, $_fitness) = ($ga->fitness, $ga->_fitness);
my @children;
#-------------------------------------------------------------------
while(my $elders = shift @$parents){
my @elders = unpack 'I*', $elders;
unless(scalar @elders){
lib/AI/Genetic/Pro/MCE.pm view on Meta::CPAN
use MCE::Util;
#-----------------------------------------------------------------------
$Storable::Deparse = 1;
$Storable::Eval = 1;
#-----------------------------------------------------------------------
__PACKAGE__->mk_accessors( qw(
_pop
_tpl
));
#=======================================================================
sub new {
my ( $cls, $obj, $tpl ) = @_;
my $self = bless $obj, $cls;
#-------------------------------------------------------------------
$self->_init_mce;
$self->_init_pop;
#-------------------------------------------------------------------
$AI::Genetic::Pro::Array::Type::Native = 1 if $self->native;
#-------------------------------------------------------------------
delete $tpl->{ $_ } for qw( -history -mce -population -workers );
$self->_tpl( $tpl );
#-------------------------------------------------------------------
return $self;
}
#=======================================================================
sub _init_pop {
my ( $self ) = @_;
my $pop = int( $self->population / $self->workers );
my $rst = $self->population % $self->workers;
my @pop = ( $pop ) x $self->workers;
$pop[ 0 ] += $rst;
$self->_pop( \@pop );
}
#=======================================================================
sub _calculate_fitness_all {
my ($self) = @_;
# Faster version. Thanks to Mario Roy :-)
my %fit = mce_map_s {
$_ => $self->fitness()->( $self, $self->chromosomes->[ $_ ] )
} 0, $#{ $self->chromosomes };
# The old one
#my %fit = mce_map {
# $_ => $self->fitness()->( $self, $self->chromosomes->[ $_ ] )
# } 0 .. $#{ $self->chromosomes };
$self->_fitness( \%fit );
return;
}
#=======================================================================
sub _init_mce {
my ( $self ) = @_;
#-------------------------------------------------------------------
$self->workers( MCE::Util::get_ncpu() ) unless $self->workers;
#-------------------------------------------------------------------
MCE::Map->init(
chunk_size => 1, # Thanks Roy :-)
#chunk_size => q[auto], # The old one
max_workers => $self->workers,
posix_exit => 1, # Thanks Roy :-)
);
#-------------------------------------------------------------------
return;
}
#=======================================================================
sub init {
my ( $self, $val ) = @_;
#-------------------------------------------------------------------
my $pop = $self->population;
$self->population( 1 );
$self->SUPER::init( $val );
$self->population( $pop );
#-------------------------------------------------------------------
my $one = shift @{ $self->chromosomes };
lib/AI/Genetic/Pro/Mutation/Listvector.pm view on Meta::CPAN
package AI::Genetic::Pro::Mutation::Listvector;
$AI::Genetic::Pro::Mutation::Listvector::VERSION = '1.009';
use warnings;
use strict;
use List::MoreUtils qw(first_index);
#use Data::Dumper; $Data::Dumper::Sortkeys = 1;
#=======================================================================
sub new { bless \$_[0], $_[0]; }
#=======================================================================
sub run {
my ($self, $ga) = @_;
# this is declared here just for speed
my $mutation = $ga->mutation;
my $chromosomes = $ga->chromosomes;
my $_translations = $ga->_translations;
my ($fitness, $_fitness) = ($ga->fitness, $ga->_fitness);
# main loop
for my $idx (0..$#$chromosomes){
lib/AI/Genetic/Pro/Mutation/Rangevector.pm view on Meta::CPAN
package AI::Genetic::Pro::Mutation::Rangevector;
$AI::Genetic::Pro::Mutation::Rangevector::VERSION = '1.009';
use warnings;
use strict;
use List::MoreUtils qw(first_index);
use Math::Random qw(random_uniform_integer);
#use Data::Dumper; $Data::Dumper::Sortkeys = 1;
#=======================================================================
sub new { bless \$_[0], $_[0]; }
#=======================================================================
sub run {
my ($self, $ga) = @_;
# this is declared here just for speed
my $mutation = $ga->mutation;
my $chromosomes = $ga->chromosomes;
my $_translations = $ga->_translations;
my ($fitness, $_fitness) = ($ga->fitness, $ga->_fitness);
# main loop
for my $idx (0..$#$chromosomes){
lib/AI/Genetic/Pro/Selection/Roulette.pm view on Meta::CPAN
package AI::Genetic::Pro::Selection::Roulette;
$AI::Genetic::Pro::Selection::Roulette::VERSION = '1.009';
use warnings;
use strict;
#use Data::Dumper; $Data::Dumper::Sortkeys = 1;
use List::Util qw(sum min);
use List::MoreUtils qw(first_index);
use Carp 'croak';
#=======================================================================
sub new { bless \$_[0], $_[0]; }
#=======================================================================
sub run {
my ($self, $ga) = @_;
my ($fitness) = ($ga->_fitness);
my (@parents, @elders);
#-------------------------------------------------------------------
my $count = $#{$ga->chromosomes};
my $const = min values %$fitness;
$const = $const < 0 ? abs($const) : 0;
my $total = sum( map { $_ < 0 ? $_ + $const : $_ } values %$fitness);
$total ||= 1;
lib/AI/Genetic/Pro/Selection/RouletteBasic.pm view on Meta::CPAN
package AI::Genetic::Pro::Selection::RouletteBasic;
$AI::Genetic::Pro::Selection::RouletteBasic::VERSION = '1.009';
use warnings;
use strict;
use List::Util qw(min);
#use Data::Dumper; $Data::Dumper::Sortkeys = 1;
use List::MoreUtils qw(first_index);
use Carp 'croak';
#=======================================================================
sub new { bless \$_[0], $_[0]; }
#=======================================================================
sub run {
my ($self, $ga) = @_;
my ($fitness, $chromosomes) = ($ga->_fitness, $ga->chromosomes);
croak "You must set a number of parents to use the RouletteBasic strategy"
unless defined($ga->parents);
my $parents = $ga->parents;
my (@parents, @wheel);
my $const = min values %$fitness;
$const = $const < 0 ? abs($const) : 0;
my $total = 0;
lib/AI/Genetic/Pro/Selection/RouletteDistribution.pm view on Meta::CPAN
random_uniform
random_normal
random_beta
random_binomial
random_chi_square
random_exponential
random_poisson
);
use Carp 'croak';
#=======================================================================
sub new {
my ($class, $type, @params) = @_;
bless {
type => $type,
params => \@params,
}, $class;
}
#=======================================================================
sub roulette {
my ($total, $wheel) = @_;
my $rand = rand($total);
my $idx = first_index { $_->[1] > $rand } @$wheel;
if($idx == 0){ $idx = 1 }
elsif($idx == -1 ) { $idx = scalar @$wheel; }
return $wheel->[$idx-1]->[0];
}
#=======================================================================
sub run {
my ($self, $ga) = @_;
my ($fitness, $chromosomes) = ($ga->_fitness, $ga->chromosomes);
croak "You must set a number of parents for the RouletteDistribution strategy"
unless defined($ga->parents);
my $parents = $ga->parents;
my $high = scalar @$chromosomes;
my (@parents, @wheel);
my $const = min values %$fitness;
$const = $const < 0 ? abs($const) : 0;
t/01_inject.t view on Meta::CPAN
use Test::More qw(no_plan);
use Struct::Compare;
use AI::Genetic::Pro;
use constant BITS => 32;
my @Win;
push @Win, 1 for 1..BITS;
my $Win = sum( \@Win );
sub sum {
my ($ar) = @_;
my $counter = 0;
for(0..$#$ar){
$counter += $ar->[$_] if $ar->[$_];
}
return $counter;
}
sub fitness {
my ($ga, $chromosome) = @_;
return sum(scalar $ga->as_array($chromosome));
}
sub terminate {
my ($ga) = @_;
return 1 if $Win == $ga->as_value($ga->getFittest);
return;
}
my $ga = AI::Genetic::Pro->new(
-fitness => \&fitness, # fitness function
-terminate => \&terminate, # terminate function
-type => 'bitvector', # type of chromosomes
-population => 100, # population
t/02_cache.t view on Meta::CPAN
use warnings;
use FindBin qw($Bin);
use lib $Bin;
use Test::More qw(no_plan);
use Time::HiRes;
use AI::Genetic::Pro;
use constant BITS => 32;
sub sum {
my ($ar) = @_;
my $counter = 0;
for(0..$#$ar){
$counter += $ar->[$_] if $ar->[$_];
}
return $counter;
}
sub fitness {
my ($ga, $chromosome) = @_;
return sum(scalar $ga->as_array($chromosome));
}
my $ga = AI::Genetic::Pro->new(
-fitness => \&fitness, # fitness function
-terminate => sub { return; }, # terminate function
-type => 'bitvector', # type of chromosomes
-population => 10, # population
-crossover => 0.9, # probab. of crossover
-mutation => 0.05, # probab. of mutation
-parents => 2, # number of parents
-selection => [ 'Roulette' ], # selection strategy
-strategy => [ 'Points', 2 ], # crossover strategy
-cache => 0, # cache results
-history => 0, # remember best results
-preserve => 0, # remember the bests
t/04_bitvectors_variable_length_I.t view on Meta::CPAN
use lib $Bin;
use Test::More qw(no_plan);
use AI::Genetic::Pro;
use constant BITS => 32;
my @Win;
push @Win, 1 for 0..BITS-1;
my $Win = sum( \@Win );
sub sum {
my ($ar) = @_;
my $counter = 0;
for(0..$#$ar){
$counter += $ar->[$_] if $ar->[$_];
}
return $counter;
}
sub fitness {
my ($ga, $chromosome) = @_;
return sum(scalar $ga->as_array($chromosome));
}
sub terminate {
my ($ga) = @_;
return 1 if $Win == $ga->as_value($ga->getFittest);
return;
}
my $ga = AI::Genetic::Pro->new(
-fitness => \&fitness, # fitness function
-terminate => \&terminate, # terminate function
-type => 'bitvector', # type of chromosomes
-population => 100, # population
t/05_bitvectors_variable_length_II.t view on Meta::CPAN
use lib $Bin;
use Test::More qw(no_plan);
use AI::Genetic::Pro;
use constant BITS => 32;
my @Win;
push @Win, 1 for 0..BITS-1;
my $Win = sum( \@Win );
sub sum {
my ($ar) = @_;
my $counter = 0;
for(0..$#$ar){
$counter += $ar->[$_] if $ar->[$_];
}
return $counter;
}
sub fitness {
my ($ga, $chromosome) = @_;
return sum(scalar $ga->as_array($chromosome));
}
sub terminate {
my ($ga) = @_;
return 1 if $Win == $ga->as_value($ga->getFittest);
return;
}
my $ga = AI::Genetic::Pro->new(
-fitness => \&fitness, # fitness function
-terminate => \&terminate, # terminate function
-type => 'bitvector', # type of chromosomes
-population => 100, # population
t/06_listvectors_constant_length.t view on Meta::CPAN
use AI::Genetic::Pro;
use constant SIZE => 8;
use constant MIN => -4;
use constant MAX => 4;
my @Win;
push @Win, MAX for 1..SIZE;
my $Win = sum( \@Win );
sub sum {
my ($ar) = @_;
my $counter = 0;
for(0..$#$ar){
$counter += $ar->[$_] if $ar->[$_];
}
return $counter;
}
sub fitness {
my ($ga, $chromosome) = @_;
return sum(scalar $ga->as_array($chromosome));
}
sub terminate {
my ($ga) = @_;
return 1 if $Win == $ga->as_value($ga->getFittest);
return;
}
my $ga = AI::Genetic::Pro->new(
-fitness => \&fitness, # fitness function
-terminate => \&terminate, # terminate function
-type => 'listvector', # type of chromosomes
-population => 100, # population
t/07_listvectors_variable_length_I.t view on Meta::CPAN
use AI::Genetic::Pro;
use constant SIZE => 8;
use constant MIN => -4;
use constant MAX => 4;
my @Win;
push @Win, MAX for 1..SIZE;
my $Win = sum( \@Win );
sub sum {
my ($ar) = @_;
my $counter = 0;
for(0..$#$ar){
$counter += $ar->[$_] if $ar->[$_];
}
return $counter;
}
sub fitness {
my ($ga, $chromosome) = @_;
return sum(scalar $ga->as_array($chromosome));
}
sub terminate {
my ($ga) = @_;
return 1 if $Win == $ga->as_value($ga->getFittest);
return;
}
my $ga = AI::Genetic::Pro->new(
-fitness => \&fitness, # fitness function
-terminate => \&terminate, # terminate function
-type => 'listvector', # type of chromosomes
-population => 100, # population
t/08_listvectors_variable_length_II.t view on Meta::CPAN
use AI::Genetic::Pro;
use constant SIZE => 8;
use constant MIN => -4;
use constant MAX => 4;
my @Win;
push @Win, MAX for 1..SIZE;
my $Win = sum( \@Win );
sub sum {
my ($ar) = @_;
my $counter = 0;
for(0..$#$ar){
$counter += $ar->[$_] if $ar->[$_];
}
return $counter;
}
sub fitness {
my ($ga, $chromosome) = @_;
return sum(scalar $ga->as_array($chromosome));
}
sub terminate {
my ($ga) = @_;
return 1 if $Win == $ga->as_value($ga->getFittest);
return;
}
my $ga = AI::Genetic::Pro->new(
-fitness => \&fitness, # fitness function
-terminate => \&terminate, # terminate function
-type => 'listvector', # type of chromosomes
-population => 100, # population
t/09_rangevectors_constant_length.t view on Meta::CPAN
use AI::Genetic::Pro;
use constant SIZE => 8;
use constant MIN => -4;
use constant MAX => 4;
my @Win;
push @Win, MAX for 1..SIZE;
my $Win = sum( \@Win );
sub sum {
my ($ar) = @_;
my $counter = 0;
for(0..$#$ar){
$counter += $ar->[$_] if $ar->[$_];
}
return $counter;
}
sub fitness {
my ($ga, $chromosome) = @_;
return sum(scalar $ga->as_array($chromosome));
}
sub terminate {
my ($ga) = @_;
return 1 if $Win == $ga->as_value($ga->getFittest);
return;
}
my $ga = AI::Genetic::Pro->new(
-fitness => \&fitness, # fitness function
-terminate => \&terminate, # terminate function
-type => 'rangevector', # type of chromosomes
-population => 100, # population
t/10_rangevectors_variable_length_I.t view on Meta::CPAN
use AI::Genetic::Pro;
use constant SIZE => 8;
use constant MIN => -4;
use constant MAX => 4;
my @Win;
push @Win, MAX for 1..SIZE;
my $Win = sum( \@Win );
sub sum {
my ($ar) = @_;
my $counter = 0;
for(0..$#$ar){
$counter += $ar->[$_] if $ar->[$_];
}
return $counter;
}
sub fitness {
my ($ga, $chromosome) = @_;
return sum(scalar $ga->as_array($chromosome));
}
sub terminate {
my ($ga) = @_;
return 1 if $Win == $ga->as_value($ga->getFittest);
return;
}
my $ga = AI::Genetic::Pro->new(
-fitness => \&fitness, # fitness function
-terminate => \&terminate, # terminate function
-type => 'rangevector', # type of chromosomes
-population => 100, # population
view release on metacpan - search on metacpan
( run in 0.820 second using v1.00-cache-2.02-grep-82fe00e-cpan-2c419f77a38b )