AI-Genetic-Pro
view release on metacpan - search on metacpan
view release on metacpan or search on metacpan
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){
push @children, $chromosomes->[$elders[0]];
next;
}
my @points = sort { $a <=> $b } map { 1 + int(rand $#{$chromosomes->[0]}) } 0..1;
@elders = sort {
my @av = @{$a}[$points[0]..$points[1]];
my @bv = @{$b}[$points[0]..$points[1]];
for my $e(@av){
splice(@$b, (first_index { $_ == $e } @$b), 1);
}
splice @$b, $points[0], 0, @av;
for my $e(@bv){
splice(@$a, (first_index { $_ == $e } @$a), 1);
}
splice @$a, $points[0], 0, @bv;
0;
} map {
$chromosomes->[$_]->clone;
} @elders;
my %elders = map { $_ => $fitness->($ga, $elders[$_]) } 0..$#elders;
my $max = (sort { $elders{$a} <=> $elders{$b} } keys %elders)[-1];
$_fitness->{scalar(@children)} = $elders{$max};
push @children, $elders[$max];
}
#-------------------------------------------------------------------
return \@children;
}
#=======================================================================
1;
view all matches for this distributionview release on metacpan - search on metacpan
( run in 0.451 second using v1.00-cache-2.02-grep-82fe00e-cpan-2c419f77a38b )