Skip to content

Commit

Permalink
Fixed bug in Bio::DB::Taxonomy::list. One can now create an object wi…
Browse files Browse the repository at this point in the history 
…thout specifying a lineage, as intended

+ lightened the Bio::DB::Taxonomy::list object by removing one level of the object structure
  • Loading branch information
@fangly
fangly committed May 8, 2012
1 parent 21cfe5c commit df8ec28
Show file tree
Hide file tree
Showing 2 changed files with 38 additions and 23 deletions.
42 changes: 22 additions & 20 deletions Bio/DB/Taxonomy/list.pm
View file
Expand Up @@ -23,8 +23,9 @@ that accepts lists of words to build a database
my @names = ('Eukaryota', 'Mammalia', 'Homo', 'Homo sapiens');
my @ranks = qw(superkingdom class genus species);
my $db = Bio::DB::Taxonomy->new(-source => 'list', -names => \@names,
-ranks => \@ranks);
my $db = Bio::DB::Taxonomy->new( -source => 'list',
-names => \@names,
-ranks => \@ranks);
@names = ('Eukaryota', 'Mammalia', 'Mus', 'Mus musculus');
$db->add_lineage(-names => \@names, -ranks => \@ranks);
Expand Down Expand Up @@ -108,8 +109,10 @@ our $prefix = 'list';
sub new {
my ($class, @args) = @_;
my $self = $class->SUPER::new(@args);
$self->{db} = {};
$self->add_lineage(@args) if @args;
my %args = @args;
delete $args{'-source'};

$self->add_lineage(%args) if %args;

return $self;
}
Expand Down Expand Up @@ -160,11 +163,10 @@ sub add_lineage {
# and do a reasonable one. So, let's just do the trivial implementation now
# and see how bad it is! (assumes ranks are unique except for 'no rank')

my $db = $self->{db};
my $ancestors = $db->{ancestors};
my $node_data = $db->{node_data};
my $name_to_id = $db->{name_to_id};
my $children = $db->{children};
my $ancestors = $self->{ancestors};
my $node_data = $self->{node_data};
my $name_to_id = $self->{name_to_id};
my $children = $self->{children};

my $my_ancestor_id = '';
my @node_ids;
Expand Down Expand Up @@ -226,10 +228,10 @@ sub add_lineage {
if (not defined $node_id) {
# This is a new node. Add it to the database, using the prefix 'list'
# for its ID to distinguish it from the IDs from other taxonomies.
my $next_num = ++$db->{node_ids};
my $next_num = ++$self->{node_ids};
$node_id = $prefix.$next_num;
push @{$db->{name_to_id}->{$name}}, $node_id;
$db->{node_data}->{$node_id} = [$name];
push @{$self->{name_to_id}->{$name}}, $node_id;
$self->{node_data}->{$node_id} = [$name];
}

if ( (defined $rank) && (not defined $node_data->{$node_id}->[1]) ) {
Expand All @@ -238,12 +240,12 @@ sub add_lineage {
}

if ($my_ancestor_id) {
if ($db->{ancestors}->{$node_id} && $db->{ancestors}->{$node_id} ne $my_ancestor_id) {
if ($self->{ancestors}->{$node_id} && $self->{ancestors}->{$node_id} ne $my_ancestor_id) {
$self->throw("The lineage '".join(', ', @$names)."' and a ".
"previously stored lineage share a node name but have ".
"different ancestries for that node. Can't cope!");
}
$db->{ancestors}->{$node_id} = $my_ancestor_id;
$self->{ancestors}->{$node_id} = $my_ancestor_id;
}

$my_ancestor_id = $node_id;
Expand All @@ -252,7 +254,7 @@ sub add_lineage {

# Go through the lineage in reverse so we can remember the children
for (my $i = $names_idx - 1; $i >= 0; $i--) {
$db->{children}->{$node_ids[$i]}->{$node_ids[$i+1]} = undef;
$self->{children}->{$node_ids[$i]}->{$node_ids[$i+1]} = undef;
}
}

Expand All @@ -271,7 +273,7 @@ sub add_lineage {

sub get_num_taxa {
my ($self) = @_;
return $self->{db}->{node_ids} || 0;
return $self->{node_ids} || 0;
}


Expand Down Expand Up @@ -306,7 +308,7 @@ sub get_taxon {
}

my $taxon;
my $node = $self->{db}->{node_data}->{$taxonid};
my $node = $self->{node_data}->{$taxonid};
if ($node) {
my ($sci_name, $rank) = @$node;
$taxon = Bio::Taxon->new(
Expand Down Expand Up @@ -345,7 +347,7 @@ sub get_taxon {

sub get_taxonids {
my ($self, $name) = @_;
return @{$self->{db}->{name_to_id}->{$name} || []};
return @{$self->{name_to_id}->{$name} || []};
}

*get_taxonid = \&get_taxonids;
Expand All @@ -370,7 +372,7 @@ sub ancestor {
unless $taxon->db_handle && $taxon->db_handle eq $self;
my $id = $taxon->id || $self->throw("The supplied Taxon is missing its id!");

my $ancestor_id = $self->{db}->{ancestors}->{$id} || return;
my $ancestor_id = $self->{ancestors}->{$id} || return;
return $self->get_taxon($ancestor_id);
}

Expand All @@ -394,7 +396,7 @@ sub each_Descendent {
my $id = $taxon->id || $self->throw("The supplied Taxon is missing its id!");

my @children;
while ( my ($child_id, undef) = each %{$self->{db}->{children}->{$id}} ) {
while ( my ($child_id, undef) = each %{$self->{children}->{$id}} ) {
push @children, ($self->get_taxon($child_id) || next);
}

Expand Down
19 changes: 16 additions & 3 deletions t/RemoteDB/Taxonomy.t
View file
Expand Up @@ -7,7 +7,7 @@ BEGIN {
use lib '.';
use Bio::Root::Test;

test_begin(-tests => 122,
test_begin(-tests => 129,
-requires_module => 'XML::Twig');

use_ok('Bio::DB::Taxonomy');
Expand All @@ -20,12 +20,16 @@ my $temp_dir = test_output_dir();
# Bio::Taxonomy

ok my $db_entrez = Bio::DB::Taxonomy->new(-source => 'entrez');
isa_ok $db_entrez, 'Bio::DB::Taxonomy::entrez';
isa_ok $db_entrez, 'Bio::DB::Taxonomy';

ok my $db_flatfile = Bio::DB::Taxonomy->new(
-source => 'flatfile',
-nodesfile => test_input_file('taxdump', 'nodes.dmp'),
-namesfile => test_input_file('taxdump','names.dmp'),
);
isa_ok $db_flatfile, 'Bio::DB::Taxonomy::flatfile';
isa_ok $db_flatfile, 'Bio::DB::Taxonomy';

ok $db_flatfile = Bio::DB::Taxonomy->new(
-source => 'flatfile',
Expand Down Expand Up @@ -150,11 +154,20 @@ for my $db ($db_entrez, $db_flatfile) {
}
}


# Test the list database

ok my $db_list = Bio::DB::Taxonomy->new(-source => 'list');
isa_ok $db_list, 'Bio::DB::Taxonomy::list';
isa_ok $db_list, 'Bio::DB::Taxonomy';

my @ranks = qw(superkingdom class genus species);
my @h_lineage = ('Eukaryota', 'Mammalia', 'Homo', 'Homo sapiens');
ok my $db_list = Bio::DB::Taxonomy->new(-source => 'list', -names => \@h_lineage,
-ranks => \@ranks);
ok $db_list = Bio::DB::Taxonomy->new(
-source => 'list',
-names => \@h_lineage,
-ranks => \@ranks,
);
is $db_list->get_num_taxa, 4;

ok my $h_list = $db_list->get_taxon(-name => 'Homo sapiens');
Expand Down

0 comments on commit df8ec28

Please sign in to comment.