lib/CXGN/Phylo/OrganismTree.pm

   1 package CXGN::Phylo::OrganismTree;
   2
   3 =head1 NAME
   4
   5 CXGN::Phylo::OrgnanismTree - an object to handle SGN organism  trees
   6
   7 =head1 USAGE
   8
   9  my $tree = CXGN::Phylo::OrganismTree->new();
  10  my $root = $tree->get_root();
  11  my $node = $root->add_child();
  12  $node->set_name("I'm a child node");
  13  $node->set_link("http://solgenomics.net/");
  14  my $child_node = $node->add_child();
  15  $child_node->set_name("I'm a grand-child node");
  16  print $tree->generate_newick();
  17
  18 =head1 DESCRIPTION
  19
  20 This is a subcass of L<CXGN::Phylo::Tree>
  21
  22 =head1 AUTHORS
  23
  24  Naama Menda (nm249@cornell.edu)
  25
  26 =cut
  27
  28 use strict;
  29 use warnings;
  30 use namespace::autoclean;
  31
  32 use HTML::Entities;
  33
  34 use CXGN::DB::DBICFactory;
  35 use CXGN::Chado::Organism;
  36 use CXGN::Tools::WebImageCache;
  37 use CXGN::Phylo::Node;
  38
  39 use base qw / CXGN::Phylo::Tree /;
  40
  41 =head2 function new()
  42
  43   Synopsis:     my $t = CXGN::Phylo::OrganismTree->new($schema)
  44   Arguments:    $schema object
  45   Returns:      an instance of a Tree object.
  46   Side effects: creates the object and initializes some parameters.
  47   Description:
  48
  49 =cut
  50
  51 sub new {
  52     my $class = shift;
  53     my $schema = shift || die "NO SCHEMA OBJECT PROVIDED!!\n";
  54
  55     my $self = $class->SUPER::new();
  56
  57     $self->set_schema($schema);
  58
  59     return $self;
  60 }
  61
  62 #######
  63
  64 =head2 recursive_children
  65
  66  Usage: $self->recursive_children($nodes_hashref, $organism, $node, $species_info, $is_root)
  67  Desc:  recursively add child nodes starting from root.
  68  Ret:   nothing
  69  Args:  $nodes_hashref (organism_id => CXGN::Chado::Organism),
  70         $organism object for your root,
  71         $node object for your root,
  72         hashref of text species info (for rendering species popups),
  73         1 (required)
  74  Side Effects: sets name, label, link, tooltip for nodes, highlites leaf nodes.
  75  Example:
  76
  77 =cut
  78
  79 sub recursive_children {
  80     my ( $self, $nodes, $o, $n, $species_cache, $is_root ) = @_;
  81
  82     # $o is a CXGN::Chado::Organism object
  83     # $n is a CXGN::Phylo::Node object
  84
  85     $n->set_name( $o->get_species() );
  86     my $orgkey = $o->get_organism_id();
  87     $n->get_label
  88       ->set_link( "/chado/organism.pl?organism_id="
  89                   . $o->get_organism_id
  90                  );
  91     $n->get_label
  92       ->set_name( $o->get_species );
  93     $n->set_tooltip( $n->get_name );
  94     $n->set_species( $n->get_name );
  95     $n->set_hide_label( 0 );
  96     $n->get_label->set_hidden( 0 );
  97
  98     my $content = do {
  99         if( my $species_data = $species_cache->thaw($orgkey) ) {
 100             join '<br />', map {
 101                     "<b>$_:</b> ".( $species_data->{$_} || '<span class="ghosted">not set</span>' )
 102                   } sort keys %$species_data
 103         } else {
 104             '<span class="ghosted">no data available</span>'
 105         }
 106     };
 107
 108     $content =~ s/\n/ /g;
 109     $content = encode_entities( $content );
 110
 111     my $species = $o->get_species;
 112     for ( $n, $n->get_label ) {
 113         $_->set_onmouseover(
 114             "javascript:showPopUp('popup','$content','<b>$species</b>')"
 115            );
 116         $_->set_onmouseout(
 117             "javascript:hidePopUp('popup')"
 118            );
 119     }
 120
 121     my @cl = $n->get_children;
 122
 123     my @children = $o->get_direct_children;
 124     foreach my $child (@children) {
 125
 126         if ( exists( $nodes->{ $child->get_organism_id } )
 127             && defined( $nodes->{ $child->get_organism_id } ) )
 128         {
 129
 130             my $new_node = $n->add_child;
 131             $self->recursive_children( $nodes, $child, $new_node,
 132                 $species_cache );
 133         }
 134     }
 135
 136     $n->set_hilited(1) if $n->is_leaf;
 137 }
 138
 139 =head2 find_recursive_parent
 140
 141  Usage: $self->find_recursive_parent($organism, $nodes_hashref)
 142  Desc:  populate $nodes_hashref  (organism_id=> CXGN::Chado::organism) with recursive parent organisms
 143  Ret:   $nodes_hashref
 144  Args:  $organism object, $nodes_hashref
 145  Side Effects: none
 146  Example:
 147
 148 =cut
 149
 150 sub find_recursive_parent {
 151     my ($self, $organism, $nodes) = @_;
 152
 153     my $parent = $organism->get_parent;
 154     if ($parent) {
 155         my $id = $parent->get_organism_id();
 156
 157         if ( !$nodes->{$id} ) {
 158             $nodes->{$id} = $parent;
 159             $self->find_recursive_parent( $parent, $nodes );
 160         }
 161     }
 162     else { return; }
 163     return $nodes;
 164 }
 165
 166
 167 =head2 hilite_species
 168
 169  Usage:        $tree->hilite_species([255,0,0], ['Solanum lycopersicum']);
 170  Desc:
 171  Ret:
 172  Args:
 173  Side Effects:
 174  Example:
 175
 176 =cut
 177
 178 sub hilite_species {
 179     my $self = shift;
 180     my $color_ref = shift;
 181     my $species_ref = shift;
 182
 183     foreach my $s (@$species_ref) {
 184         my $n = $self->get_node_by_name($s);
 185         $n->set_hilited(1);
 186         $n->get_label()->set_hilite_color(@$color_ref);
 187         $n->get_label()->set_hilite(1);
 188     }
 189 }
 190
 191
 192
 193 =head2 build_tree
 194
 195  Usage:  $self->build_tree($root_species_name, $org_ids, $speciesinfo_cache)
 196  Desc:   builds an organism tree starting from $root with a list of species
 197  Ret:    a newick representation of the tree
 198  Args:   $root_species_id (species name of root species)
 199          $org_ids (arrayref of organism IDs)
 200  Side Effects:  sets tree nodes names and lables, and renders the tree  (see L<CXGN::Phylo::Renderer> )
 201                 calls $tree->generate_newick($root_node, 1)
 202  Example:
 203
 204 =cut
 205
 206 sub build_tree {
 207     my ( $self, $root, $organisms, $species_cache ) = @_;
 208     my $schema    = $self->get_schema();
 209     my $root_o    = CXGN::Chado::Organism->new_with_species( $schema, $root )
 210         or die "species '$root' not found";
 211     my $root_o_id = $root_o->get_organism_id();
 212     my $organism_link = "/chado/organism.pl?organism_id=";
 213     my $nodes         = ();
 214     my $root_node = $self->get_root();    #CXGN::Phylo::Node->new();
 215
 216     # look up all the organism objects
 217     my @organisms =
 218         grep $_, #< filter out missing organisms
 219         map CXGN::Chado::Organism->new_with_species( $schema, $_ ),
 220         @$organisms;
 221
 222     foreach my $o ( @organisms ) {
 223         my $organism_id = $o->get_organism_id();
 224         $nodes->{$organism_id} = $o;
 225         $nodes = $self->find_recursive_parent( $o, $nodes );
 226     }
 227
 228     $self->recursive_children( $nodes, $nodes->{$root_o_id}, $root_node,
 229         $species_cache, 1 );
 230
 231     $self->set_show_labels(1);
 232
 233     $root_node->set_name( $root_o->get_species() );
 234     $root_node->set_link( $organism_link . $root_o_id );
 235     $self->set_root($root_node);
 236
 237     $self->d( "FOUND organism "
 238           . $nodes->{$root_o_id}
 239           . " root node: "
 240           . $root_node->get_name()
 241           . "\n\n" );
 242
 243     my $newick = $self->generate_newick( $root_node, 1 );
 244
 245     $self->standard_layout();
 246
 247     my $renderer     = CXGN::Phylo::PNG_tree_renderer->new($self);
 248     my $leaf_count   = $self->get_leaf_count();
 249     my $image_height = $leaf_count * 20 > 120 ? $leaf_count * 20 : 120;
 250
 251     $self->get_layout->set_image_height($image_height);
 252     $self->get_layout->set_image_width(800);
 253     $self->get_layout->set_top_margin(20);
 254     $self->set_renderer($renderer);
 255
 256     #$tree->get_layout->layout();
 257     $self->get_renderer->render();
 258
 259     return $newick;
 260 }
 261
 262 1;