added missing files

[biopieces.git] / code_perl / Maasha / NClist.pm

diff --git a/code_perl/Maasha/NClist.pm b/code_perl/Maasha/NClist.pm
index eda1d4abf6a9d9c2a008ff1ab0bd77a4705bd871..9c3a71e7309d81134b73f48b46e84d0d622afc18 100644 (file)
--- a/code_perl/Maasha/NClist.pm
+++ b/code_perl/Maasha/NClist.pm
@@ -38,9 +38,9 @@ use warnings;
 use strict;
 
 use Maasha::Filesys;
-use Storable;
 use Data::Dumper;
-use Json::XS;
+use Time::HiRes;
+use JSON::XS;
 
 use vars qw( @ISA @EXPORT );
 
@@ -83,7 +83,7 @@ sub nc_list_add
 {
     # Martin A. Hansen, February 2010.
     
-    # Recursively construct a Nested Containment (NC) list by added
+    # Recursively construct a Nested Containment (NC) list by adding
     # a given feature to an existing NC list.
 
     my ( $nc_list,   # NC list
@@ -115,7 +115,7 @@ sub nc_list_lookup
     
     # Given a Nested Containment (NC) list use binary search to locate
     # the NC list containing a given search position. The index of the NC
-    # list containing the search position is returned.
+    # list containing the search position is returned. Extremely fast.
 
     my ( $nc_list,   # NC list
          $pos,       # search position
@@ -212,8 +212,9 @@ sub nc_list_get
     # Martin A. Hansen, February 2010.
 
     # Recursively retrieve all features from a Nested Containment (NC) list
-    # from a specified index begin to a specified index end. The index is 
-    # stripped.
+    # from a specified index begin to a specified index end.
+
+    # WARNING: The NC list is distroyed because the sublists are stripped.
 
     my ( $nc_list,     # NC list
          $index_beg,   # index begin
@@ -223,19 +224,17 @@ sub nc_list_get
 
     # Returns a list.
 
-    my ( $i, $nc, @features );
+    my ( $i, @features );
 
     for ( $i = $index_beg; $i <= $index_end; $i++ )
     {
-        $nc = Storable::dclone( $nc_list->[ $i ] );
-
-        push @features, $nc;
+        push @features, $nc_list->[ $i ];
 
         if ( defined $nc_list->[ $i ]->[ $index ] ) # sublist exists so recurse to this.
         {  
             push @features, nc_list_get( $nc_list->[ $i ]->[ $index ], 0, scalar @{ $nc_list->[ $i ]->[ $index ] } - 1, $index );
 
-            delete $nc->[ $index ];
+            delete $nc_list->[ $i ]->[ $index ];
         }
     }
 
@@ -271,8 +270,45 @@ sub nc_list_get_interval
 }
 
 
+sub nc_list_search
+{
+    # Martin A. Hansen, February 2010.
+
+    # Recursively search a Nested Containment (NC) list for features matching
+    # a given REGEX.
+
+    my ( $nc_list,   # NC list
+         $regex,     # regex to search for
+         $index,     # feature element with index position
+       ) = @_;
+
+    # Returns a list.
+
+    my ( $feature, @features );
+
+    foreach $feature ( @{ $nc_list } )
+    {
+        push @features, $feature if grep { $_ =~ /$regex/i if defined $_ } @{ $feature };
+
+        if ( defined $feature->[ $index ] ) # sublist exists so recurse to this.
+        {  
+            push @features, nc_list_search( $feature->[ $index ], $regex, $index );
+
+            delete $feature->[ $index ];
+        }
+    }
+
+    return wantarray ? @features : \@features;
+}
+
+
 sub nc_list_store
 {
+    # Martin A. Hansen, February 2010.
+
+    # Store a Nested Containment (NC) list to a
+    # given file.
+
     my ( $nc_list,   # NC list
          $file,      # path to file
        ) = @_;
@@ -291,7 +327,7 @@ sub nc_list_store
 }
 
 
-sub nc_list_retieve
+sub nc_list_retrieve
 {
     # Martin A. Hansen, February 2010.
 
@@ -323,3 +359,8 @@ sub nc_list_retieve
 
 
 1;
+
+__END__
+
+    my $t0 = Time::HiRes::gettimeofday();
+    my $t1 = Time::HiRes::gettimeofday(); print STDERR "Time: " . ( $t1 - $t0 ) . "\n";