diff variant_effect_predictor/Bio/EnsEMBL/Compara/CAFETreeNode.pm @ 0:21066c0abaf5 draft

Uploaded
author willmclaren
date Fri, 03 Aug 2012 10:04:48 -0400
parents
children
line wrap: on
line diff
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/variant_effect_predictor/Bio/EnsEMBL/Compara/CAFETreeNode.pm	Fri Aug 03 10:04:48 2012 -0400
@@ -0,0 +1,195 @@
+=head1 LICENSE
+
+  Copyright (c) 1999-2011 The European Bioinformatics Institute and
+  Genome Research Limited.  All rights reserved.
+
+  This software is distributed under a modified Apache license.
+  For license details, please see
+
+   http://www.ensembl.org/info/about/code_licence.html
+
+=head1 CONTACT
+
+  Please email comments or questions to the public Ensembl
+  developers list at <dev@ensembl.org>.
+
+  Questions may also be sent to the Ensembl help desk at
+  <helpdesk@ensembl.org>.
+
+=head1 NAME
+
+Bio::EnsEMBL::Compara::GeneTree
+
+=head1 SYNOPSIS
+
+Tree - Class for a CAFE tree
+
+=head1 DESCRIPTION
+
+Specific subclass of NestedSet to add functionality when the nodes of this tree
+are CAFETreeMember objects.
+
+=head1 INHERITANCE TREE
+
+  Bio::EnsEMBL::Compara::CAFETreeNode
+  +- Bio::EnsEMBL::Compara::NestedSet
+   +- Bio::EnsEMBL::Compara::Graph::Node
+    +- Bio::EnsEMBL::Compara::Graph::CGObject
+
+
+=head1 APPENDIX
+
+The rest of the documentation details each of the object methods. Internal methods are usually preceded with a _
+
+=cut
+
+package Bio::EnsEMBL::Compara::CAFETreeNode;
+
+use strict;
+use Data::Dumper;
+
+use base ('Bio::EnsEMBL::Compara::NestedSet');
+
+#################################################
+# Object variable methods
+#################################################
+
+
+sub method_link_species_set_id {
+    my ($self, $mlss_id) = @_;
+
+    if (defined $mlss_id) {
+        $self->{'_method_link_species_set_id'} = $mlss_id;
+    }
+    return $self->{'_method_link_species_set_id'};
+}
+
+sub species_tree {
+    my ($self, $species_tree) = @_;
+
+    if (defined $species_tree) {
+        $self->{'_species_tree'} = $species_tree;
+    }
+    return $self->{'_species_tree'};
+}
+
+sub genome_db {
+    my ($self) = @_;
+    return undef unless ($self->is_leaf);
+    $self->throw("taxon_id is not set in this node") unless ($self->taxon_id);
+    my $GenomeDBAdaptor = $self->adaptor->db->get_GenomeDBAdaptor;
+    my $genomeDB = $GenomeDBAdaptor->fetch_by_taxon_id($self->taxon_id);
+    return $genomeDB;
+}
+
+sub lambdas {
+    my ($self, $lambdas) = @_;
+
+    if (defined $lambdas) {
+        $self->{'_lambdas'} = $lambdas;
+    }
+    return $self->{'_lambdas'};
+}
+
+sub avg_pvalue {
+    my ($self, $avg_pvalue) = @_;
+
+    if (defined $avg_pvalue) {
+        $self->{'_avg_pvalue'} = $avg_pvalue;
+    }
+    return $self->{'_avg_pvalue'};
+}
+
+sub pvalue_lim {
+    my ($self, $pvalue) = @_;
+    if (defined $pvalue) {
+        $self->{'_pvalue_lim'} = $pvalue;
+    }
+    return $self->{'_pvalue_lim'};
+}
+
+sub fam_id {
+    my ($self, $fam_id) = @_;
+
+    if (defined $fam_id) {
+        $self->{'_fam_id'} = $fam_id;
+    }
+    return $self->{'_fam_id'};
+}
+
+sub taxon_id {
+    my ($self, $taxon_id) = @_;
+
+    if (defined $taxon_id) {
+        $self->{'_taxon_id'} = $taxon_id;
+    }
+    return $self->{'_taxon_id'};
+}
+
+sub n_members {
+    my ($self, $n_members) = @_;
+
+    if (defined $n_members) {
+        $self->{'_n_members'} = $n_members;
+    }
+    return $self->{'_n_members'};
+}
+
+sub p_value {
+    my ($self, $pvalue) = @_;
+
+    if (defined $pvalue) {
+        $self->{'_p_value'} = $pvalue;
+    }
+    return $self->{'_p_value'};
+}
+
+sub is_tree_significant {
+    my ($self) = @_;
+    return $self->avg_pvalue() < $self->pvalue_lim();
+}
+
+sub is_node_significant {
+    my ($self) = @_;
+    return $self->p_value() < $self->root->pvalue_lim();
+}
+
+sub get_contractions {
+    my ($self) = @_;
+    my $contractions;
+    for my $node (@{$self->get_all_nodes}) {
+        if (defined $node->p_value && ($node->p_value < $self->pvalue_lim) && $node->is_contraction) {
+            push @{$contractions}, $node;
+        }
+    }
+    return $contractions || [];
+}
+
+sub get_expansions {
+    my ($self) = @_;
+    my $expansions;
+    for my $node (@{$self->get_all_nodes}) {
+        if (defined $node->p_value && ($node->p_value < $self->pvalue_lim) && $node->is_expansion) {
+            push @{$expansions}, $node;
+        }
+    }
+    return $expansions || [];
+}
+
+sub is_expansion {
+    my ($self) = @_;
+    if ($self->has_parent) {
+        return 1 if ($self->n_members > $self->parent->n_members);
+    }
+    return 0;
+}
+
+sub is_contraction {
+    my ($self) = @_;
+    if ($self->has_parent) {
+        return 1 if ($self->n_members < $self->parent->n_members);
+    }
+    return 0;
+}
+
+1;