Treefam Node
SummaryPackage variablesSynopsisDescriptionGeneral documentationMethods
Summary
 Treefam::Node.pm
Package variables
Privates (from "my" definitions)
$_internalID = 0
%_valid_tags = (O=>'sequence_id', Sd=>'', B=>'bootstrap', S=>'taxon', G=>'gene', E=>'gene_loss', D=>'is_duplication', Com=>'')
Included modules
Carp
Scalar::Util qw ( weaken )
Treefam::Tree
Synopsis
Description
 Representation of a node in a Treefam tree.
 Current NHX tags valid in Treefam are:

    B     bootstrap value
    S     taxon name
    D     'Y' for duplication, 'N' for speciation, or not defined
    O     sequence ID
    G     gene ID
    E     gene loss stored in a string like "$-Eutheria-DROME"
Methods
_get_new_internalID
No description
Code
_is_valid_tag
No description
Code
bootstrapDescriptionCode
branch_lengthDescriptionCode
childrenDescriptionCode
geneDescriptionCode
gene_lossDescriptionCode
get_all_ancestorsDescriptionCode
get_all_tagsDescriptionCode
get_tag_valueDescriptionCode
heightDescriptionCode
idDescriptionCode
internalIDDescriptionCode
is_duplicationDescriptionCode
is_leafDescriptionCode
is_speciationDescriptionCode
nameDescriptionCode
newDescriptionCode
parentDescriptionCode
sequence_idDescriptionCode
species_nameDescriptionCode
taxonDescriptionCode
Methods description
bootstrapcode    nextTop
 Arg: (optional) integer
 Description: Gets/sets the bootstrap value attached to the node.
 Returntype: integer
branch_lengthcodeprevnextTop
 Arg: (optional) double
 Description: Gets/sets the branch length value attached to
              the node.
 Returntype: double
childrencodeprevnextTop
 Arg: (optional) list of Treefam::Node objects
 Description: Gets/sets the children of the node.
 Returntype: list of Treefam::Node objects
genecodeprevnextTop
 Arg: (optional) Treefam::Gene
 Description: Gets/sets the gene attached to the node.
              Works only for leaves.
 Returntype: Treefam::Gene
gene_losscodeprevnextTop
 Arg: (optional) string
 Description: Gets/sets the gene/taxon loss event attached to
              the node
 Returntype: string
get_all_ancestorscodeprevnextTop
 Description: Gets list of all ancestors of this node. The list
              is ordered from parent to grand-parent, etc up to
              the root of the tree.
 Returntype: list of Treefam::Node objects
get_all_tagscodeprevnextTop
 Description: Gets all the tags attached to the node.
 Returntype: list of string
get_tag_valuecodeprevnextTop
 Arg: (optional) string
 Description: Gets the value associated with the given tag
              attached to the node.
 Returntype: string
heightcodeprevnextTop
 Arg: (optional) double
 Description: Gets/sets distance of node to root of the tree as
              cumulative sum of branch lengths
 Returntype: double
idcodeprevnextTop
 Arg: (optional) string
 Description: Gets/sets the node id. Synonym for name.
 Returntype: string
internalIDcodeprevnextTop
 Description: Gets the id used internally to uniquely identify
              the node.
 Returntype: integer
is_duplicationcodeprevnextTop
 Arg: (optional) character: Y or N
 Description: Gets/sets the node's status as a duplication event
 Returntype: 1 or 0
is_leafcodeprevnextTop
 Description: Gets/sets the node's status as a leaf.
              A leaf is a node with no children
 Returntype: 1 or 0
is_speciationcodeprevnextTop
 Arg: (optional) character: Y or N
 Description: Gets/sets the node's status as a speciation event
 Returntype: 1 or 0
namecodeprevnextTop
 Arg: (optional) string
 Description: Gets/sets the node name. Synonym for id.
 Returntype: string
