AI-Genetic-Pro

 view release on metacpan or  search on metacpan

lib/AI/Genetic/Pro.pm  view on Meta::CPAN

		my @preserved;
		for(my $i = 0; $i != $generations; $i++){
			# terminate ----------------------------------------------------
			last if $self->terminate and $self->terminate->($self);
			# update generation --------------------------------------------
			$self->generation($self->generation + 1);
			# update history -----------------------------------------------
			$self->_save_history;
			#---------------------------------------------------------------
			# preservation of N unique chromosomes
			@preserved = map { clone($_) } @{ $self->getFittest_as_arrayref($self->preserve - 1, 1) };
			# selection ----------------------------------------------------
			$self->_select_parents();
			# crossover ----------------------------------------------------
			$self->_crossover();
			# mutation -----------------------------------------------------
			$self->_mutation();
			#---------------------------------------------------------------
			for(@preserved){
				my $idx = int rand @{$self->chromosomes};
				$self->chromosomes->[$idx] = $_;

lib/AI/Genetic/Pro.pm  view on Meta::CPAN

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;

lib/AI/Genetic/Pro.pm  view on Meta::CPAN

    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
        -crossover       => 0.9,              # probab. of crossover
        -mutation        => 0.01,             # probab. of mutation

lib/AI/Genetic/Pro.pm  view on Meta::CPAN

        -workers         => 3,                # number of workers (MCE)
    );
	
    # init population of 32-bit vectors
    $ga->init(32);
	
    # evolve 10 generations
    $ga->evolve(10);
    
    # best score
    print "SCORE: ", $ga->as_value($ga->getFittest), ".\n";
    
    # save evolution path as a chart
    $ga->chart(-filename => 'evolution.png');
     
    # save state of GA
    $ga->save('genetic.sga');
    
    # load state of GA
    $ga->load('genetic.sga');

lib/AI/Genetic/Pro.pm  view on Meta::CPAN

doesn't have limitations of its ancestor (such as slow-down in the
case of big populations ( >10000 ) or vectors with more than 33 fields).

If You are looking for a pure Perl solution, consider L<AI::Genetic>.

=over 4

=item Speed

To increase speed XS code is used, however with portability in 
mind. This distribution was tested on Windows and Linux platforms 
(and should work on any other).

Multicore support is available through Many-Core Engine (C<MCE>). 
You can gain the most speed up for big populations or time/CPU consuming 
fitness functions, however for small populations and/or simple fitness 
function better choice will be single-process version.

You can get even more speed up if you turn on use of native arrays 
(parameter: C<native>) instead of packing chromosomes into single scalar. 
However you have to remember about expensive memory use in that case.

lib/AI/Genetic/Pro.pm  view on Meta::CPAN

=item -workers

This option has any meaning only if MCE is turned on. This defines how 
many process will be used during processing. Default will be used one proces per core (most efficient).

=item -strict

This defines if the check for modifying chromosomes in a user-defined fitness
function is active. Directly modifying chromosomes is not allowed and it is 
a highway to big trouble. This mode should be used only for testing, because it is B<slow>.

=back

=item I<$ga>-E<gt>B<inject>($chromosomes)

Inject new, user defined, chromosomes into the current population. See example below:

    # example for bitvector
    my $chromosomes = [
        [ 1, 1, 0, 1, 0, 1 ],

lib/AI/Genetic/Pro.pm  view on Meta::CPAN

		[ mean,  mean1, mean2, ... ],       # mean values
		[ min0,  min1,  min2,  ... ],       # min values
	]

=item I<$ga>-E<gt>B<getAvgFitness>()

Get I<max>, I<mean> and I<min> score of the current generation. In example:

    my ($max, $mean, $min) = $ga->getAvgFitness();

=item I<$ga>-E<gt>B<getFittest>($n, $unique)

This function returns a list of the fittest chromosomes from the current
population.  You can specify how many chromosomes should be returned and if
the returned chromosomes should be unique. See example below.

    # only one - the best
    my ($best) = $ga->getFittest;

    # or 5 bests chromosomes, NOT unique
    my @bests = $ga->getFittest(5);

    # or 7 bests and UNIQUE chromosomes
    my @bests = $ga->getFittest(7, 1);

If you want to get a large number of chromosomes, try to use the
C<getFittest_as_arrayref> function instead (for efficiency).

=item I<$ga>-E<gt>B<getFittest_as_arrayref>($n, $unique)

This function is very similar to C<getFittest>, but it returns a reference 
to an array instead of a list. 

=item I<$ga>-E<gt>B<generation>()

Get the number of the current generation.

=item I<$ga>-E<gt>B<people>()

Returns an anonymous list of individuals/chromosomes of the current population. 

lib/AI/Genetic/Pro.pm  view on Meta::CPAN

C<AI::Genetic::Pro> is still under development; however, it is used in many
production environments.

=head1 TODO

=over 4

=item Examples.

=item More tests.

=item More warnings about incorrect parameters.

=back

=head1 REPORTING BUGS

When reporting bugs/problems please include as much information as possible.
It may be difficult for me to reproduce the problem as almost every setup
is different.

lib/AI/Genetic/Pro.pm  view on Meta::CPAN

Miles Gould for suggestions and some fixes (even in this documentation! :-).

Alun Jones for fixing memory leaks.

Tod Hagan for reporting a bug (rangevector values truncated to signed  8-bit quantities) and supplying a patch.

Randal L. Schwartz for reporting a bug in this documentation.

Maciej Misiak for reporting problems with C<combination> (and a bug in a PMX strategy).

LEONID ZAMDBORG for recommending the addition of variable-length chromosomes as well as supplying relevant code samples, for testing and at the end reporting some bugs.

Christoph Meissner for reporting a bug.

Alec Chen for reporting some bugs.

=head1 AUTHOR

Strzelecki Lukasz <lukasz@strzeleccy.eu>

=head1 SEE ALSO

lib/AI/Genetic/Pro/Chromosome.pm  view on Meta::CPAN

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/){ 
		#@genes = shuffle 0..$#{$data->[0]}; 
		@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; 
	}