[Bioperl-guts-l] [14806] bioperl-live/trunk: phyloxml more tests
miraceti at dev.open-bio.org
miraceti at dev.open-bio.org
Sat Aug 16 04:02:35 EDT 2008
Revision: 14806
Author: miraceti
Date: 2008-08-16 04:02:35 -0400 (Sat, 16 Aug 2008)
Log Message:
-----------
phyloxml more tests
Modified Paths:
--------------
bioperl-live/trunk/Bio/TreeIO/phyloxml.pm
bioperl-live/trunk/t/phyloxml.t
Modified: bioperl-live/trunk/Bio/TreeIO/phyloxml.pm
===================================================================
--- bioperl-live/trunk/Bio/TreeIO/phyloxml.pm 2008-08-16 02:35:26 UTC (rev 14805)
+++ bioperl-live/trunk/Bio/TreeIO/phyloxml.pm 2008-08-16 08:02:35 UTC (rev 14806)
@@ -204,7 +204,7 @@
# if clade_relation exists
my @relations = $ac->get_Annotations('clade_relation');
foreach (@relations) {
- my $clade_rel = $self->relation_to_string($node, $_, '');
+ my $clade_rel = $self->_relation_to_string($node, $_, '');
# set as tree attr
push (@{$self->{'_tree_attr'}->{'clade_relation'}}, $clade_rel);
}
@@ -234,7 +234,7 @@
# if sequence_relation exists
my @relations = $seq->annotation->get_Annotations('sequence_relation');
foreach (@relations) {
- my $sequence_rel = $self->relation_to_string($seq, $_, '');
+ my $sequence_rel = $self->_relation_to_string($seq, $_, '');
# set as tree attr
push (@{$self->{'_tree_attr'}->{'sequence_relation'}}, $sequence_rel);
}
@@ -246,7 +246,7 @@
return $str;
}
-sub relation_to_string {
+sub _relation_to_string {
my ($self, $obj, $rel, $str) = @_;
my @attr = $obj->annotation->get_Annotations('_attr'); # check id_source
@@ -269,7 +269,81 @@
}
+=head2 read_annotation
+ Title : read_node_annotation
+ Usage : $treeio->read_node_annotation(-obj=>$node, -path=>$path, -attr=>1);
+ Function: read text value (or attribute value) of the annotations corresponding to the element path
+ Returns : list of text values of the annotations matching the path
+ Args : Bio::Tree::AnnotatableNode object and the path of the nested elements
+
+=cut
+
+sub read_annotation
+{
+ my ($self, @args) = @_;
+ my ($obj, $path, $attr) = $self->_rearrange([qw(OBJ PATH ATTR)], @args);
+ my $ac = $obj->annotation;
+ if ($attr) {
+ my @elements = split ('/', $path);
+ my $final = pop @elements;
+ push (@elements, '_attr');
+ push (@elements, $final);
+ $path = join ('/', @elements);
+ return $self->_read_annotation_attr_Helper( [$ac], $path);
+ }
+ else {
+ return $self->_read_annotation_text_Helper( [$ac], $path);
+ }
+}
+
+sub _read_annotation_text_Helper
+{
+ my ($self, $acs, $path) = @_;
+ my @elements = split ('/', $path);
+ my $key = shift @elements;
+ my @nextacs = ();
+ foreach my $ac (@$acs) {
+ foreach my $ann ($ac->get_Annotations($key)) {
+ if ($ann->isa('Bio::AnnotationCollectionI')) {push (@nextacs, $ann)}
+ }
+ }
+ if (@elements == 0) {
+ my @values = ();
+ my @texts = map {$_->get_Annotations('_text')} @nextacs;
+ foreach (@texts) {
+ $_ && push (@values, $_->value);
+ }
+ return @values;
+ }
+ else {
+ $path = join ('/', @elements);
+ return $self->_read_annotation_text_Helper( \@nextacs, $path);
+ }
+}
+
+sub _read_annotation_attr_Helper
+{
+ my ($self, $acs, $path) = @_;
+ my @elements = split ('/', $path);
+ my $key = shift @elements;
+ my @nextacs = ();
+ foreach my $ac (@$acs) {
+ foreach my $ann ($ac->get_Annotations($key)) {
+ if ($ann->isa('Bio::AnnotationCollectionI')) {push (@nextacs, $ann)}
+ }
+ }
+ if (@elements == 1) {
+ my $attrname = $elements[0];
+ my @sv = map {$_->get_Annotations($attrname)} @nextacs;
+ return map {$_->value} @sv;
+ }
+ else {
+ $path = join ('/', @elements);
+ return $self->_read_annotation_attr_Helper( \@nextacs, $path);
+ }
+}
+
=head2 processXMLNode
Title : processXMLNode
@@ -395,7 +469,7 @@
# aggregate the nodes into trees basically ad-hoc.
if ( @{$self->{'_currentnodes'}} > 1)
{
- $root = $self->nodetype->new( -verbose => $self->verbose,
+ $root = $self->nodetype->new(
-id => '',
tostring => \&node_to_string,
);
@@ -412,7 +486,6 @@
}
my $tree = $self->treetype->new(
- -verbose => $self->verbose,
-root => $root,
-id => $self->current_attr->{'name'},
%{$self->current_attr}
@@ -441,7 +514,7 @@
my %clade_attr = (); # doesn't use current attribute in order to save memory
$self->processAttribute(\%clade_attr);
# create a node (Annotatable Node)
- my $tnode = $self->nodetype->new( -verbose => $self->verbose,
+ my $tnode = $self->nodetype->new(
-id => '',
tostring => \&node_to_string,
%clade_attr,
Modified: bioperl-live/trunk/t/phyloxml.t
===================================================================
--- bioperl-live/trunk/t/phyloxml.t 2008-08-16 02:35:26 UTC (rev 14805)
+++ bioperl-live/trunk/t/phyloxml.t 2008-08-16 08:02:35 UTC (rev 14806)
@@ -7,7 +7,7 @@
use lib 't/lib';
use BioperlTest;
- test_begin(-tests => 73,
+ test_begin(-tests => 90,
-requires_modules => [qw(XML::LibXML XML::LibXML::Reader)],
);
if (1000*$] < 5008) {
@@ -172,17 +172,28 @@
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');
+ is($scientificname->value, 'C. elegans');
if ($verbose > 0) {
- diag( "Node C Scientific Name: ",$scientificname->as_text);
+ diag( "Node C Scientific Name: ",$scientificname->value);
}
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');
+ is($scientificname->value, 'C. elegans');
if ($verbose > 0) {
- diag( "Node C Scientific Name: ",$scientificname->as_text);
+ diag( "Node C Scientific Name: ",$scientificname->value);
}
+ my ($seq) = @{$C->sequence};
+ isa_ok( $seq, 'Bio::SeqI');
+ my ($seqac) = $seq->annotation;
+ isa_ok( $seqac, 'Bio::Annotation::Collection');
+ my ($descac) = $seqac->get_nested_Annotations(-keys=>['desc'], -recursive=>1);
+ my ($desc) = $descac->get_Annotations('_text');
+ is($desc->value, 'alcohol dehydrogenase');
+ if ($verbose > 0) {
+ diag( "Node C Sequence description: ",$desc->value);
+ }
+ ($descac) = $seqac->get_nested_Annotations(-keys=>['desc'], -recursive=>1);
# write_tree
if ($verbose > 0) {
@@ -201,33 +212,50 @@
# tree5: homolog relationship and sequence relationship
# <events> <speciations> <duplications> <symbol> <accession>
+# <sequence_relation>
{
if ($verbose > 0) {
- diag("\ntree5: events");
+ diag("\ntree5: events and relations");
}
-# <sequence_relation>
my $tree = $treeio->next_tree;
isa_ok($tree, 'Bio::Tree::TreeI');
if ($verbose > 0) {
diag("tree id: ",$tree->id);
}
my $node = $tree->get_root_node;
+ my ($speciationsac) = $node->annotation->get_nested_Annotations(-keys=>['speciations'], -recursive=>1);
+ my ($speciationval) = $speciationsac->get_Annotations('_text');
+ is($speciationval->value, '1');
+ if ($verbose > 0) {
+ diag("root node speciation event: ", $speciationval->value);
+ }
my @children = ($node);
for (@children) {
push @children, $_->each_Descendent();
}
- my ($A) = $children[0];
- isa_ok($A, 'Bio::Tree::AnnotatableNode');
- my $ac = $A->annotation();
- isa_ok($ac, 'Bio::AnnotationCollectionI');
- if ($verbose > 0) {
- diag($A->to_string());
+ my @leaves = ();
+ for (@children) {
+ push @leaves, $_ if $_->is_Leaf;
}
- my $leaves_string = $tree->simplify_to_leaves_string();
- if ($verbose > 0) {
- diag($leaves_string);
+ my ($z) = $leaves[0];
+ my $z_seq = $z->sequence->[0];
+ isa_ok ($z_seq, 'Bio::SeqI');
+ my ($z_id) = $z_seq->annotation->get_nested_Annotations('-keys'=>['id_source'], '-recursive'=>1);
+ my ($z_id_text) = $z_id->value;
+ my @seq_rels = $z_seq->annotation->get_nested_Annotations('-keys'=>['sequence_relation'], '-recursive'=>1);
+ foreach my $rel (@seq_rels) {
+ isa_ok($rel, 'Bio::Annotation::Relation');
+ is ($rel->tagname, 'sequence_relation');
+ my $seqto = $rel->to;
+ isa_ok ($seqto, 'Bio::SeqI');
+ my ($seqto_id) = $seqto->annotation->get_nested_Annotations('-keys'=>['id_source'], '-recursive'=>1);
+ my $seqto_text = $seqto_id->value;
+ if ($verbose > 0) {
+ diag( "node ", $z_id_text, " has ", $rel->type, " relation to ", $seqto_text);
+ }
}
- is($leaves_string, '');
+ my ($x) = $leaves[1];
+
# write_tree
if ($verbose > 0) {
@@ -255,11 +283,27 @@
if ($verbose > 0) {
diag("tree id: ",$tree->id);
}
- my $leaves_string = $tree->simplify_to_leaves_string();
+ my @children = ($tree->get_root_node);
+ for (@children) {
+ push @children, $_->each_Descendent();
+ }
+ my @leaves = ();
+ for (@children) {
+ push @leaves, $_ if $_->is_Leaf;
+ }
+ my ($z) = $leaves[0];
+ my $z_seq = $z->sequence->[0];
+ isa_ok ($z_seq, 'Bio::SeqI');
+ my ($z_seqname) = $z_seq->annotation->get_nested_Annotations('-keys'=>['name'], '-recursive'=>1);
+ my ($z_seqname_text) = $z_seqname->get_Annotations('_text');
+ is ($z_seqname_text->value, 'NADH-dependent butanol dehydrogenase B');
+ my ($z_molseq) = $z_seq->seq;
+ is ($z_molseq, 'MVDFEYSIPTRIFFGKDKINVLGRELKKYGSKVLIVYGGGSIKRNGIYDK');
if ($verbose > 0) {
- diag($leaves_string);
+ diag("Sequence ", $z_seqname_text->value, " is ", $z_molseq);
}
- is($leaves_string, '');
+ my ($z_seqname_text2) = $treeio->read_annotation('-obj'=>$z_seq, '-path'=>'name');
+ is ($z_seqname_text->value, $z_seqname_text2);
# write_tree
if ($verbose > 0) {
@@ -287,11 +331,30 @@
if ($verbose > 0) {
diag("tree id: ",$tree->id);
}
- my $leaves_string = $tree->simplify_to_leaves_string();
- if ($verbose > 0) {
- diag($leaves_string);
+ my @children = ($tree->get_root_node);
+ for (@children) {
+ push @children, $_->each_Descendent();
}
- is($leaves_string, '((A,B),C)');
+ my @leaves = ();
+ for (@children) {
+ push @leaves, $_ if $_->is_Leaf;
+ }
+ my ($c) = $leaves[0];
+ my ($c_id) = $c->annotation->get_nested_Annotations('-keys'=>['id_source'], '-recursive'=>1);
@@ Diff output truncated at 10000 characters. @@
More information about the Bioperl-guts-l
mailing list