view release on metacpan or  search on metacpan

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

  if ($fragment->{'code'} ) {
    $code_fragments{$fragment->{'code'}->{'-type'}} = $fragment->{'code'}->{'src'};
  }    
       
  for ( @{$fragment->{'op'}} ) { 
    $ops{$_->{'-name'}} = [$_->{'-rate'}, $_];
  }

  #If the class is not loaded, we load it. The 
  eval "require $class" || croak "Can't find $class Module";

  #Let the class configure itself
  $self->set( \%params, \%code_fragments, \%ops );
  return $self;
}


=head2 asXML( [$id] )

Prints as XML, following the EvoSpec 0.2 XML specification. Should be
called from derived classes, not by itself. Provides a default
implementation of XML serialization, with a void tag that includes the
name of the operator and the rate (all operators have a default
rate). For instance, a C<foo> operator would be serialized as C< E<lt>op
name='foo' rate='1' E<gt> >.

If there is not anything special, this takes also care of the instance
variables different from C<rate>: they are inserted as C<param> within
the XML file. In this case, C<param>s are void tags; if you want
anything more fancy, you will have to override this method. An
optional ID can be used.

=cut

sub asXML {
  my $self = shift;
  my ($opName) = ( ( ref $self) =~ /::(\w+)$/ );
  my $name = shift; #instance variable it corresponds to
  my $str =  "<op name='$opName' ";
  $str .= "id ='$name' " if $name;
  if ( $self->{rate} ) { # "Rated" ops, such as genetic ops
	$str .= " rate='".$self->{rate}."'";
  }
  if (keys %$self == 1 ) {
    $str .= " />" ; #Close void tag, only the "rate" param
  } else {
    $str .= " >";
    for ( keys %$self ) {
      next if !$self->{$_};
      if (!/\brate\b/ ) {
	my ($paramName) = /_(\w+)/;
	if ( ! ref $self->{$_}  ) {
	  $str .= "\n\t<param name='$paramName' value='$self->{$_}' />";
	} elsif ( ref $self->{$_} eq 'ARRAY' ) {
	  for my $i ( @{$self->{$_}} ) {
	    $str .= $i->asXML()."\n";
	  }
	} elsif ( ref $self->{$_} eq 'CODE' ) {
	  my $deparse = B::Deparse->new;
	  $str .="<code type='eval' language='perl'>\n<src><![CDATA[".$deparse->coderef2text($self->{$_})."]]>\n </src>\n</code>";
	} elsif ( (ref $self->{$_} ) =~ 'Algorithm::Evolutionary' ) { #Composite object, I guess...
	  $str .= $self->{$_}->asXML( $_ );
	}
      }
    }
    $str .= "\n</op>";
  }
  return $str;
}

=head2 rate( [$rate] )

Gets or sets the rate of application of the operator

=cut

sub rate {
  my $self = shift ;
  $self->{rate} = shift if @_;
  return $self;
}

=head2 check()

Check if the object the operator is applied to is in the correct
class. 

=cut

sub check {
  my $self = (ref  $_[0] ) ||  $_[0] ;
  my $object =  $_[1];
  my $at = eval ("\$"."$self"."::APPLIESTO");
  return $object->isa( $at ) ;
}

=head2 arity()

Returns the arity, ie, the number of individuals it can be applied to

=cut

sub arity {
  my $class = ref shift;
  return eval( "\$"."$class"."::ARITY" );
}

=head2 set( $options_hashref )

Converts the parameters passed as hash in instance variables. Default
method, probably should be overriden by derived classes. If it is not,
it sets the instance variables by prepending a C<_> to the keys of the
hash. That is, 
    $op->set( { foo => 3, bar => 6} );
will set C<$op-E<gt>{_foo}> and  C<$op-E<gt>{_bar}> to the corresponding values

=cut

sub set {
  my $self = shift;
  my $hashref = shift || croak "No params here";