view release on metacpan or  search on metacpan

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

sub clone {
  my $indi = shift || croak "Indi to clone missing ";
  my $self = { _fitness => undef,
	       _depth => $indi->{_depth} };
  %{$self->{_primitives}} =  %{$indi->{_primitives}};
  @{$self->{_keys}} =  @{$indi->{_keys}};			      
  $self->{_tree} = $indi->{_tree}->copy_tree();
  bless $self, __PACKAGE__;
  return $self;
}


=head2 asString

Prints it

=cut

sub asString {
  my $self = shift;
  #my $lol =  $self->{_tree}->tree_to_lol();
#  my $str = lolprint( @$lol );
#  $str .= " -> ";
#  if ( defined $self->{_fitness} ) {
#	$str .=$self->{_fitness};
#  }
  my $node =  $self->{_tree};
  my $str;
  $node->walk_down( { callback => \&nodePrint,
					  callbackback => \&closeParens,
					  str => \$str,
					  primitives => $self->{_primitives}} );
#  print $self->{_tree}->tree_to_lol_notation();
  return $str;
}

=head2 nodePrint

Prints a node

=cut

sub nodePrint {
  my $node = shift;
  my $options = shift;
  my $strRef = $options->{str};
  ${$strRef} .= ($node->attributes()->{constant}?($node->attributes()->{constant}. "*"):""). $node->name();
  if ( $options->{primitives}{$node->name()}[0] > 0 ) { #That's the arity
	${$strRef} .= "( ";
  } elsif ( $options->{primitives}{$node->name()}[0] == 0 ){ #Add comma
    if ($node->right_sister() ) {
      ${$strRef} .= ", ";
    }
  }
  
}

=head2 closeParens

Internal subrutine: closes node parenthesis

=cut 

sub closeParens {
  my $node = shift;
  my $options = shift;
  my $strRef = $options->{str};
  if ( $options->{primitives}{$node->name()}[0] > 0 ) { #That's the arity
	${$strRef} .= " ) ";
    if ($node->right_sister() ) {
      ${$strRef} .= ", ";
    }
  }
 
}


=head2 Atom

Returns the tree, which is atomic by itself. Cannot be used as lvalue

=cut

sub Atom {
  my $self = shift;
  return $self->{'_tree'};
}

=head2 asXML

Prints it as XML. It prints the tree as String, which does not mean
you will be able to get it back from this form. It's done just for
compatibity, reading from this format will be available. In the future.

=cut

sub asXML {
  my $self = shift;
  my $str = $self->SUPER::asXML();
#  my $str2 = ">\n<atom><![CDATA[".$self->asString()."]]></atom> ";
  my $str2 = ">\n<atom><![CDATA[dummy root node]]></atom> ";
  $str =~ s/\/>/$str2/e ;
  return $str.$str2."\n</indi>";
}


=head2 addAtom

Dummy sub

=cut 

sub addAtom {
  my $self = shift;
  $self->{_tree} = Tree::DAG_Node->new();
  $self->{'_tree'}->name( "dummy root node" ); #Root node
  $self->{'_tree'}->attributes( { constant => 0 } );
}

=head2 lolprint