AI-Genetic-Pro
view release on metacpan or search on metacpan
AND MODIFICATION
0. This License Agreement applies to any software library or
other program which contains a notice placed by the
copyright holder or other authorized party saying it may be
distributed under the terms of this Lesser General Public
License (also called "this License"). Each licensee is
addressed as "you".
A "library" means a collection of software functions and/or
data prepared so as to be conveniently linked with
application programs (which use some of those functions
and data) to form executables.
The "Library", below, refers to any such software library or
work which has been distributed under these terms. A "work
based on the Library" means either the Library or any
derivative work under copyright law: that is to say, a work
containing the Library or a portion of it, either verbatim or with
modifications and/or translated straightforwardly into another
language. (Hereinafter, translation is included without
limitation in the term "modification".)
a) The modified work must itself be a software
library.
b) You must cause the files modified to carry
prominent notices stating that you changed the
files and the date of any change.
c) You must cause the whole of the work to be
licensed at no charge to all third parties under
the terms of this License.
d) If a facility in the modified Library refers to a
function or a table of data to be supplied by an
application program that uses the facility, other
than as an argument passed when the facility
is invoked, then you must make a good faith
effort to ensure that, in the event an application
does not supply such function or table, the
facility still operates, and performs whatever
part of its purpose remains meaningful.
(For example, a function in a library to
compute square roots has a purpose that is
distribution of such executables.
When a "work that uses the Library" uses material from a
header file that is part of the Library, the object code for the
work may be a derivative work of the Library even though the
source code is not. Whether this is true is especially
significant if the work can be linked without the Library, or if
the work is itself a library. The threshold for this to be true is
not precisely defined by law.
If such an object file uses only numerical parameters, data
structure layouts and accessors, and small macros and
small inline functions (ten lines or less in length), then the
use of the object file is unrestricted, regardless of whether it
is legally a derivative work. (Executables containing this
object code plus portions of the Library will still fall under
Section 6.)
Otherwise, if the work is a derivative of the Library, you may
distribute the object code for the work under the terms of
Section 6. Any executables containing that work also fall
d) If distribution of the work is made by offering
access to copy from a designated place, offer
equivalent access to copy the above specified
materials from the same place.
e) Verify that the user has already received a
copy of these materials or that you have
already sent this user a copy.
For an executable, the required form of the "work that uses
the Library" must include any data and utility programs
needed for reproducing the executable from it. However, as a
special exception, the materials to be distributed need not
include anything that is normally distributed (in either source
or binary form) with the major components (compiler, kernel,
and so on) of the operating system on which the executable
runs, unless that component itself accompanies the
executable.
It may happen that this requirement contradicts the license
restrictions of other proprietary libraries that do not normally
lib/AI/Genetic/Pro.pm view on Meta::CPAN
}
#=======================================================================
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;
#-------------------------------------------------------------------
if($self->type eq q/listvector/){
croak(q/You have to pass array reference if "type" is set to "listvector"/) unless ref $data eq 'ARRAY';
$self->_translations( $self->_check_data_ref($data) );
}elsif($self->type eq q/bitvector/){
croak(q/You have to pass integer if "type" is set to "bitvector"/) if $data !~ /^\d+$/o;
$self->_translations( [ [ 0, 1 ] ] );
$self->_translations->[$_] = $self->_translations->[0] for 1..$data-1;
}elsif($self->type eq q/combination/){
croak(q/You have to pass array reference if "type" is set to "combination"/) unless ref $data eq 'ARRAY';
$self->_translations( [ clone($data) ] );
$self->_translations->[$_] = $self->_translations->[0] for 1..$#$data;
}elsif($self->type eq q/rangevector/){
croak(q/You have to pass array reference if "type" is set to "rangevector"/) unless ref $data eq 'ARRAY';
$self->_translations( $self->_find_fix_range( $self->_check_data_ref($data) ));
}else{
croak(q/You have to specify first "type" of vector!/);
}
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();
lib/AI/Genetic/Pro.pm view on Meta::CPAN
}
#=======================================================================
# 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);
$graph->set_y_label_font($params{-font}, 10);
$graph->set_legend_font ($params{-font}, 8);
}
$graph->set_legend(
$params{legend1} || q/Max value/,
$params{legend2} || q/Mean value/,
$params{legend3} || q/Min value/,
);
$graph->set(
x_label_skip => int(($data->[0]->[-1]*4)/100),
x_labels_vertical => 1,
x_label_position => .5,
y_label_position => .5,
y_long_ticks => 1, # poziome linie
x_ticks => 1, # poziome linie
l_margin => 10,
b_margin => 10,
r_margin => 10,
t_margin => 10,
lib/AI/Genetic/Pro.pm view on Meta::CPAN
transparent => 0,
title => ($params{'-title'} || q/Evolution/ ),
x_label => ($params{'-x_label'} || q/Generation/),
y_label => ($params{'-y_label'} || q/Value/ ),
( $params{-logo} && -f $params{-logo} ? ( logo => $params{-logo} ) : ( ) )
);
my $gd = $graph->plot( [ [ 0..$#{$data->[0]} ], @$data ] ) or croak($@);
open(my $fh, '>', $params{-filename}) or croak($@);
binmode $fh;
print $fh $gd->png;
close $fh;
return 1;
}
#=======================================================================
# TRANSLATIONS #########################################################
#=======================================================================
lib/AI/Genetic/Pro.pm view on Meta::CPAN
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 {
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/){
#@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;
}
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;
@genes = @$values;
}elsif($type eq q/combination/){
die qq/\nToo few elements in the injected chromosome of type "$type": @$values\n/
if $#$values != $#{$data->[0]};
for my $idx(0..$#$values){
my $id = first_index { $_ eq $values->[$idx] } @{$data->[0]}; # pomijamy poczatkowy undef
die qq/\nInproper element in the injected chromosome of type "$type": @$values\n/ if $id == -1;
push @genes, $id;
}
}elsif($type eq q/rangevector/){
for my $idx(0..$#$values){
if(defined $values->[$idx]){
my $min = $data->[$idx]->[1] - $fix_range->[$idx];
my $max = $data->[$idx]->[2] - $fix_range->[$idx];
die qq/\nValue out of scope in the injected chromosome of type "$type": @$values\n/
if $values->[$idx] > $max or $values->[$idx] < $min;
push @genes, $values->[$idx] + $fix_range->[$idx];
}else{ push @genes, 0; }
}
}else{
for my $idx(0..$#$values){
my $id = first_index {
not defined $values->[$idx] and not defined $_ or
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
{
t/01_inject.t view on Meta::CPAN
);
# init population of 32-bit vectors
$ga->init(BITS);
my $population = [ ];
for my $chromosome(@{$ga->chromosomes}){
push @$population, $chromosome->clone;
}
my @data;
for(0..BITS){
my @chromosome;
push @chromosome, rand() < 0.5 ? 1 : 0 for 1..BITS;
push @data, \@chromosome;
}
push @$population, @data;
$ga->inject(\@data);
my $OK = 1;
for(0..$#$population){
my @tmp0 = @{$population->[$_]};
my @tmp1 = @{$ga->chromosomes->[$_]};
unless(compare(\@tmp0, \@tmp1)){
$OK = 0;
last;
}
}
t/06_listvectors_constant_length.t view on Meta::CPAN
-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
-variable_length => 0, # turn variable length OFF
);
my @data;
push @data, [ MIN..MAX ] for 1..SIZE;
$ga->init(\@data);
@data = (
[qw( 4 0 4 0 4 0 4 0 )],
[qw( 0 4 0 4 0 4 0 4 )],
[qw( 4 4 0 0 4 4 0 0 )],
[qw( 4 4 4 4 0 0 0 0 )],
[qw( 0 0 0 0 4 4 4 4 )],
);
push @data, @data for 1..SIZE;
$ga->inject(\@data);
# evolve 1000 generations
$ga->evolve(1000);
ok($Win == $ga->as_value($ga->getFittest));
t/07_listvectors_variable_length_I.t view on Meta::CPAN
-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
-variable_length => 1, # turn variable length OFF
);
my @data;
push @data, [ MIN..MAX ] for 1..SIZE;
$ga->init(\@data);
@data = (
[qw( 4 0 4 0 4 0 4 0 )],
[qw( 0 4 0 4 0 4 0 4 )],
[qw( 4 4 0 0 4 4 0 0 )],
[qw( 4 4 4 4 0 0 0 0 )],
[qw( 0 0 0 0 4 4 4 4 )],
);
push @data, @data for 1..SIZE;
$ga->inject(\@data);
# evolve 1000 generations
$ga->evolve(1000);
ok($Win == $ga->as_value($ga->getFittest));
t/08_listvectors_variable_length_II.t view on Meta::CPAN
-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
-variable_length => 2, # turn variable length OFF
);
my @data;
push @data, [ MIN..MAX ] for 1..SIZE;
$ga->init(\@data);
@data = (
[qw( 4 0 4 0 4 0 4 0 )],
[qw( 0 4 0 4 0 4 0 4 )],
[qw( 4 4 0 0 4 4 0 0 )],
[qw( 4 4 4 4 0 0 0 0 )],
[qw( 0 0 0 0 4 4 4 4 )],
);
push @data, @data for 1..SIZE;
$ga->inject(\@data);
# evolve 1000 generations
$ga->evolve(1000);
ok($Win == $ga->as_value($ga->getFittest));
t/09_rangevectors_constant_length.t view on Meta::CPAN
-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
-variable_length => 0, # turn variable length OFF
);
my @data;
push @data, [ MIN, MAX ] for 1..SIZE;
$ga->init(\@data);
@data = (
[qw( 4 0 4 0 4 0 4 0 )],
[qw( 0 4 0 4 0 4 0 4 )],
[qw( 4 4 0 0 4 4 0 0 )],
[qw( 4 4 4 4 0 0 0 0 )],
[qw( 0 0 0 0 4 4 4 4 )],
);
push @data, @data for 1..SIZE;
$ga->inject(\@data);
# evolve 1000 generations
$ga->evolve(1000);
ok($Win == $ga->as_value($ga->getFittest));
t/10_rangevectors_variable_length_I.t view on Meta::CPAN
-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
-variable_length => 1, # turn variable length OFF
);
my @data;
push @data, [ MIN, MAX ] for 1..SIZE;
$ga->init(\@data);
@data = (
[qw( 4 0 4 0 4 0 4 0 )],
[qw( 0 4 0 4 0 4 0 4 )],
[qw( 4 4 0 0 4 4 0 0 )],
[qw( 4 4 4 4 0 0 0 0 )],
[qw( 0 0 0 0 4 4 4 4 )],
);
push @data, @data for 1..SIZE;
$ga->inject(\@data);
# evolve 1000 generations
$ga->evolve(1000);
ok($Win == $ga->as_value($ga->getFittest));
t/11_rangevectors_variable_length_II.t view on Meta::CPAN
-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
-variable_length => 2, # turn variable length OFF
);
my @data;
push @data, [ MIN, MAX ] for 1..SIZE;
$ga->init(\@data);
@data = (
[qw( 4 0 4 0 4 0 4 0 )],
[qw( 0 4 0 4 0 4 0 4 )],
[qw( 4 4 0 0 4 4 0 0 )],
[qw( 4 4 4 4 0 0 0 0 )],
[qw( 0 0 0 0 4 4 4 4 )],
);
push @data, @data for 1..SIZE;
$ga->inject(\@data);
# evolve 1000 generations
$ga->evolve(1000);
ok($Win == $ga->as_value($ga->getFittest));
t/12_combinations_constant_length.t view on Meta::CPAN
-strategy => [ 'PMX' ], # crossover strategy
-cache => 1, # cache results
-history => 0, # remember best results
-preserve => 0, # remember the bests
-variable_length => 0, # turn variable length OFF
);
$ga->init( [ 'a'..'h' ] );
my @data = (
[qw( a c b d e g f h )],
[qw( a b d c e f h g )],
[qw( a c b d f e g h )],
[qw( h b c d e f g a )],
);
push @data, @data for 1..scalar(@Win);
$ga->inject(\@data);
# evolve 1000 generations
$ga->evolve(1000);
ok($Win == $ga->as_value($ga->getFittest));
( run in 0.323 second using v1.01-cache-2.11-cpan-ec4f86ec37b )