AI-Genetic-Pro

 view release on metacpan or  search on metacpan

README  view on Meta::CPAN

              0 0 1 1 0 1 1 1 1
              0 1 1 1 0 1 0 0 1 1 0 1 1 1
              0 1 0 0 1 1 0 1 1 1
              # ...and so on
                  

	level 2

	  Feature is active and chromosomes can varies on the left side and
	  on the right side; unwanted values/genes on the left side are
	  replaced with undef, ie.

                  -variable_length => 2
           
              # chromosomes (i.e. bitvectors)
              x x x 0 1 1 0 1 1 1 
              x x x x 0 1 1 1 1
              x 1 1 1 0 1 0 0 1 1 0 1 1 1
              0 1 0 0 1 1 0 1 1 1
              # where 'x' means 'undef'
              # ...and so on

	  In this situation returned chromosomes in an array context
	  ($ga->as_array($chromosome)) can have undef values on the left
	  side (only). In a scalar context each undefined value is replaced
	  with a single space. If You don't want to see any undef or space,
	  just use as_array_def_only and as_string_def_only instead of
	  as_array and as_string.

      -parents

	This defines how many parents should be used in a crossover.

      -selection

	This defines how individuals/chromosomes are selected to crossover.

README  view on Meta::CPAN

	genes looks something like that:

            [ 'a', 'b', 'c' ]    # gene 1
            [ 'c', 'a', 'b' ]    # gene 2
            [ 'b', 'c', 'a' ]    # gene 3
            # ...and so on...

    $ga->evolve($n)

      This method causes the GA to evolve the population for the specified
      number of generations. If its argument is 0 or undef GA will evolve
      the population to infinity unless a terminate function is specified.

    $ga->getHistory()

      Get history of the evolution. It is in a format listed below:

              [
                      # gen0   gen1   gen2   ...          # generations
                      [ max0,  max1,  max2,  ... ],       # max values
                      [ mean,  mean1, mean2, ... ],       # mean values

README  view on Meta::CPAN


    $ga->load($file)

      Load a state of the genetic algorithm from the specified file.

    $ga->as_array($chromosome)

      In list context return an array representing the specified
      chromosome. In scalar context return an reference to an array
      representing the specified chromosome. If variable_length is turned
      on and is set to level 2, an array can have some undef values. To get
      only not undef values use as_array_def_only instead of as_array.

    $ga->as_array_def_only($chromosome)

      In list context return an array representing the specified
      chromosome. In scalar context return an reference to an array
      representing the specified chromosome. If variable_length is turned
      off, this function is just an alias for as_array. If variable_length
      is turned on and is set to level 2, this function will return only
      not undef values from chromosome. See example below:

          # -variable_length => 2, -type => 'bitvector'
              
          my @chromosome = $ga->as_array($chromosome)
          # @chromosome looks something like that
          # ( undef, undef, undef, 1, 0, 1, 1, 1, 0 )
              
          @chromosome = $ga->as_array_def_only($chromosome)
          # @chromosome looks something like that
          # ( 1, 0, 1, 1, 1, 0 )

    $ga->as_string($chromosome)

      Return a string representation of the specified chromosome. See
      example below:

README  view on Meta::CPAN

              
              # or 
              
              # -type => 'listvector'
              
              $string = $ga->as_string($chromosome);
              # $string looks something like that
              # element0___element1___element2___element3...

      Attention! If variable_length is turned on and is set to level 2, it
      is possible to get undef values on the left side of the vector. In
      the returned string undef values will be replaced with spaces. If you
      don't want to see any spaces, use as_string_def_only instead of
      as_string.

    $ga->as_string_def_only($chromosome)

      Return a string representation of specified chromosome. If
      variable_length is turned off, this function is just alias for
      as_string. If variable_length is turned on and is set to level 2,
      this function will return a string without undef values. See example
      below:

              # -variable_length => 2, -type => 'bitvector'
              
              my $string = $ga->as_string($chromosome);
              # $string looks something like that
              #  ___ ___ ___1___1___0 
              
              $string = $ga->as_string_def_only($chromosome);
              # $string looks something like that

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

	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){

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

#=======================================================================
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,
		_mutator	=> undef,
	};
	
	$clone->{ chromosomes } = [ map { ${ tied( @$_ ) } } @{ $self->chromosomes } ] 
		if $self->_package;
	
	foreach my $key(keys %$self){
		next if exists $clone->{$key};
		$clone->{$key} = $self->{$key};
	}
	

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

		#return @$chromosome if wantarray;
		#return $chromosome;
		
		my @chr = @$chromosome;
		return @chr if wantarray;
		return \@chr;
		
	}elsif($self->type eq q/rangevector/){
		my $fix_range = $self->_fix_range;
		my $c = -1;
		#my @array = map { $c++; warn "WARN: $c | ",scalar @$chromosome,"\n" if not defined $fix_range->[$c]; $_ ? $_ - $fix_range->[$c] : undef } @$chromosome;
		my @array = map { $c++; $_ ? $_ - $fix_range->[$c] : undef } @$chromosome;
		
		return @array if wantarray;
		return \@array;
	}else{
		my $cnt = 0;
		my @array = map { $self->_translations->[$cnt++]->[$_] } @$chromosome;
		return @array if wantarray;
		return \@array;
	}
}

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

		}
		$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) = @_;
	

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

    # chromosomes (i.e. bitvectors)
    0 1 0 0 1 1 0 1 1 1 
    0 0 1 1 0 1 1 1 1
    0 1 1 1 0 1 0 0 1 1 0 1 1 1
    0 1 0 0 1 1 0 1 1 1
    # ...and so on
	
