lib/CXGN/Phylo/Ortholog_group_factory.pm

   1
   2 package CXGN::Phylo::Ortholog_group_factory;
   3
   4 sub new {
   5     my $class = shift;
   6     my $tree = shift;
   7
   8     my $args = {};
   9     my $self = bless $args, $class;
  10
  11     my @ortholog_groups = $self->collect_orthologs($tree->get_root());
  12
  13     return $self;
  14 }
  15
  16 sub collect_orthologs {
  17     my $self = shift;
  18     my $node = shift;
  19     my $ortho_groups_ref = shift;
  20     my $ortho_tree_ref = shift;
  21
  22     # test if we have a subtree that contains orthologs... that's the case
  23     # when the subtree_species_count is equal to the subtree_node_count.
  24     #
  25     if ($node->get_subtree_species_count() == $node->get_subtree_node_count()) {
  26         #print STDERR "Found ortholog group starting at node ". $node->get_name()."\n";
  27
  28         # collect all the leaves in that subtree
  29         #
  30         my @orthologs = $node->recursive_leaf_list();
  31         push @$ortho_groups_ref, \@orthologs;
  32         #print STDERR "Done collecting ".scalar(@orthologs)." subnodes.\n";
  33
  34         # now we also want the actual subtree so that we can compare it to the
  35         # species tree. First, copy the subtree.
  36         #print STDERR "Getting the subtree...\n";
  37         my $new_tree = CXGN::Phylo::Tree->new();
  38         my $new_root = $node->recursive_copy(undef, $new_tree);
  39
  40         $new_tree->set_root($new_root);
  41
  42         push @$ortho_tree_ref, $new_tree;
  43
  44         return ($ortho_groups_ref, $ortho_tree_ref);
  45     }
  46     else {
  47         foreach my $c ($node->get_children()) {
  48             #print STDERR "Testing child node ".$c->get_name()." for orthology.\n";
  49             my ($children_ortho_groups_ref, $children_ortho_trees_ref) = $self->collect_orthologs($node);
  50             foreach my $ref (@$children_ortho_groups_ref) {
  51                 #print STDERR "Adding subnodes...\n";
  52                 push @$ortho_groups_ref, $ref;
  53             }
  54             foreach my $ref (@$children_ortho_trees_ref) {
  55                 #print STDERR "Adding subtree to ortholog tree list...\n";
  56                 push @$ortho_tree_ref, $ref;
  57             }
  58         }
  59     }
  60     #print STDERR  "Returning.\n";
  61     return ($ortho_groups_ref, $ortho_tree_ref);
  62 }
  63
  64 1;