lib/CXGN/Phylo/TreePlus.pm

   1 package CXGN::Phylo::TreePlus;
   2
   3 use base qw/ CXGN::Phylo::Tree /;
   4
   5 =head1 NAME
   6
   7 CXGN::Phylo::TreePlus
   8
   9 =head1 SYNOPSIS
  10
  11 This is a subclass of Tree that has more advanced
  12 functionality, such as a BayesTraits method
  13
  14 =cut
  15 use strict;
  16 use CXGN::Tools::Cluster::BayesTraits;
  17
  18 sub new {
  19         my $class = shift;
  20         my $self = bless {}, $class;
  21         my $tree = CXGN::Phylo::Tree->new(@_);
  22         while(my ($k, $v) = each %$tree){
  23                 $self->{$k} = $v;
  24         }
  25         return $self;
  26 }
  27
  28 =head2 function calculate_bayes_traits()
  29
  30  Args: List of trait names, numerically valued attributes of leaf nodes
  31  Ret: Nothing
  32  Effect:  Runs a BayesTraits Cluster process on all nodes, determining
  33           ancestral characteristics and setting attributes at each node
  34
  35 =cut
  36
  37 sub calculate_bayes_traits {
  38         my $self = shift;
  39         my @trait_names = @_;
  40
  41         my @leaves = $self->get_leaf_list();
  42
  43         my $data = {};
  44
  45         foreach my $l (@leaves){
  46                 my $id = $l->get_name();
  47                 my $traits = {};
  48                 foreach my $tn (@trait_names){
  49                         my $v = $l->get_attribute($tn);
  50                         $v ||= "-";
  51                         $traits->{$tn} = $v;
  52                 }
  53                 $data->{$id} = $traits;
  54         }
  55
  56         my $binary_tree = $self->copy();
  57         $binary_tree->make_binary();
  58
  59         my $proc = CXGN::Tools::Cluster::BayesTraits->new({
  60                                         tree => $binary_tree,
  61                                         data => $data,
  62                                         model => "continuous",
  63                                         auto_mla => 1,
  64                                         all_nodes => 1
  65                                         });
  66
  67         $proc->add_command("delta", "lambda", "kappa");
  68
  69         $proc->submit();
  70         $proc->spin();
  71
  72         my $results = $proc->results();
  73
  74         while(my ($node_key, $value_hash) = each %$results){
  75                 my $node = $self->get_node($node_key);
  76                 foreach my $tn (@trait_names){
  77                         $node->set_attribute($tn, $value_hash->{$tn});
  78                         $node->set_attribute($tn . "_var", $value_hash->{$tn . "_var"});
  79                         $node->set_attribute("bayes_lh", $value_hash->{likelihood});
  80                 }
  81         }
  82 }
  83
  84
  85 1;