view release on metacpan or  search on metacpan

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

  my %chars;
  map ( $chars{$_} = 1, split(//,$str) );
  my @chars = keys %chars; 
  $self->{_length} = length( $str  );
  $self->{'_chars'} = \@chars;
  return $self;
}

=head2 from_string

Similar to a copy ctor; creates a bitstring individual from a string. 

=cut

sub from_string  {
  my $class = shift; 
  my $chars = shift;
  my $str = shift;
  my $self = Algorithm::Evolutionary::Individual::Base::new( $class );
  $self->{'_chars'} = $chars;
  $self->{'_str'} =  $str;
  $self->{'_length'} = length( $str  );
  return $self;
}

=head2 clone

Similar to a copy ctor: creates a new individual from another one

=cut

sub clone {
  my $indi = shift || croak "Indi to clone missing ";
  my $self = { '_fitness' => undef };
  bless $self, ref $indi;
  for ( qw( _chars _str _length)  ) {
	$self->{ $_ } = $indi->{$_};
  }
  return $self;
}


=head2 asString

Returns the individual as a string with the fitness as a suffix.

=cut

sub asString {
  my $self = shift;
  my $str = $self->{'_str'} . " -> ";
  if ( defined $self->{'_fitness'} ) {
	$str .=$self->{'_fitness'};
  }
  return $str;
}

=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 {
  my $self = shift;
  my $index = shift;
  if ( @_ ) {
    substr( $self->{_str}, $index, 1 ) = substr(shift,0,1);
  } else {
    substr( $self->{_str}, $index, 1 );
  }
}

=head2 TIE methods

String implements FETCH, STORE, PUSH and the rest, so an String
can be tied to an array and used as such.

=cut

sub FETCH {
  my $self = shift;
  return $self->Atom( @_ );
}

sub STORE {
  my $self = shift;
  $self->Atom( @_ );
}

sub PUSH {
  my $self = shift;
  $self->{_str}.= join("", @_ );
}

sub UNSHIFT {
  my $self = shift;
  $self->{_str} = join("", @_ ).$self->{_str} ;
}

sub POP {
  my $self = shift;
  my $pop = substr( $self->{_str}, length( $self->{_str} )-1, 1 );
  substr( $self->{_str}, length( $self->{_str} ) -1, 1 ) = ''; 
  return $pop;
}

sub SHIFT {
  my $self = shift;
  my $shift = substr( $self->{_str}, 0, 1 );
  substr( $self->{_str}, 0, 1 ) = ''; 
  return $shift;
}

sub SPLICE {
  my $self = shift;
  my $offset = shift;
  my $length = shift || length( $self->{'_str'} - $offset );
  my $sub_string =  substr( $self->{_str}, $offset, $length );
#  if ( @_ ) {