[Bioperl-guts-l] [14802] bioperl-live/trunk/Bio: get_nested_Annotations

miraceti at dev.open-bio.org miraceti at dev.open-bio.org
Fri Aug 15 02:01:19 EDT 2008


Revision: 14802
Author:   miraceti
Date:     2008-08-15 02:01:18 -0400 (Fri, 15 Aug 2008)

Log Message:
-----------
get_nested_Annotations

Modified Paths:
--------------
    bioperl-live/trunk/Bio/Annotation/Collection.pm
    bioperl-live/trunk/Bio/TreeIO/phyloxml.pm

Modified: bioperl-live/trunk/Bio/Annotation/Collection.pm
===================================================================
--- bioperl-live/trunk/Bio/Annotation/Collection.pm	2008-08-14 15:23:24 UTC (rev 14801)
+++ bioperl-live/trunk/Bio/Annotation/Collection.pm	2008-08-15 06:01:18 UTC (rev 14802)
@@ -149,16 +149,90 @@
     my @anns = ();
     @keys = $self->get_all_annotation_keys() unless @keys;
     foreach my $key (@keys) {
-	if(exists($self->{'_annotation'}->{$key})) {
-	    push(@anns,
-		 map {
-		     $_->tagname($key) if ! $_->tagname(); $_;
-		 } @{$self->{'_annotation'}->{$key}});
-	}
+      if(exists($self->{'_annotation'}->{$key})) {
+        push(@anns,
+            map {
+            $_->tagname($key) if ! $_->tagname(); $_;
+            } @{$self->{'_annotation'}->{$key}});
+      }
     }
     return @anns;
 }
 
+
+=head2 get_nested_Annotations
+
+ Title   : get_nested_Annotations
+ Usage   : my @annotations = $collection->get_nested_Annotations(
+                                '-key' => \@keys,
+                                '-recursive => 1);
+ Function: Retrieves all the Bio::AnnotationI objects for one or more
+           specific key(s). If -recursive is set to true, traverses the nested 
+           annotation collections recursively and returns all annotations 
+           matching the key(s).
+
+           If no key is given, returns all annotation objects.
+
+           The returned objects will have their tagname() attribute set to
+           the key under which they were attached, unless the tagname was
+           already set.
+
+ Returns : list of Bio::AnnotationI - empty if no objects stored for a key
+ Args    : -keys      => arrayref of keys to search for (optional)
+           -recursive => boolean, whether or not to recursively traverse the 
+            nested annotations and return annotations with matching keys.
+
+=cut
+
+sub get_nested_Annotations {
+  my ($self, @args) = @_;
+  my ($keys, $recursive) = $self->_rearrange([qw(KEYS RECURSIVE)], @args);
+  $self->verbose(1);
+  
+  my @anns = ();
+  # if not recursive behave exactly like get_Annotations()
+  if (!$recursive) {
+	  my @keys = $keys? @$keys : $self->get_all_annotation_keys();
+    foreach my $key (@keys) {
+      if(exists($self->{'_annotation'}->{$key})) {
+        push(@anns,
+            map {
+            $_->tagname($key) if ! $_->tagname(); $_;
+            } @{$self->{'_annotation'}->{$key}});
+      }
+    }
+  }
+  # if recursive search for keys recursively
+  else {
+    my @allkeys = $self->get_all_annotation_keys();
+    foreach my $key (@allkeys) {
+      my $keymatch = 0;
+      foreach my $searchkey (@$keys) {
+        if ($key eq $searchkey) { $keymatch = 1;}
+      }
+      if ($keymatch) {
+        if(exists($self->{'_annotation'}->{$key})) {
+          push(@anns,
+              map {
+              $_->tagname($key) if ! $_->tagname(); $_;
+              } @{$self->{'_annotation'}->{$key}});
+        }
+      }
+      else {
+        my @annotations = @{$self->{'_annotation'}->{$key}};
+        foreach (@annotations) {
+          if ($_->isa("Bio::AnnotationCollectionI")) {
+            push (@anns, 
+                  $_->get_nested_Annotations('-keys' => $keys, '-recursive' => 1)
+                 );
+          }
+        }
+      }
+    }
+  }
+  return @anns;
+}
+
 =head2 get_all_Annotations
 
  Title   : get_all_Annotations
@@ -189,60 +263,7 @@
     } $self->get_Annotations(@keys);
 }
 
-=head2 get_deep_Annotations
 
- Title   : get_deep_Annotations
- Usage   :
- Function: Similar to get_Annotations, but traverses the nested 
-           annotation collections and returns all annotations with 
-           matching keys. 
-
-           It is different from get_all_Annotations in that the
-           keys are passed on to nested collections. and nested 
-           collections are not flattened.
-
- Example :
- Returns : an array of L<Bio::AnnotationI> compliant objects
- Args    : keys (list of strings) for annotations (optional)
-
-
-=cut
-
-sub get_deep_Annotations{
-    my ($self, at searchkeys) = @_;
-
-    my @anns = ();
-    $self->_deep_Annotation_helper(\@searchkeys, \@anns);
-    return @anns;
-}    
-
-sub _deep_Annotation_helper {
-  my ($self, $searchkeys, $anns) = @_;
-  my @allkeys = $self->get_all_annotation_keys();
-  foreach my $key (@allkeys) {
-    my $keymatch = 0;
-    foreach my $searchkey (@$searchkeys) {
-      if ($key eq $searchkey) { $keymatch = 1;}
-    }
-    if ($keymatch) {
-      if(exists($self->{'_annotation'}->{$key})) {
-        push(@$anns,
-            map {
-            $_->tagname($key) if ! $_->tagname(); $_;
-            } @{$self->{'_annotation'}->{$key}});
-      }
-    }
-    else {
-      my @annotations = @{$self->{'_annotation'}->{$key}};
-      foreach (@annotations) {
-        if ($_->isa("Bio::AnnotationCollectionI")) {
-          $_->_deep_Annotation_helper($searchkeys, $anns);
-        }
-      }
-    }
-  }
-}
-
 =head2 get_num_of_annotations
 
  Title   : get_num_of_annotations

Modified: bioperl-live/trunk/Bio/TreeIO/phyloxml.pm
===================================================================
--- bioperl-live/trunk/Bio/TreeIO/phyloxml.pm	2008-08-14 15:23:24 UTC (rev 14801)
+++ bioperl-live/trunk/Bio/TreeIO/phyloxml.pm	2008-08-15 06:01:18 UTC (rev 14802)
@@ -202,7 +202,6 @@
   my @relations = $ac->get_Annotations('clade_relation');
   foreach (@relations) {
     my $clade_rel = $self->relation_to_string($node, $_, '');
-    $self->debug("write clade_relations: ", $clade_rel);
     # set as tree attr
     push (@{$self->{'_tree_attr'}->{'clade_relation'}}, $clade_rel);
   }
@@ -240,12 +239,13 @@
   my @attr = $node->annotation->get_Annotations('_attr'); # check id_source
   if (@attr) { 
     my @id_source = $attr[0]->get_Annotations('id_source');
-    if (@id_source) {
-      $self->debug("idsrc:",$id_source[0]->as_text);
-    }
   }
-  my ($id_ref_0) = $node->annotation->get_deep_Annotations('id_source'); 
-  my ($id_ref_1) = $rel->to->annotation->get_deep_Annotations('id_source'); 
+  my ($id_ref_0) = $node->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."\" ";




More information about the Bioperl-guts-l mailing list