AI-Genetic-Pro
view release on metacpan or search on metacpan
copy of the Library. To do this, you must alter all the notices
that refer to this License, so that they refer to the ordinary
GNU General Public License, version 2, instead of to this
License. (If a newer version than version 2 of the ordinary
GNU General Public License has appeared, then you can
specify that version instead if you wish.) Do not make any
other change in these notices.
Once this change is made in a given copy, it is irreversible
for that copy, so the ordinary GNU General Public License
applies to all subsequent copies and derivative works made
from that copy.
This option is useful when you wish to copy part of the code
of the Library into a program that is not a library.
4. You may copy and distribute the Library (or a portion or
derivative of it, under Section 2) in object code or executable
form under the terms of Sections 1 and 2 above provided that
you accompany it with the complete corresponding
machine-readable source code, which must be distributed
uncombined with any other library facilities.
This must be distributed under the terms of the
Sections above.
b) Give prominent notice with the combined
library of the fact that part of it is a work based
on the Library, and explaining where to find the
accompanying uncombined form of the same
work.
8. You may not copy, modify, sublicense, link with, or
distribute the Library except as expressly provided under this
License. Any attempt otherwise to copy, modify, sublicense,
link with, or distribute the Library is void, and will
automatically terminate your rights under this License.
However, parties who have received copies, or rights, from
you under this License will not have their licenses terminated
so long as such parties remain in full compliance.
9. You are not required to accept this License, since you
have not signed it. However, nothing else grants you
permission to modify or distribute the Library or its derivative
works. These actions are prohibited by law if you do not
accept this License. Therefore, by modifying or distributing
the Library (or any work based on the Library), you indicate
your acceptance of this License to do so, and all its terms
and conditions for copying, distributing or modifying the
Library or works based on it.
10. Each time you redistribute the Library (or any work
based on the Library), the recipient automatically receives a
license from the original licensor to copy, distribute, link with
or modify the Library subject to these terms and conditions.
You may not impose any further restrictions on the
recipients' exercise of the rights granted herein. You are not
responsible for enforcing compliance by third parties with this
License.
11. If, as a consequence of a court judgment or allegation of
patent infringement or for any other reason (not limited to
patent issues), conditions are imposed on you (whether by
court order, agreement or otherwise) that contradict the
conditions of this License, they do not excuse you from the
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
METHODS
$ga->new( %options )
Constructor. It accepts options in hash-value style. See options and
an example below.
-fitness
This defines a fitness function. It expects a reference to a
subroutine.
-terminate
This defines a terminate function. It expects a reference to a
subroutine.
-type
This defines the type of chromosomes. Currently, AI::Genetic::Pro
supports four types:
bitvector
Individuals/chromosomes of this type have genes that are bits.
Each gene can be in one of two possible states, on or off.
For bitvectors, the argument is simply the length of the bitvector.
$ga->init(10);
This initializes a population where each individual/chromosome has
10 genes.
listvector
For listvectors, the argument is an anonymous list of lists. The
number of sub-lists is equal to the number of genes of each
individual/chromosome. Each sub-list defines the possible string
values that the corresponding gene can assume.
$ga->init([
[qw/red blue green/],
[qw/big medium small/],
[qw/very_fat fat fit thin very_thin/],
]);
This initializes a population where each individual/chromosome has
3 genes and each gene can assume one of the given values.
rangevector
For rangevectors, the argument is an anonymous list of lists. The
number of sub-lists is equal to the number of genes of each
individual/chromosome. Each sub-list defines the minimum and
maximum integer values that the corresponding gene can assume.
$ga->init([
[1, 5],
[0, 20],
[4, 9],
]);
This initializes a population where each individual/chromosome has
3 genes and each gene can assume an integer within the
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.pm view on Meta::CPAN
#-------------------------------------------------------------------
return $self unless $self->mce;
#-------------------------------------------------------------------
delete $self->{ mce };
'AI::Genetic::Pro::MCE'->use or die q[Cannot raise multicore support: ] . $@;
return AI::Genetic::Pro::MCE->new( $self, \%args );
}
#=======================================================================
sub _Cache { $_Cache; }
#=======================================================================
# INIT #################################################################
#=======================================================================
sub _set_strict {
my ($self) = @_;
# fitness
my $fitness = $self->fitness();
my $replacement = sub {
my @tmp = @{$_[1]};
my $ret = $fitness->(@_);
my @cmp = @{$_[1]};
die qq/Chromosome was modified in a fitness function from "@tmp" to "@{$_[1]}"!\n/ unless compare(\@tmp, \@cmp);
return $ret;
};
$self->fitness($replacement);
}
#=======================================================================
sub _fitness_cached {
my ($self, $chromosome) = @_;
#my $key = md5_hex(${tied(@$chromosome)});
my $key = md5_hex( $self->_package ? md5_hex( ${ tied( @$chromosome ) } ) : join( q[:], @$chromosome ) );
return $_Cache->{$key} if exists $_Cache->{$key};
$_Cache->{$key} = $self->_fitness_real->($self, $chromosome);
return $_Cache->{$key};
}
#=======================================================================
sub _init_cache {
my ($self) = @_;
$self->_fitness_real($self->fitness);
$self->fitness(\&_fitness_cached);
return;
}
#=======================================================================
sub _check_data_ref {
my ($self, $data_org) = @_;
my $data = clone($data_org);
my $ars;
for(0..$#$data){
next if $ars->{$data->[$_]};
$ars->{$data->[$_]} = 1;
unshift @{$data->[$_]}, undef;
}
return $data;
}
#=======================================================================
# we have to find C to (in some cases) incrase value of range
# due to design model
sub _find_fix_range {
my ($self, $data) = @_;
for my $idx (0..$#$data){
if($data->[$idx]->[1] < 1){
my $const = 1 - $data->[$idx]->[1];
push @{$self->_fix_range}, $const;
$data->[$idx]->[1] += $const;
$data->[$idx]->[2] += $const;
}else{ push @{$self->_fix_range}, 0; }
}
return $data;
}
#=======================================================================
sub init {
my ( $self, $data ) = @_;
croak q/You have to pass some data to "init"!/ unless $data;
#-------------------------------------------------------------------
$self->generation(0);
$self->_init( $data );
$self->_fitness( { } );
$self->_fix_range( [ ] );
$self->_history( [ [ ], [ ], [ ] ] );
$self->_init_cache if $self->cache;
lib/AI/Genetic/Pro.pm view on Meta::CPAN
my $size = 0;
if($self->type ne q/rangevector/){ for(@{$self->_translations}){ $size = $#$_ if $#$_ > $size; } }
# else{ for(@{$self->_translations}){ $size = $_->[1] if $_->[1] > $size; } }
else{ for(@{$self->_translations}){ $size = $_->[2] if $_->[2] > $size; } } # Provisional patch for rangevector values truncated to signed 8-bit quantities. Thx to Tod Hagan
my $package = get_package_by_element_size($size);
$self->_package($package);
my $length = ref $data ? sub { $#$data; } : sub { $data - 1 };
if($self->variable_length){
$length = ref $data ? sub { 1 + int( rand( $#{ $self->_init } ) ); } : sub { 1 + int( rand( $self->_init - 1) ); };
}
$self->_length( $length );
$self->chromosomes( [ ] );
push @{$self->chromosomes},
AI::Genetic::Pro::Chromosome->new($self->_translations, $self->type, $package, $length->())
for 1..$self->population;
$self->_calculate_fitness_all();
}
#=======================================================================
# SAVE / LOAD ##########################################################
#=======================================================================
sub spew {
#+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
STORABLE->use( qw( store retrieve freeze thaw ) ) or croak(q/You need "/.STORABLE.q/" module to save a state of "/.__PACKAGE__.q/"!/);
$Storable::Deparse = 1;
$Storable::Eval = 1;
#+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
my ( $self ) = @_;
my $clone = {
_selector => undef,
_strategist => undef,
lib/AI/Genetic/Pro.pm view on Meta::CPAN
if $self->_package;
foreach my $key(keys %$self){
next if exists $clone->{$key};
$clone->{$key} = $self->{$key};
}
return $clone;
}
#=======================================================================
sub slurp {
my ( $self, $dump ) = @_;
if( my $typ = $self->_package ){
@{ $dump->{ chromosomes } } = map {
my $arr = $typ->make_with_packed( $_ );
bless $arr, q[AI::Genetic::Pro::Chromosome];
} @{ $dump->{ chromosomes } };
}
%$self = %$dump;
return 1;
}
#=======================================================================
sub save {
my ( $self, $file ) = @_;
croak(q/You have to specify file!/) unless defined $file;
store( $self->spew, $file );
}
#=======================================================================
sub load {
#+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
STORABLE->use( qw( store retrieve freeze thaw ) ) or croak(q/You need "/.STORABLE.q/" module to load a state of "/.__PACKAGE__.q/"!/);
$Storable::Deparse = 1;
$Storable::Eval = 1;
#+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
my ($self, $file) = @_;
croak(q/You have to specify file!/) unless defined $file;
my $clone = retrieve($file);
return carp('Incorrect file!') unless $clone;
return $self->slurp( $clone );
}
#=======================================================================
# CHARTS ###############################################################
#=======================================================================
sub chart {
GD->require or croak(q/You need "/.GD.q/" module to draw chart of evolution!/);
my ($self, %params) = (shift, @_);
my $graph = GD()->new(($params{-width} || 640), ($params{-height} || 480));
my $data = $self->getHistory;
if(defined $params{-font}){
$graph->set_title_font ($params{-font}, 12);
$graph->set_x_label_font($params{-font}, 10);
lib/AI/Genetic/Pro.pm view on Meta::CPAN
open(my $fh, '>', $params{-filename}) or croak($@);
binmode $fh;
print $fh $gd->png;
close $fh;
return 1;
}
#=======================================================================
# TRANSLATIONS #########################################################
#=======================================================================
sub as_array_def_only {
my ($self, $chromosome) = @_;
return $self->as_array($chromosome)
if not $self->variable_length or $self->variable_length < 2;
if( $self->type eq q/bitvector/ ){
return $self->as_array($chromosome);
}else{
my $ar = $self->as_array($chromosome);
my $idx = first_index { $_ } @$ar;
my @array = @$ar[$idx..$#$chromosome];
return @array if wantarray;
return \@array;
}
}
#=======================================================================
sub as_array {
my ($self, $chromosome) = @_;
if($self->type eq q/bitvector/){
# This could lead to internal error, bacause of underlaying Tie::Array::Packed
#return @$chromosome if wantarray;
#return $chromosome;
my @chr = @$chromosome;
return @chr if wantarray;
return \@chr;
lib/AI/Genetic/Pro.pm view on Meta::CPAN
return @array if wantarray;
return \@array;
}else{
my $cnt = 0;
my @array = map { $self->_translations->[$cnt++]->[$_] } @$chromosome;
return @array if wantarray;
return \@array;
}
}
#=======================================================================
sub as_string_def_only {
my ($self, $chromosome) = @_;
return $self->as_string($chromosome)
if not $self->variable_length or $self->variable_length < 2;
my $array = $self->as_array_def_only($chromosome);
return join(q//, @$array) if $self->type eq q/bitvector/;
return join(q/___/, @$array);
}
#=======================================================================
sub as_string {
return join(q//, @{$_[1]}) if $_[0]->type eq q/bitvector/;
return join(q/___/, map { defined $_ ? $_ : q/ / } $_[0]->as_array($_[1]));
}
#=======================================================================
sub as_value {
my ($self, $chromosome) = @_;
croak(q/You MUST call 'as_value' as method of 'AI::Genetic::Pro' object./)
unless defined $_[0] and ref $_[0] and ( ref $_[0] eq 'AI::Genetic::Pro' or ref $_[0] eq 'AI::Genetic::Pro::MCE');
croak(q/You MUST pass 'AI::Genetic::Pro::Chromosome' object to 'as_value' method./)
unless defined $_[1] and ref $_[1] and ref $_[1] eq 'AI::Genetic::Pro::Chromosome';
return $self->fitness->($self, $chromosome);
}
#=======================================================================
# ALGORITHM ############################################################
#=======================================================================
sub _calculate_fitness_all {
my ($self) = @_;
$self->_fitness( { } );
$self->_fitness->{$_} = $self->fitness()->($self, $self->chromosomes->[$_])
for 0..$#{$self->chromosomes};
# sorting the population is not necessary
# my (@chromosomes, %fitness);
# for my $idx (sort { $self->_fitness->{$a} <=> $self->_fitness->{$b} } keys %{$self->_fitness}){
# push @chromosomes, $self->chromosomes->[$idx];
lib/AI/Genetic/Pro.pm view on Meta::CPAN
# delete $self->_fitness->{$idx};
# delete $self->chromosomes->[$idx];
# }
#
# $self->_fitness(\%fitness);
# $self->chromosomes(\@chromosomes);
return;
}
#=======================================================================
sub _select_parents {
my ($self) = @_;
unless($self->_selector){
croak "You must specify a selection strategy!"
unless defined $self->selection;
my @tmp = @{$self->selection};
my $selector = q/AI::Genetic::Pro::Selection::/ . shift @tmp;
$selector->require or die $!;
$self->_selector($selector->new(@tmp));
}
$self->_parents($self->_selector->run($self));
return;
}
#=======================================================================
sub _crossover {
my ($self) = @_;
unless($self->_strategist){
my @tmp = @{$self->strategy};
my $strategist = q/AI::Genetic::Pro::Crossover::/ . shift @tmp;
$strategist->require or die $!;
$self->_strategist($strategist->new(@tmp));
}
my $a = $self->_strategist->run($self);
$self->chromosomes( $a );
return;
}
#=======================================================================
sub _mutation {
my ($self) = @_;
unless($self->_mutator){
my $mutator = q/AI::Genetic::Pro::Mutation::/ . ucfirst(lc($self->type));
unless($mutator->require){
$mutator = q/AI::Genetic::Pro::Mutation::Listvector/;
$mutator->require;
}
$self->_mutator($mutator->new);
}
return $self->_mutator->run($self);
}
#=======================================================================
sub _save_history {
my @tmp;
if($_[0]->history){ @tmp = $_[0]->getAvgFitness; }
else { @tmp = (undef, undef, undef); }
push @{$_[0]->_history->[0]}, $tmp[0];
push @{$_[0]->_history->[1]}, $tmp[1];
push @{$_[0]->_history->[2]}, $tmp[2];
return 1;
}
#=======================================================================
sub inject {
my ($self, $candidates) = @_;
for(@$candidates){
push @{$self->chromosomes},
AI::Genetic::Pro::Chromosome->new_from_data($self->_translations, $self->type, $self->_package, $_, $self->_fix_range);
$self->_fitness->{$#{$self->chromosomes}} = $self->fitness()->($self, $self->chromosomes->[-1]);
}
$self->_strict( [ ] );
$self->population( $self->population + scalar( @$candidates ) );
return 1;
}
#=======================================================================
sub _state {
my ( $self ) = @_;
my @res;
if( $self->_package ){
@res = map {
[
${ tied( @{ $self->chromosomes->[ $_ ] } ) },
$self->_fitness->{ $_ },
]
lib/AI/Genetic/Pro.pm view on Meta::CPAN
[
$self->chromosomes->[ $_ ],
$self->_fitness->{ $_ },
]
} 0 .. $self->population - 1
}
return \@res;
}
#=======================================================================
sub evolve {
my ($self, $generations) = @_;
# generations must be defined
$generations ||= -1;
if($self->strict and $self->_strict){
for my $idx (0..$#{$self->chromosomes}){
croak(q/Chromosomes was modified outside the 'evolve' function!/) unless $self->chromosomes->[$idx] and $self->_strict->[$idx];
my @tmp0 = @{$self->chromosomes->[$idx]};
my @tmp1 = @{$self->_strict->[$idx]};
lib/AI/Genetic/Pro.pm view on Meta::CPAN
}
if($self->strict){
$self->_strict( [ ] );
push @{$self->_strict}, $_->clone for @{$self->chromosomes};
}
}
#=======================================================================
# ALIASES ##############################################################
#=======================================================================
sub people { $_[0]->chromosomes() }
#=======================================================================
sub getHistory { $_[0]->_history() }
#=======================================================================
sub mutProb { shift->mutation(@_) }
#=======================================================================
sub crossProb { shift->crossover(@_) }
#=======================================================================
sub intType { shift->type() }
#=======================================================================
# STATS ################################################################
#=======================================================================
sub getFittest_as_arrayref {
my ($self, $n, $uniq) = @_;
$n ||= 1;
$self->_calculate_fitness_all() unless scalar %{ $self->_fitness };
my @keys = sort { $self->_fitness->{$a} <=> $self->_fitness->{$b} } 0..$#{$self->chromosomes};
if($uniq){
my %grep;
my $chromosomes = $self->chromosomes;
if( my $pkg = $self->_package ){
lib/AI/Genetic/Pro.pm view on Meta::CPAN
my $key = md5_hex( join( q[:], @{ $chromosomes->[ $_ ] } ) );
$tmp{ $key } && 0 or $tmp{ $key } = 1;
} @keys;
}
}
$n = scalar @keys if $n > scalar @keys;
return [ reverse @{$self->chromosomes}[ splice @keys, $#keys - $n + 1, $n ] ];
}
#=======================================================================
sub getFittest { return wantarray ? @{ shift->getFittest_as_arrayref(@_) } : shift @{ shift->getFittest_as_arrayref(@_) }; }
#=======================================================================
sub getAvgFitness {
my ($self) = @_;
my @minmax = minmax values %{$self->_fitness};
my $mean = sum(values %{$self->_fitness}) / scalar values %{$self->_fitness};
return $minmax[1], int($mean), $minmax[0];
}
#=======================================================================
1;
__END__
=head1 NAME
AI::Genetic::Pro - Efficient genetic algorithms for professional purpose with support for multiprocessing.
=head1 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
=item I<$ga>-E<gt>B<new>( %options )
Constructor. It accepts options in hash-value style. See options and
an example below.
=over 8
=item -fitness
This defines a I<fitness> function. It expects a reference to a subroutine.
=item -terminate
This defines a I<terminate> function. It expects a reference to a subroutine.
=item -type
This defines the type of chromosomes. Currently, C<AI::Genetic::Pro> supports four types:
=over 12
=item bitvector
Individuals/chromosomes of this type have genes that are bits. Each gene can be in one of two possible states, on or off.
lib/AI/Genetic/Pro.pm view on Meta::CPAN
=item B<bitvector>
For bitvectors, the argument is simply the length of the bitvector.
$ga->init(10);
This initializes a population where each individual/chromosome has 10 genes.
=item B<listvector>
For listvectors, the argument is an anonymous list of lists. The number of sub-lists is equal to the number of genes of each individual/chromosome. Each sub-list defines the possible string values that the corresponding gene can assume.
$ga->init([
[qw/red blue green/],
[qw/big medium small/],
[qw/very_fat fat fit thin very_thin/],
]);
This initializes a population where each individual/chromosome has 3 genes and each gene can assume one of the given values.
=item B<rangevector>
For rangevectors, the argument is an anonymous list of lists. The number of sub-lists is equal to the number of genes of each individual/chromosome. Each sub-list defines the minimum and maximum integer values that the corresponding gene can assume.
$ga->init([
[1, 5],
[0, 20],
[4, 9],
]);
This initializes a population where each individual/chromosome has 3 genes and each gene can assume an integer within the corresponding range.
=item B<combination>
lib/AI/Genetic/Pro/Array/Type.pm view on Meta::CPAN
use Exporter::Lite;
use Tie::Array::Packed;
#=======================================================================
our @EXPORT_OK = qw(
get_package_by_element_size
get_array_ref_by_element_size
);
#-----------------------------------------------------------------------
our $Native = 0;
#=======================================================================
sub get_package_by_element_size {
return if $Native;
my $size = shift;
my $type = #$size < 32 ? undef : # Pure Perl array
#$size < 32 ? 'AI::Genetic::Pro::Array::Tied' : # Pure Perl array
$size < 128 ? 'Tie::Array::Packed::Char' : # 8 bits
$size < 256 ? 'Tie::Array::Packed::UnsignedChar' : # 8 bits
$size < 65_537 ? 'Tie::Array::Packed::ShortNative' : # 16 bits
$size < 131_073 ? 'Tie::Array::Packed::UnsignedShortNative' : # 16 bits
$size < 2_147_483_648 ? 'Tie::Array::Packed::Integer' : # 32 bits
$size < 4_294_967_297 ? 'Tie::Array::Packed::UnsignedInteger' : # 32 bits; MAX
undef;
return unless $type;
return $type;
}
#=======================================================================
sub get_array_ref_by_element_size {
my $package = get_package_by_element_size(shift);
my @array;
tie @array, $package if $package;
return \@array;
}
#=======================================================================
1;
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/Chromosome.pm view on Meta::CPAN
@genes = shuffle 0..$length;
}elsif($type eq q/rangevector/){
@genes = map { $_->[1] + int rand($_->[2] - $_->[1] + 1) } @$data[0..$length];
}else{
@genes = map { 1 + int(rand( $#{ $data->[$_] })) } 0..$length;
}
return bless \@genes, $class;
}
#=======================================================================
sub new_from_data {
my ($class, $data, $type, $package, $values, $fix_range) = @_;
die qq/\nToo many elements in the injected chromosome of type "$type": @$values\n/ if $#$values > $#$data;
my @genes;
tie @genes, $package if $package;
if($type eq q/bitvector/){
die qq/\nInproper value in the injected chromosome of type "$type": @$values\n/
if first { not defined $_ or ($_ != 0 and $_ != 1) } @$values;
lib/AI/Genetic/Pro/Chromosome.pm view on Meta::CPAN
defined $_ and defined $values->[$idx] and $_ eq $values->[$idx]
} @{$data->[$idx]}; # pomijamy poczatkowy undef
die qq/\nInproper element in the injected chromosome of type "$type": @$values\n/ if $id == -1;
push @genes, $id;
}
}
return bless \@genes, $class;
}
#=======================================================================
sub clone
{
my ( $self ) = @_;
my $cln;
if( my $obj = tied( @$self ) ){
$cln = $obj->make_clone;
}else{
@$cln = @$self;
}
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/MCE.pm view on Meta::CPAN
my $gal = AI::Genetic::Pro->new( %$arg );
$gal->init( $val );
@{ $gal->_state };
} @{ $self->_pop };
#-------------------------------------------------------------------
return $self->_adopt( \@lst );
}
#=======================================================================
sub _adopt {
my ( $self, $lst ) = @_;
if( my $typ = $self->_package ){
for my $idx ( 0 .. $#$lst ){
$lst->[ $idx ]->[ 0 ] = $typ->make_with_packed( $lst->[ $idx ]->[ 0 ] );
bless $lst->[ $idx ]->[ 0 ], q[AI::Genetic::Pro::Chromosome];
}
}
my ( @chr, %fit, @rhc, %tif );
lib/AI/Genetic/Pro/MCE.pm view on Meta::CPAN
push @rhc, $chr[ $i ];
$tif{ $#rhc } = $fit{ $i };
}
$self->_fitness ( \%tif );
$self->chromosomes( \@rhc );
return;
}
#=======================================================================
sub _chunks {
my ( $self ) = @_;
my $cnt = 0;
my @chk;
for my $idx ( 0 .. $#{ $self->_pop } ){
my $pos = 0;
my %tmp = map { $pos++ => $self->_fitness->{ $_ } } $cnt .. $cnt + $self->_pop->[ $idx ] -1 ;
my @tmp = splice @{ $self->chromosomes }, 0, $self->_pop->[ $idx ];
$cnt += @tmp;
lib/AI/Genetic/Pro/MCE.pm view on Meta::CPAN
push @chk, [
\@tmp,
\%tmp,
];
}
}
return \@chk;
}
#=======================================================================
sub evolve {
my ( $self, $generations ) = @_;
$generations ||= -1;
for(my $i = 0; $i != $generations; $i++){
# terminate ----------------------------------------------------
last if $self->terminate and $self->terminate->( $self );
# update generation --------------------------------------------
lib/AI/Genetic/Pro/Mutation/Bitvector.pm view on Meta::CPAN
package AI::Genetic::Pro::Mutation::Bitvector;
$AI::Genetic::Pro::Mutation::Bitvector::VERSION = '1.009';
use warnings;
use strict;
#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/Bitvector.pm view on Meta::CPAN
$chromosomes->[$idx]->[$id] = $chromosomes->[$idx]->[$id] ? 0 : 1;
}
# we need to change fitness
$_fitness->{$idx} = $fitness->($ga, $chromosomes->[$idx]);
}
return 1;
}
#=======================================================================
# too slow; mutation is too dangerous in this solution
sub run0 {
my ($self, $ga) = @_;
my $mutation = $ga->mutation; # this is declared here just for speed
foreach my $chromosome (@{$ga->{chromosomes}}){
if(rand() < $mutation){ tied(@$chromosome)->reverse; }
else{
for(0..$#$chromosome){
next if rand > $mutation;
$chromosome->[$_] = $chromosome->[$_] ? 0 : 1;
}
lib/AI/Genetic/Pro/Mutation/Combination.pm view on Meta::CPAN
package AI::Genetic::Pro::Mutation::Combination;
$AI::Genetic::Pro::Mutation::Combination::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);
my $inv = $mutation / 2;
# main loop
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/Mutation/Rangevector.pm view on Meta::CPAN
$chromosomes->[$idx]->[$id] = random_uniform_integer(1, @{$_translations->[$id]}[1..2]);
}
# we need to change fitness
$_fitness->{$idx} = $fitness->($ga, $chromosomes->[$idx]);
}
return 1;
}
#=======================================================================
sub run0 {
my ($self, $ga) = @_;
# this is declared here just for speed
my $mutation = $ga->mutation;
# main loop
foreach my $chromosome (@{$ga->{chromosomes}}){
next if rand() <= $mutation;
if($ga->variable_length){
lib/AI/Genetic/Pro/Selection/Distribution.pm view on Meta::CPAN
random_uniform_integer
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 run {
my ($self, $ga) = @_;
my ($fitness, $chromosomes) = ($ga->_fitness, $ga->chromosomes);
croak "You must set a number of parents to use the Distribution strategy"
unless defined($ga->parents);
my $parents = $ga->parents;
my @parents;
my $high = scalar @$chromosomes;
#-------------------------------------------------------------------
if($self->{type} eq q/uniform/){
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/02_cache.t view on Meta::CPAN
$ga->init(BITS);
$ga->chromosomes( [ ] );
$ga->inject( [ [ qw( 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1) ] ] );
my $start = [Time::HiRes::gettimeofday()];
$ga->as_value($ga->chromosomes->[0]) for 0..10000;
my $time0 =Time::HiRes::tv_interval($start);
$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 => 1, # cache results
-history => 0, # remember best results
-preserve => 0, # remember the bests
t/03_bitvectors_constant_length.t view on Meta::CPAN
use lib $Bin, $Bin.'../lib';
use Test::More qw(no_plan);
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/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
( run in 1.266 second using v1.01-cache-2.11-cpan-88abd93f124 )