view release on metacpan or  search on metacpan

lib/Algorithm/Evolutionary/Op/Easy_MO.pm  view on Meta::CPAN

}

=head2 set( $hashref, codehash, opshash )

Sets the instance variables. Takes a ref-to-hash (for options), codehash (for fitness) and opshash (for operators)

=cut

sub set {
  my $self = shift;
  my $hashref = shift || croak "No params here";
  my $codehash = shift || croak "No code here";
  my $opshash = shift || croak "No ops here";
  $self->{_selrate} = $hashref->{selrate};

  for ( keys %$codehash ) {
    $self->{"_$_"} =  eval "sub {  $codehash->{$_} } " || carp "Error compiling fitness function: $! => $@";
  }

  $self->{_ops} =();
  for ( keys %$opshash ) {
    #First element of the array contains the content, second the rate.
    push @{$self->{_ops}},  
      Algorithm::Evolutionary::Op::Base::fromXML( $_, $opshash->{$_}->[1], $opshash->{$_}->[0] );
  }

}

=head2 apply( $population )

Applies the algorithm to the population; checks that it receives a
ref-to-array as input, croaks if it does not. Returns a sorted,
culled, evaluated population for next generation.

=cut

sub apply ($) {
  my $self = shift;
  my $pop = shift || croak "No population here";

  #Evaluate
  my $eval = $self->{_eval};
  my @ops = @{$self->{_ops}};
  $self->{'_rank'}->apply( $pop );

  #Sort
  my @popsort = sort { $b->{_fitness} <=> $a->{_fitness}; } @$pop;

  #Cull
  my $pringaos = int(($#popsort+1)*$self->{_selrate}); #+1 gives you size
#  print "Pringaos $pringaos\n";
  splice @popsort, - $pringaos;
#  print "Población ", scalar @popsort, "\n";
 
  #Reproduce
  my @rates = map( $_->{'rate'}, @ops );
  my $opWheel = new Algorithm::Evolutionary::Wheel @rates;

  #Generate offpring;
  my $originalSize = $#popsort; # Just for random choice
  for ( my $i = 0; $i < $pringaos; $i ++ ) {
      my @offspring;
      my $selectedOp = $ops[ $opWheel->spin()];
      for ( my $j = 0; $j < $selectedOp->arity(); $j ++ ) {
	  my $chosen = $popsort[ int ( rand( $originalSize ) )];
	  push( @offspring, $chosen ); #No need to clone, it's not changed in ops
      }
      my $mutante = $selectedOp->apply( @offspring );
      push( @popsort, $mutante );
  }

  #Return
  for ( my $i = 0; $i <= $#popsort; $i++ ) {
#	print $i, "->", $popsort[$i]->asString, "\n";
      $pop->[$i] = $popsort[$i];
  }

  
}

=head1 SEE ALSO

L<Algorithm::Evolutionary::Op::CanonicalGA>.
L<Algorithm::Evolutionary::Op::FullAlgorithm>.
L<Algorithm::Evolutionary::Op::Easy> for the scalar version of this code.

=head1 Copyright
  
  This file is released under the GPL. See the LICENSE file included in this distribution,
  or go to http://www.fsf.org/licenses/gpl.txt

  CVS Info: $Date: 2011/02/14 06:55:36 $ 
  $Header: /media/Backup/Repos/opeal/opeal/Algorithm-Evolutionary/lib/Algorithm/Evolutionary/Op/Easy_MO.pm,v 3.6 2011/02/14 06:55:36 jmerelo Exp $ 
  $Author: jmerelo $ 
  $Revision: 3.6 $
  $Name $

=cut

"The truth is out there";