view release on metacpan or  search on metacpan

lib/Algorithm/Evolutionary/Individual/Bit_Vector.pm  view on Meta::CPAN

=head1 Base Class

L<Algorithm::Evolutionary::Individual::String|Algorithm::Evolutionary::Individual::String>

=head1 DESCRIPTION

Bitstring Individual for a Genetic Algorithm. Used, for instance, in a canonical GA

=cut

package Algorithm::Evolutionary::Individual::Bit_Vector;

use Carp;
use Bit::Vector;
use String::Random; # For initial string generation

our ($VERSION) =  ( '$Revision: 3.1 $ ' =~ / (\d+\.\d+)/ );

use base 'Algorithm::Evolutionary::Individual::Base';

use constant MY_OPERATORS => ( qw(Algorithm::Evolutionary::Op::BitFlip Algorithm::Evolutionary::Op::Mutation )); 
 

=head1 METHODS

=head2 new( $arg )

Creates a new bitstring individual. C<$arg> can be either { length =>
    $length} or { string => [binary string] }. With no argument, a
    length of 16 is given by default.

=cut

sub new {
    my $class = shift; 
    my $self = Algorithm::Evolutionary::Individual::Base::new( $class );
    my $arg = shift || { length => 16};
    if ( $arg =~ /^\d+$/ ) { #It's a number
      $self->{'_bit_vector'} = _create_bit_vector( $arg );
    } elsif ( $arg->{'length'} ) {
      $self->{'_bit_vector'} = _create_bit_vector( $arg->{'length'} );
    } elsif ( $arg->{'string'} ) {
      $self->{'_bit_vector'} = 
	Bit::Vector->new_Bin( length($arg->{'string'}), $arg->{'string'} );
    } 
    croak "Incorrect creation options" if !$self->{'_bit_vector'};
    return $self;
}

sub _create_bit_vector {
   my $length = shift || croak "No length!";
   my $rander = new String::Random;
   my $hex_string = $rander->randregex("[0-9A-F]{".int($length/4)."}");
   return Bit::Vector->new_Hex( $length, $hex_string );
}

sub TIEARRAY {
  my $class = shift; 
  my $self = { _bit_vector => Bit::Vector->new_Bin(scalar( @_), join("",@_)) };
  bless $self, $class;
  return $self;
}

=head2 Atom

Sets or gets the value of the n-th character in the string. Counting
starts at 0, as usual in Perl arrays.

=cut

sub Atom: lvalue {
  my $self = shift;
  my $index = shift;
  my $last_index = $self->{'_bit_vector'}->Size()-1;
  if ( @_ ) {
      $self->{'_bit_vector'}->Bit_Copy($last_index-$index, shift );
  } else {
      $self->{'_bit_vector'}->bit_test($last_index - $index);
  }
}

=head2 size()

Returns size in bits 

=cut

sub size {
    my $self = shift;
    return $self->{'_bit_vector'}->Size();
}

=head2 clone()

Clones using native methods. Does not work with general Clone::Fast, since it's implemented as an XS

=cut

sub clone {
    my $self = shift;
    my $clone = Algorithm::Evolutionary::Individual::Base::new( ref $self );
    $clone->{'_bit_vector'} = $self->{'_bit_vector'}->Clone();
    return $clone;
}

=head2 as_string() 

Overrides the default; prints the binary chromosome 

=cut

sub as_string {
  my $self = shift;
  return $self->{'_bit_vector'}->to_Bin();
}

=head2 Chrom()

Returns the internal bit_vector