File Coverage

lib/Algorithm/Evolutionary/Experiment.pm

Criterion	Covered	Total	%
statement	10	12	83.3
branch			n/a
condition			n/a
subroutine	4	4	100.0
pod			n/a
total	14	16	87.5

use strict; #-*-CPerl-*- -*- hi-lock -*-
use warnings;

use lib qw( ../../../lib );

=head1 NAME

Algorithm::Evolutionary::Experiment - Class for setting up an
experiment with algorithms and population

=head1 SYNOPSIS

  use Algorithm::Evolutionary::Experiment;
  my $popSize = 20;
  my $indiType = 'BitString';
  my $indiSize = 64;

  #Algorithm might be anything of type Op
  my $ex = new Algorithm::Evolutionary::Experiment $popSize, $indiType, $indiSize, $algorithm;


=head1 DESCRIPTION

This class contains (as instance variables) an algorithm and a population, and applies one to
the other.  Can be serialized
using XML, and can read an XML description of the experiment.

=head1 METHODS

=cut

package Algorithm::Evolutionary::Experiment;

use Algorithm::Evolutionary::Utils qw(parse_xml);
use Algorithm::Evolutionary qw(Individual::Base
			       Op::Base
			       Op::Creator );

our $VERSION =   sprintf "%d.%03d", q$Revision: 3.3 $ =~ /(\d+)\.(\d+)/g;

use Carp;

=head2 new( $pop_size, $type_of_individual, $individual_size )

Creates a new experiment. An C has two parts: the
   population and the algorithm. The population is created from a set
   of parameters: popSize, indiType and indiSize, and an array of
   algorithms that will be applied sequentially. Alternatively, if
   only operators are passed as an argument, it is understood as an
   array of algorithms (including, probably, initialization of the
   population).

=cut

sub new ($$$$;$) {
  my $class = shift;
  my $self = { _pop => [] };
  if ( index ( ref $_[0], 'Algorithm::Evolutionary') == -1 )   {
    #If the first arg is not an algorithm, create one
    my $popSize = shift || carp "Pop size = 0, can't create\n";
    my $indiType = shift || carp "Empty individual class, can't create\n";
    my $indiSize = shift || carp "Empty individual size, no reasonable default, can't create\n";
    for ( my $i = 0; $i < $popSize; $i ++ ) {
      my $indi = Algorithm::Evolutionary::Individual::Base::new( $indiType,
								 { length => $indiSize } );
      $indi->randomize();
      push @{$self->{_pop}}, $indi;
    }
  };
  @_ || croak "Can't find an algorithm";
  push @{$self->{_algo}}, @_;
  bless $self, $class;
  return $self

}

=head2 fromXML

Creates a new experiment, same as before, but with an L specification. An
example of it follows:


    xsi:noNamespaceSchemaLocation='ea-alpha.xsd'
    version='0.2'>






























This is an alternative constructor. Takes a well-formed string with the XML
spec, which should have been done according to EvoSpec 0.3, or the same
string processed with C, and returns a built experiment

=cut

sub fromXML ($;$) {
  my $class = shift;
  my $xml = shift || carp "XML fragment missing ";
  if ( ref $xml eq ''  ) { #We are receiving a string, parse it
    $xml = parse_xml( $xml );
  }

  my @pop;
  my $self = { _pop => \@pop, #Just an empty reference
	       _xml => $xml }; # Create a reference
  #Process operators
  for ( @{ ref $xml->{'ea'}->{'initial'}->{'op'} eq 'ARRAY' ?
	 $xml->{'ea'}->{'initial'}->{'op'}:
	   [ $xml->{'ea'}->{'initial'}->{'op'}]} ) { #Should process the  tag
    push( @{$self->{'_algo'}},
	  Algorithm::Evolutionary::Op::Base::fromXML( $_->{'-name'},$_ ) );
  }

  #Process population
  if ( $xml->{'ea'}->{'initial'}->{'pop'} ) {
    my $pop_hash = $xml->{'ea'}->{'initial'}->{'pop'};
    my $size = $pop_hash->{'-size'};
    my $type;
    my %params;
    for my $p ( @{$pop_hash->{'param'}} ) {
      if ( $p->{'-name'} eq 'type' ) {
 	$type = $p->{'-value'};
      } else {
 	$params{ $p->{'-name'} } = $p->{'-value'};
      }
    }
    my $creator = new Algorithm::Evolutionary::Op::Creator  $size, $type, \%params ;

     $creator->apply( \@pop );
     push( @{$self->{_pop}}, @pop ) ;
  }

  #Process population, if it exists
  if ( $xml->{'ea'}->{'pop'} ) { #Process runtime population
    for my $i (  @{$xml->{'ea'}->{'pop'}->{'indi'}} ) {
      push( @{$self->{_pop}},
	    Algorithm::Evolutionary::Individual::Base::fromXML( $i->{'-type'}, $i ) );
    }
  }
  #Bless and return
  bless $self, $class;

  return $self;
}


=head2 go

Applies the different operators in the order that they appear; returns the population
as a ref-to-array.

=cut

sub go {
  my $self = shift;
  for ( @{$self->{_algo}} ) {
	$_->apply( $self->{_pop} );
  }
  return $self->{_pop}
}

=head2 asXML

Opposite of fromXML; serializes the object in XML. First the operators, and then
the population

=cut

sub asXML {
  my $self = shift;
  my $str=<<'EOC';



EOC

  for ( @{$self->{_algo}} ) {
	$str.= $_->asXML()."\n";
  }

  $str .="\t\n\n";
   for ( @{$self->{_pop}} ) {
	$str .= $_->asXML()."\n";
  }
  $str .="\n\t\n\n";
  return $str;
}

=head2 SEE ALSO

L , another option for setting up
experiments, which is the one you should rather use, as XML support is
going to be deprecated (some day).

=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: 2012/07/11 06:14:51 $
  $Header: /media/Backup/Repos/opeal/opeal/Algorithm-Evolutionary/lib/Algorithm/Evolutionary/Experiment.pm,v 3.3 2012/07/11 06:14:51 jmerelo Exp $
  $Author: jmerelo $
  $Revision: 3.3 $

=cut

"What???";