[Bioperl-guts-l] [14805] bioperl-live/trunk: phyloxml: bug fixes and tests
miraceti at dev.open-bio.org
miraceti at dev.open-bio.org
Fri Aug 15 22:35:26 EDT 2008
Revision: 14805
Author: miraceti
Date: 2008-08-15 22:35:26 -0400 (Fri, 15 Aug 2008)
Log Message:
-----------
phyloxml: bug fixes and tests
Modified Paths:
--------------
bioperl-live/trunk/Bio/PrimarySeq.pm
bioperl-live/trunk/Bio/Tree/AnnotatableNode.pm
bioperl-live/trunk/Bio/TreeIO/phyloxml.pm
bioperl-live/trunk/t/phyloxml.t
Modified: bioperl-live/trunk/Bio/PrimarySeq.pm
===================================================================
--- bioperl-live/trunk/Bio/PrimarySeq.pm 2008-08-15 21:57:41 UTC (rev 14804)
+++ bioperl-live/trunk/Bio/PrimarySeq.pm 2008-08-16 02:35:26 UTC (rev 14805)
@@ -185,9 +185,8 @@
)],
@args);
- # nowarnonempty: private var, no need for accessor
- # but need to be set before calling _guess_alphabet
- $self->{'nowarnonempty'} = $nowarnonempty;
+ # private var _nowarnonempty, need to be set before calling _guess_alphabet
+ $self->{'_nowarnonempty'} = $nowarnonempty;
if( defined $id && defined $given_id ) {
if( $id ne $given_id ) {
@@ -841,7 +840,7 @@
my $total = CORE::length($str);
if( $total == 0 ) {
- if (!$self->{'nowarnonempty'}) {
+ if (!$self->{'_nowarnonempty'}) {
$self->warn("Got a sequence with no letters in it ".
"cannot guess alphabet");
}
Modified: bioperl-live/trunk/Bio/Tree/AnnotatableNode.pm
===================================================================
--- bioperl-live/trunk/Bio/Tree/AnnotatableNode.pm 2008-08-15 21:57:41 UTC (rev 14804)
+++ bioperl-live/trunk/Bio/Tree/AnnotatableNode.pm 2008-08-16 02:35:26 UTC (rev 14805)
@@ -313,7 +313,7 @@
Usage : $ann = $node->sequence or
$node->sequence($seq)
Function: Gets or sets the sequence
- Returns : Bio::SeqI object
+ Returns : array reference of Bio::SeqI objects
Args : None or Bio::SeqI object
See L<Bio::SeqI> and L<Bio::Seq>
for more information
@@ -326,7 +326,7 @@
if( defined $value ) {
$self->throw("object of class ".ref($value)." does not implement ".
"Bio::SeqI. Too bad.") unless $value->isa("Bio::SeqI");
- $self->{'_sequence'} = $value;
+ push (@{$self->{'_sequence'}}, $value);
}
#elsif( ! defined $self->{'_sequence'})
#{
@@ -335,4 +335,21 @@
return $self->{'_sequence'};
}
+=head2 has_sequence
+
+ Title : has_sequence
+ Usage : if( $node->has_sequence) { # do something }
+ Function: tells if node has sequence attached
+ Returns : Boolean for whether or not node has Bio::SeqI attached.
+ Args : None
+
+=cut
+
+sub has_sequence
+{
+ my ($self) = @_;
+ return $self->{'_sequence'} && @{$self->{'_sequence'}};
+}
+
+
1;
Modified: bioperl-live/trunk/Bio/TreeIO/phyloxml.pm
===================================================================
--- bioperl-live/trunk/Bio/TreeIO/phyloxml.pm 2008-08-15 21:57:41 UTC (rev 14804)
+++ bioperl-live/trunk/Bio/TreeIO/phyloxml.pm 2008-08-16 02:35:26 UTC (rev 14805)
@@ -181,6 +181,10 @@
while (my $str = pop (@{$self->{'_tree_attr'}->{'clade_relation'}})) {
$self->_print($str);
}
+ # print sequence relations
+ while (my $str = pop (@{$self->{'_tree_attr'}->{'sequence_relation'}})) {
+ $self->_print($str);
+ }
$self->_print("</phylogeny>");
$self->_print("\n");
}
@@ -196,7 +200,6 @@
$self->throw( "node must be a Bio::Tree::AnnotatableNode" );
}
my $ac = $node->annotation;
- my $seq = $node->sequence;
# if clade_relation exists
my @relations = $ac->get_Annotations('clade_relation');
@@ -208,11 +211,11 @@
# start <clade>
$str .= '<clade';
- my @attr = $ac->get_Annotations('_attr'); # check id_source
- if (@attr) {
- my @id_source = $attr[0]->get_Annotations('id_source');
- if (@id_source) {
- $str .= " id_source=\"".$id_source[0]->value."\"";
+ my ($attr) = $ac->get_Annotations('_attr'); # check id_source
+ if ($attr) {
+ my ($id_source) = $attr->get_Annotations('id_source');
+ if ($id_source) {
+ $str .= " id_source=\"".$id_source->value."\"";
}
}
$str .= ">";
@@ -224,9 +227,19 @@
# print all annotations
$str = print_annotation( $node, $str, $ac );
+
# print all sequences
- if ($seq) {
- $str = print_seq_annotation( $self, $str, $seq );
+ if ($node->has_sequence) {
+ foreach my $seq (@{$node->sequence}) {
+ # if sequence_relation exists
+ my @relations = $seq->annotation->get_Annotations('sequence_relation');
+ foreach (@relations) {
+ my $sequence_rel = $self->relation_to_string($seq, $_, '');
+ # set as tree attr
+ push (@{$self->{'_tree_attr'}->{'sequence_relation'}}, $sequence_rel);
+ }
+ $str = print_seq_annotation( $node, $str, $seq );
+ }
}
$str .= "</clade>";
@@ -234,22 +247,23 @@
}
sub relation_to_string {
- my ($self, $node, $rel, $str) = @_;
+ my ($self, $obj, $rel, $str) = @_;
- my @attr = $node->annotation->get_Annotations('_attr'); # check id_source
+ my @attr = $obj->annotation->get_Annotations('_attr'); # check id_source
if (@attr) {
my @id_source = $attr[0]->get_Annotations('id_source');
}
- my ($id_ref_0) = $node->annotation->get_nested_Annotations(
+ my ($id_ref_0) = $obj->annotation->get_nested_Annotations(
'-keys' => ['id_source'],
'-recursive' => 1);
my ($id_ref_1) = $rel->to->annotation->get_nested_Annotations(
'-keys' => ['id_source'],
'-recursive' => 1);
- $str .= "<clade_relation ";
- $str .= "id_ref_0=\"".$id_ref_0->value."\" ";
- $str .= "id_ref_1=\"".$id_ref_1->value."\" ";
- $str .= "type=\"".$rel->type."\"";
+ $str .= "<";
+ $str .= $rel->tagname;
+ $str .= " id_ref_0=\"".$id_ref_0->value."\"";
+ $str .= " id_ref_1=\"".$id_ref_1->value."\"";
+ $str .= " type=\"".$rel->type."\"";
$str .= "/>";
return $str;
}
@@ -947,7 +961,6 @@
# not a Bio::TreeIO::phyloxml
my $str = '';
my $ac = $self->annotation;
- my $seq = $self->sequence;
# start <clade>
$str .= '<clade';
@@ -963,8 +976,10 @@
# print all annotations
$str = print_annotation( $self, $str, $ac );
# print all sequences
- if ($seq) {
- $str = print_seq_annotation( $self, $str, $seq );
+ if ($self->has_sequence) {
+ foreach my $seq (@{$self->sequence}) {
+ $str = print_seq_annotation( $self, $str, $seq );
+ }
}
$str .= '</clade>';
@@ -1028,7 +1043,16 @@
{
my ($self, $str, $seq) = @_;
- $str .= "<sequence>";
+ $str .= "<sequence";
+ my ($attr) = $seq->annotation->get_Annotations('_attr'); # check id_source
+ if ($attr) {
+ my ($id_source) = $attr->get_Annotations('id_source');
+ if ($id_source) {
+ $str .= " id_source=\"".$id_source->value."\"";
+ }
+ }
+ $str .= ">";
+
my @all_anns = $seq->annotation->get_Annotations();
foreach my $ann (@all_anns) {
my $key = $ann->tagname;
Modified: bioperl-live/trunk/t/phyloxml.t
===================================================================
--- bioperl-live/trunk/t/phyloxml.t 2008-08-15 21:57:41 UTC (rev 14804)
+++ bioperl-live/trunk/t/phyloxml.t 2008-08-16 02:35:26 UTC (rev 14805)
@@ -7,7 +7,7 @@
use lib 't/lib';
use BioperlTest;
- test_begin(-tests => 69,
+ test_begin(-tests => 73,
-requires_modules => [qw(XML::LibXML XML::LibXML::Reader)],
);
if (1000*$] < 5008) {
@@ -167,16 +167,23 @@
diag("tree id: ",$tree->id);
}
my $C = $tree->find_node('C');
-
+ my ($ac) = $C->annotation->get_Annotations('taxonomy');
+ isa_ok( $ac, 'Bio::Annotation::Collection');
+ my ($ac2) = $ac->get_Annotations('scientific_name');
+ isa_ok( $ac2, 'Bio::Annotation::Collection');
+ my ($scientificname) = $ac2->get_Annotations('_text');
+ is($scientificname->as_text, 'Value: C. elegans');
if ($verbose > 0) {
- diag($C->to_string());
+ diag( "Node C Scientific Name: ",$scientificname->as_text);
}
- my $leaves_string = $tree->simplify_to_leaves_string();
+ my ($ac3) = $C->annotation->get_nested_Annotations(-keys=>['scientific_name'], -recursive=>1);
+ isa_ok( $ac3, 'Bio::Annotation::Collection');
+ ($scientificname) = $ac2->get_Annotations('_text');
+ is($scientificname->as_text, 'Value: C. elegans');
if ($verbose > 0) {
- diag($leaves_string);
+ diag( "Node C Scientific Name: ",$scientificname->as_text);
}
- is($leaves_string, '((A,B),C)');
-
+
# write_tree
if ($verbose > 0) {
diag("\ntest write_tree");
More information about the Bioperl-guts-l
mailing list