File Coverage

blib/lib/POE/Component/Algorithm/Evolutionary.pm

Criterion	Covered	Total	%
statement	19	21	90.4
branch			n/a
condition			n/a
subroutine	7	7	100.0
pod			n/a
total	26	28	92.8

package POE::Component::Algorithm::Evolutionary;

use lib qw( ../../../../../Algorithm-Evolutionary/lib ../../../../../../Algorithm-Evolutionary/lib ../Algorithm-Evolutionary/lib ); #For development and perl syntax mode

use warnings;
use strict;
use Carp;

use version; our $VERSION = qv('0.2.1');

use POE;
use Algorithm::Evolutionary;


sub AUTOLOAD {
  my $self = shift;
  our $AUTOLOAD;
  my ($method) = ($AUTOLOAD =~ /::(\w+)$/);
  return if !$self->{'session'}; # Before creation or after destruction
  my $heap = $self->{'session'}->get_heap();
  if ( $method =~ /^set_(\w+)/ ) {
      my $instanceVar = $1;
      if (defined ($heap->{$instanceVar})) {
	  $heap->{$instanceVar} = shift;
      }
  } else {
      my $instanceVar = lcfirst($method);
      if (defined ($heap->{$instanceVar})) {
	  return $heap->{$instanceVar};
      }

  }
}


# Module implementation here
sub new {
  my $class = shift;
  my %args = @_;

  my $options = {};
  for my $option ( qw( Fitness Creator Single_Step Terminator Alias ) ) {
      $options->{lc($option)} = $args{$option} || croak "$option required";
  }

  for my $option ( qw( Replacer After_Step ) ) {
      $options->{lc($option)} = $args{$option};
  }

  my $self = { alias => $options->{'alias' }};
  bless $self, $class;

  my $session = POE::Session->create(inline_states => { _start => \&start,
							generation => \&generation,
							after_step => \&after_step,
							finish => \&finishing},
				     args  => [$options->{'alias'}, $self, $options]
				    );
  $self->{'session'} = $session;
  return $self;
}

sub _start_base {
    my ($kernel, $heap, $alias, $self, $options )=
	    @_[KERNEL, HEAP, ARG0, ARG1, ARG2 ];
    $kernel->alias_set($alias);
    for my $option ( keys %$options ) {
	$heap->{$option} = $options->{$option};
    }
    $heap->{'self'} = $self;
    my @pop;
    $options->{'creator'}->apply( \@pop );
    map( $_->evaluate($options->{'fitness'}), @pop );
    $heap->{'population'} = \@pop;

}

# Create stuff and get ready to go
sub start {
    _start_base( @_ );
    $_[KERNEL]->yield('generation');
}


sub new_population {
    my ($kernel, $heap, $new_population ) = @_[KERNEL, HEAP, ARG0];
    if ( $heap->{'replacer'} ) {
	$heap->{'replacer'}->apply($heap->{'population'}, $new_population );
    } else {
	splice( @{$heap->{'population'}}, -@{$new_population} );
	push @{$heap->{'population'}}, @{$new_population} ;
    }
    $kernel->yield('generation');
}

sub after_step {
    my ($kernel, $heap, $arg ) = @_[KERNEL, HEAP, ARG0];
    if ( $heap->{'after_step'} ){
	if ( ref $heap->{'after_step'} eq 'CODE' ) {
	    $heap->{'after_step'}->( $heap->{'population'}, $arg );
	} else {
	    $heap->{'after_step'}->apply( $heap->{'population'}, $arg );
	}
    }
    $kernel->yield('generation');
}

#Evolve population
sub generation {
  my ($kernel, $heap ) = @_[KERNEL, HEAP];
  $heap->{'single_step'}->apply( $heap->{'population'} );
  if ( ! $heap->{'terminator'}->apply( $heap->{'population'} ) ) {
    $kernel->yield( 'finish' );
  } else {
    $kernel->yield( 'after_step' );
  }

}

#Finish here
sub finishing {
  my ($kernel, $heap ) = @_[KERNEL, HEAP];
  print "Best is:\n\t ",$heap->{'population'}->[0]->asString()," Fitness: ",
    $heap->{'population'}->[0]->Fitness(),"\n";
}

"Don't look further" ; # Magic true value required at end of module
__END__