=item level 2 

Feature is active and chromosomes can varies B<on the left side and on 
the right side>; unwanted values/genes on the left side are replaced with C<undef>, ie.
 
	-variable_length => 2
 
    # chromosomes (i.e. bitvectors)
    x x x 0 1 1 0 1 1 1 
    x x x x 0 1 1 1 1
    x 1 1 1 0 1 0 0 1 1 0 1 1 1
    0 1 0 0 1 1 0 1 1 1
    # where 'x' means 'undef'
    # ...and so on

In this situation returned chromosomes in an array context ($ga-E<gt>as_array($chromosome)) 
can have B<undef> values on the left side (only). In a scalar context each 
undefined value is replaced with a single space. If You don't want to see
any C<undef> or space, just use C<as_array_def_only> and C<as_string_def_only> 
instead of C<as_array> and C<as_string>.

=back

=item -parents  

This defines how many parents should be used in a crossover.

=item -selection

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

    [ 'a', 'b', 'c' ]    # gene 1
    [ 'c', 'a', 'b' ]    # gene 2
    [ 'b', 'c', 'a' ]    # gene 3
    # ...and so on...

=back

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

This method causes the GA to evolve the population for the specified number of
generations. If its argument is 0 or C<undef> GA will evolve the population to
infinity unless a C<terminate> function is specified.

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

Get history of the evolution. It is in a format listed below:

	[
		# gen0   gen1   gen2   ...          # generations
		[ max0,  max1,  max2,  ... ],       # max values
		[ mean,  mean1, mean2, ... ],       # mean values

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


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

Load a state of the genetic algorithm from the specified file. 

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

In list context return an array representing the specified chromosome. 
In scalar context return an reference to an array representing the specified 
chromosome. If I<variable_length> is turned on and is set to level 2, an array 
can have some C<undef> values. To get only C<not undef> values use 
C<as_array_def_only> instead of C<as_array>.

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

In list context return an array representing the specified chromosome. 
In scalar context return an reference to an array representing the specified 
chromosome. If I<variable_length> is turned off, this function is just an
alias for C<as_array>. If I<variable_length> is turned on and is set to 
level 2, this function will return only C<not undef> values from chromosome. 
See example below:

    # -variable_length => 2, -type => 'bitvector'
	
    my @chromosome = $ga->as_array($chromosome)
    # @chromosome looks something like that
    # ( undef, undef, undef, 1, 0, 1, 1, 1, 0 )
	
    @chromosome = $ga->as_array_def_only($chromosome)
    # @chromosome looks something like that
    # ( 1, 0, 1, 1, 1, 0 )

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

Return a string representation of the specified chromosome. See example below:

	# -type => 'bitvector'

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

	
	# or 
	
	# -type => 'listvector'
	
	$string = $ga->as_string($chromosome);
	# $string looks something like that
	# element0___element1___element2___element3...

Attention! If I<variable_length> is turned on and is set to level 2, it is 
possible to get C<undef> values on the left side of the vector. In the returned
string C<undef> values will be replaced with B<spaces>. If you don't want
to see any I<spaces>, use C<as_string_def_only> instead of C<as_string>.

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

Return a string representation of specified chromosome. If I<variable_length> 
is turned off, this function is just alias for C<as_string>. If I<variable_length> 
is turned on and is set to level 2, this function will return a string without
C<undef> values. See example below:

	# -variable_length => 2, -type => 'bitvector'
	
	my $string = $ga->as_string($chromosome);
	# $string looks something like that
	#  ___ ___ ___1___1___0 
	
	$string = $ga->as_string_def_only($chromosome);
	# $string looks something like that
	# 1___1___0 

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

	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;

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

	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
{



( run in 1.301 second using v1.01-cache-2.11-cpan-d80b1682f3f )