newcodeprevnextTop
 Arg1: Treefam::DBConnection object
 Arg2: (optional) node as an unblessed hash ref,
       used by Treefam::Tree->new
 Description: Creates a new Treefam node object.
 Returntype: Treefam::Node
parentcodeprevnextTop
 Arg: (optional) Treefam::Node object
 Description: Gets/sets the node's parent.
 Returntype: Treefam::Node object
sequence_idcodeprevnextTop
 Arg: (optional) string
 Description: Gets/sets the id of the sequence attached to
              the node.
 Returntype: string
species_namecodeprevnextTop
 Arg1: (optional) 'latin' or 'swcode'
 Arg2: (optional) species name to attach to this node
 Description: Gets/sets species name of the node in specified
              format, default is latin name
 Returntype: string
taxoncodeprevnextTop
 Arg: (optional) string
 Description: Gets/sets the node's taxon.
 Returntype: string
Methods code
_get_new_internalIDdescriptionprevnextTop
sub _get_new_internalID {
    return ++$_internalID;
}
_is_valid_tagdescriptionprevnextTop
sub _is_valid_tag {
    my $tag = shift;
    return $_valid_tags{$tag};
}
bootstrapdescriptionprevnextTop
sub bootstrap {
  my $self = shift;
  $self->{B} = shift if @_;

  return $self->{B};
}
branch_lengthdescriptionprevnextTop
sub branch_length {
  my $self = shift;
  $self->{dist} = shift if @_;

  return $self->{dist};
}
childrendescriptionprevnextTop
sub children {
  my $self = shift;
  @{$self->{C}} = @_ if @_;

  return @{$self->{C}} if $self->{C};
}
genedescriptionprevnextTop
sub gene {
  my $self = shift;
  if (@_) {
    $self->{'gene'} = shift;
    $self->{G} = ref($self->{'gene'})?$self->{'gene'}->ID:$self->{'gene'};
  }
  if (!$self->{'gene'}) {
    my ($geneID) = $self->{G};
    my $dbc = $self->{'DBConnection'};
    my $gh = $dbc->get_GeneHandle;
    if ($geneID) {
      $self->{'gene'} = $gh->get_by_id($geneID);
    }
    else {
      # try getting gene using sequence id
      my $seqID = $self->sequence_id;
      if ($seqID) {
	my $query = qq(SELECT GID FROM genes WHERE ID='$seqID');
	my $dbh = $dbc->get_DatabaseHandle;
	my $sth = $dbh->prepare($query);
	$sth->execute;
	($geneID) = $sth->fetchrow_array;
	$self->{'gene'} = $gh->get_by_id($geneID) if $geneID;
      }
    }
  }

  return $self->{'gene'};
}
gene_lossdescriptionprevnextTop
sub gene_loss {
  my $self = shift;
  if (@_) {
    $self->{E} = shift;
    $self->{E} = "$-".$self->{E} unless ($self->{E}=~/^\$-/);
  }
  if ($self->{E}) {
    (my $loss = $self->{E})=~s/^\$-//;
    return $loss;
  }
  return undef;
}
get_all_ancestorsdescriptionprevnextTop
sub get_all_ancestors {
  my $self = shift;
  my $parent = $self->parent;
  my @ancestors;
  while ($parent){
    push @ancestors,$parent;
    $parent = $parent->parent;
  }
  return @ancestors;
}
get_all_tagsdescriptionprevnextTop
sub get_all_tags {
  my $self = shift;

  return grep { _is_valid_tag($_) } keys %{$self};
}
get_tag_valuedescriptionprevnextTop
sub get_tag_value {
 my $self = shift;
 my $tag = shift;
 croak "ERROR: Need a tag" unless $tag;
 croak "ERROR: Not a valid tag" unless _is_valid_tag($tag);
 return $self->{$tag};
}
heightdescriptionprevnextTop
sub height {
  my $self = shift;
  $self->{'height'} = shift if @_;
  if (!$self->{'height'}) {
    my $node = $self;
    my $height = $node->branch_length;
    while( my $parent = $node->parent) {
      $height += $parent->branch_length if ($parent->branch_length);
      $node = $parent;
    }
    $self->{'height'} = $height;
  }
  return $self->{'height'};
}
iddescriptionprevnextTop
sub id {
  my $self = shift;
  $self->{N} = shift if @_;

  return $self->{N};
}
internalIDdescriptionprevnextTop
sub internalID {
  my $self = shift;
  return $self->{'internalID'};
}
is_duplicationdescriptionprevnextTop
sub is_duplication {
  my $self = shift;
  $self->{D} = shift if @_;

  my $is_dup = uc($self->{D}) eq 'Y' ? 1 : 0;

  return $is_dup;
}
is_leafdescriptionprevnextTop
sub is_leaf {
  my $self = shift;
  $self->{'is_leaf'} = shift if @_;
  if (!$self->{'is_leaf'}) {
    # a leaf has no children
     $self->{'is_leaf'} = $self->children ? 0:1;
  }
  return $self->{'is_leaf'};
}
is_speciationdescriptionprevnextTop
sub is_speciation {
  my $self = shift;
  $self->{D} = shift if @_;

  my $is_spec = uc($self->{D}) eq 'N' ? 1 : 0;

  return $is_spec;
}
namedescriptionprevnextTop
sub name {
  my $self = shift;
  $self->{N} = shift if @_;

  return $self->{N};
}
newdescriptionprevnextTop
sub new {
  my $class = shift;
  my $dbc = shift if @_;
  my $self;
  if (@_) {
    $self = shift;
  }
  else {
    $self = {};
  }
  $self->{'DBConnection'} = $dbc;
  weaken($self->{'DBConnection'});

  $self->{'internalID'} = $class->_get_new_internalID;

  bless ($self, $class);

  return $self;
}
parentdescriptionprevnextTop
sub parent {
  my $self = shift;
  $self->{P} = shift if @_;

  return $self->{P};
}
sequence_iddescriptionprevnextTop
sub sequence_id {
  my $self = shift;
  $self->{O} = shift if @_;

  return $self->{O};
}
species_namedescriptionprevnextTop
sub species_name {
  my $self = shift;
  my $format = lc(shift) if @_;
  $format ||= 'latin';
  if ($format ne 'latin' && $format ne 'swcode') {
    croak "Argument must be 'latin' or 'swcode'";
  }
  $self->{'species'}{$format} = shift if @_;

  if (!$self->{'species'}{$format}) {
    my $dbc = $self->{'DBConnection'};
    my $dbh = $dbc->get_DatabaseHandle;
    my $sp = $self->get_tag_value('S');
    my $name;
    my $column = $format eq 'swcode' ? 'SWCODE' : 'TAXNAME';
    if ($self->is_leaf) {
      my $query = qq(SELECT $column FROM species WHERE TAXNAME = ? OR SWCODE = ? );
      my $sth = $dbh->prepare($query);
      $sth->execute($sp,$sp);
      ($name) = $sth->fetchrow_array;
      $column = $format eq 'swcode' ? 'SWCODE' : 'NAME';
      if (!$name) {
	$query = qq(SELECT $column FROM spec_names WHERE SWCODE = ? );
	my $sth = $dbh->prepare($query);
	$sth->execute($sp);
	($name) = $sth->fetchrow_array;
      }
      if (!$name) {
	$sp .='%';
	$query = qq(SELECT $column FROM spec_names WHERE NAME LIKE ?);
	$sth = $dbh->prepare($query);
	$sth->execute($sp);
	($name) = $sth->fetchrow_array;
      }
    }
    else {
      $name = $sp;
    }
    $self->{'species'}{$format} = $name;
  }

  return $self->{'species'}{$format};
}
taxondescriptionprevnextTop
sub taxon {
  my $self = shift;
  $self->{S} = shift if @_;

  return $self->{S};
}
General documentation
CONTACTTop
 jkh1@sanger.ac.uk