|
0
|
1 =head1 LICENSE
|
|
|
2
|
|
|
3 Copyright (c) 1999-2011 The European Bioinformatics Institute and
|
|
|
4 Genome Research Limited. All rights reserved.
|
|
|
5
|
|
|
6 This software is distributed under a modified Apache license.
|
|
|
7 For license details, please see
|
|
|
8
|
|
|
9 http://www.ensembl.org/info/about/code_licence.html
|
|
|
10
|
|
|
11 =head1 CONTACT
|
|
|
12
|
|
|
13 Please email comments or questions to the public Ensembl
|
|
|
14 developers list at <dev@ensembl.org>.
|
|
|
15
|
|
|
16 Questions may also be sent to the Ensembl help desk at
|
|
|
17 <helpdesk@ensembl.org>.
|
|
|
18
|
|
|
19 =head1 NAME
|
|
|
20
|
|
|
21 Bio::EnsEMBL::Compara::GeneTree
|
|
|
22
|
|
|
23 =head1 SYNOPSIS
|
|
|
24
|
|
|
25 Tree - Class for a CAFE tree
|
|
|
26
|
|
|
27 =head1 DESCRIPTION
|
|
|
28
|
|
|
29 Specific subclass of NestedSet to add functionality when the nodes of this tree
|
|
|
30 are CAFETreeMember objects.
|
|
|
31
|
|
|
32 =head1 INHERITANCE TREE
|
|
|
33
|
|
|
34 Bio::EnsEMBL::Compara::CAFETreeNode
|
|
|
35 +- Bio::EnsEMBL::Compara::NestedSet
|
|
|
36 +- Bio::EnsEMBL::Compara::Graph::Node
|
|
|
37 +- Bio::EnsEMBL::Compara::Graph::CGObject
|
|
|
38
|
|
|
39
|
|
|
40 =head1 APPENDIX
|
|
|
41
|
|
|
42 The rest of the documentation details each of the object methods. Internal methods are usually preceded with a _
|
|
|
43
|
|
|
44 =cut
|
|
|
45
|
|
|
46 package Bio::EnsEMBL::Compara::CAFETreeNode;
|
|
|
47
|
|
|
48 use strict;
|
|
|
49 use Data::Dumper;
|
|
|
50
|
|
|
51 use base ('Bio::EnsEMBL::Compara::NestedSet');
|
|
|
52
|
|
|
53 #################################################
|
|
|
54 # Object variable methods
|
|
|
55 #################################################
|
|
|
56
|
|
|
57
|
|
|
58 sub method_link_species_set_id {
|
|
|
59 my ($self, $mlss_id) = @_;
|
|
|
60
|
|
|
61 if (defined $mlss_id) {
|
|
|
62 $self->{'_method_link_species_set_id'} = $mlss_id;
|
|
|
63 }
|
|
|
64 return $self->{'_method_link_species_set_id'};
|
|
|
65 }
|
|
|
66
|
|
|
67 sub species_tree {
|
|
|
68 my ($self, $species_tree) = @_;
|
|
|
69
|
|
|
70 if (defined $species_tree) {
|
|
|
71 $self->{'_species_tree'} = $species_tree;
|
|
|
72 }
|
|
|
73 return $self->{'_species_tree'};
|
|
|
74 }
|
|
|
75
|
|
|
76 sub genome_db {
|
|
|
77 my ($self) = @_;
|
|
|
78 return undef unless ($self->is_leaf);
|
|
|
79 $self->throw("taxon_id is not set in this node") unless ($self->taxon_id);
|
|
|
80 my $GenomeDBAdaptor = $self->adaptor->db->get_GenomeDBAdaptor;
|
|
|
81 my $genomeDB = $GenomeDBAdaptor->fetch_by_taxon_id($self->taxon_id);
|
|
|
82 return $genomeDB;
|
|
|
83 }
|
|
|
84
|
|
|
85 sub lambdas {
|
|
|
86 my ($self, $lambdas) = @_;
|
|
|
87
|
|
|
88 if (defined $lambdas) {
|
|
|
89 $self->{'_lambdas'} = $lambdas;
|
|
|
90 }
|
|
|
91 return $self->{'_lambdas'};
|
|
|
92 }
|
|
|
93
|
|
|
94 sub avg_pvalue {
|
|
|
95 my ($self, $avg_pvalue) = @_;
|
|
|
96
|
|
|
97 if (defined $avg_pvalue) {
|
|
|
98 $self->{'_avg_pvalue'} = $avg_pvalue;
|
|
|
99 }
|
|
|
100 return $self->{'_avg_pvalue'};
|
|
|
101 }
|
|
|
102
|
|
|
103 sub pvalue_lim {
|
|
|
104 my ($self, $pvalue) = @_;
|
|
|
105 if (defined $pvalue) {
|
|
|
106 $self->{'_pvalue_lim'} = $pvalue;
|
|
|
107 }
|
|
|
108 return $self->{'_pvalue_lim'};
|
|
|
109 }
|
|
|
110
|
|
|
111 sub fam_id {
|
|
|
112 my ($self, $fam_id) = @_;
|
|
|
113
|
|
|
114 if (defined $fam_id) {
|
|
|
115 $self->{'_fam_id'} = $fam_id;
|
|
|
116 }
|
|
|
117 return $self->{'_fam_id'};
|
|
|
118 }
|
|
|
119
|
|
|
120 sub taxon_id {
|
|
|
121 my ($self, $taxon_id) = @_;
|
|
|
122
|
|
|
123 if (defined $taxon_id) {
|
|
|
124 $self->{'_taxon_id'} = $taxon_id;
|
|
|
125 }
|
|
|
126 return $self->{'_taxon_id'};
|
|
|
127 }
|
|
|
128
|
|
|
129 sub n_members {
|
|
|
130 my ($self, $n_members) = @_;
|
|
|
131
|
|
|
132 if (defined $n_members) {
|
|
|
133 $self->{'_n_members'} = $n_members;
|
|
|
134 }
|
|
|
135 return $self->{'_n_members'};
|
|
|
136 }
|
|
|
137
|
|
|
138 sub p_value {
|
|
|
139 my ($self, $pvalue) = @_;
|
|
|
140
|
|
|
141 if (defined $pvalue) {
|
|
|
142 $self->{'_p_value'} = $pvalue;
|
|
|
143 }
|
|
|
144 return $self->{'_p_value'};
|
|
|
145 }
|
|
|
146
|
|
|
147 sub is_tree_significant {
|
|
|
148 my ($self) = @_;
|
|
|
149 return $self->avg_pvalue() < $self->pvalue_lim();
|
|
|
150 }
|
|
|
151
|
|
|
152 sub is_node_significant {
|
|
|
153 my ($self) = @_;
|
|
|
154 return $self->p_value() < $self->root->pvalue_lim();
|
|
|
155 }
|
|
|
156
|
|
|
157 sub get_contractions {
|
|
|
158 my ($self) = @_;
|
|
|
159 my $contractions;
|
|
|
160 for my $node (@{$self->get_all_nodes}) {
|
|
|
161 if (defined $node->p_value && ($node->p_value < $self->pvalue_lim) && $node->is_contraction) {
|
|
|
162 push @{$contractions}, $node;
|
|
|
163 }
|
|
|
164 }
|
|
|
165 return $contractions || [];
|
|
|
166 }
|
|
|
167
|
|
|
168 sub get_expansions {
|
|
|
169 my ($self) = @_;
|
|
|
170 my $expansions;
|
|
|
171 for my $node (@{$self->get_all_nodes}) {
|
|
|
172 if (defined $node->p_value && ($node->p_value < $self->pvalue_lim) && $node->is_expansion) {
|
|
|
173 push @{$expansions}, $node;
|
|
|
174 }
|
|
|
175 }
|
|
|
176 return $expansions || [];
|
|
|
177 }
|
|
|
178
|
|
|
179 sub is_expansion {
|
|
|
180 my ($self) = @_;
|
|
|
181 if ($self->has_parent) {
|
|
|
182 return 1 if ($self->n_members > $self->parent->n_members);
|
|
|
183 }
|
|
|
184 return 0;
|
|
|
185 }
|
|
|
186
|
|
|
187 sub is_contraction {
|
|
|
188 my ($self) = @_;
|
|
|
189 if ($self->has_parent) {
|
|
|
190 return 1 if ($self->n_members < $self->parent->n_members);
|
|
|
191 }
|
|
|
192 return 0;
|
|
|
193 }
|
|
|
194
|
|
|
195 1;
|
