]> git.donarmstrong.com Git - biopieces.git/blob - code_perl/Maasha/NClist.pm
added NClist.pm
[biopieces.git] / code_perl / Maasha / NClist.pm
1 package Maasha::NClist;
2
3 # Copyright (C) 2010 Martin A. Hansen.
4
5 # This program is free software; you can redistribute it and/or
6 # modify it under the terms of the GNU General Public License
7 # as published by the Free Software Foundation; either version 2
8 # of the License, or (at your option) any later version.
9
10 # This program is distributed in the hope that it will be useful,
11 # but WITHOUT ANY WARRANTY; without even the implied warranty of
12 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
13 # GNU General Public License for more details.
14
15 # You should have received a copy of the GNU General Public License
16 # along with this program; if not, write to the Free Software
17 # Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
18
19 # http://www.gnu.org/copyleft/gpl.html
20
21
22 # >>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> DESCRIPTION <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
23
24
25 # Nested Containment List (NCList): A new algorithm for accelerating
26 # interval query of genome alignment and interval databases
27 # http://bioinformatics.oxfordjournals.org/cgi/content/abstract/btl647v1
28
29 # Nested lists are composed of intervals defined by begin and end positions,
30 # and any interval that is contained within another interval is rooted to this.
31 # Thus, fast interval lookups can be performed using binary search.
32
33
34 # >>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>><<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
35
36
37 use warnings;
38 use strict;
39
40 use Maasha::Filesys;
41 use Storable;
42 use Data::Dumper;
43 use Json::XS;
44
45 use vars qw( @ISA @EXPORT );
46
47 @ISA = qw( Exporter );
48
49
50 # >>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> SUBROUTINES <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
51
52
53 sub nc_list_create
54 {
55     # Martin A. Hansen, February 2010.
56
57     # Creates a Nested Containment (NC) list from a stack of features.
58     # The features consits of an AoA where beg and end specifies the
59     # elements containing the begin and end position of a feature, and
60     # index specifies a element used for nesting lists.
61
62     my ( $features,   # list of features AoA
63          $beg,        # feature element with begin position
64          $end,        # feature element with end position
65          $index,      # feature element with index position
66        ) = @_;
67
68     # Returns a list.
69
70     my ( $nc_list );
71
72     @{ $features } = sort { $a->[ $beg ] <=> $b->[ $beg ] or $b->[ $end ] <=> $a->[ $end ] } @{ $features };
73
74     $nc_list = [ shift @{ $features } ];
75
76     map { nc_list_add( $nc_list, $_, $end, $index ) } @{ $features };
77
78     return wantarray ? @{ $nc_list } : $nc_list;
79 }
80
81
82 sub nc_list_add
83 {
84     # Martin A. Hansen, February 2010.
85     
86     # Recursively construct a Nested Containment (NC) list by added
87     # a given feature to an existing NC list.
88
89     my ( $nc_list,   # NC list
90          $feat,      # feature (AoA)
91          $end,       # feature element with end position
92          $index      # feature element with index position
93        ) = @_;
94
95     # Returns nothing.
96
97     if ( $feat->[ $end ] <= $nc_list->[ -1 ]->[ $end ] ) # feature is nested.
98     {
99         if ( defined $nc_list->[ -1 ]->[ $index ] ) {   # sublist exists so recurse to this.
100             nc_list_add( $nc_list->[ -1 ]->[ $index ], $feat, $end, $index );
101         } else {
102             $nc_list->[ -1 ]->[ $index ] = [ $feat ];   # creating a new sublist.
103         }
104     }
105     else
106     {
107         push @{ $nc_list }, $feat;
108     }
109 }
110
111
112 sub nc_list_lookup
113 {
114     # Martin A. Hansen, February 2010.
115     
116     # Given a Nested Containment (NC) list use binary search to locate
117     # the NC list containing a given search position. The index of the NC
118     # list containing the search position is returned.
119
120     my ( $nc_list,   # NC list
121          $pos,       # search position
122          $beg,       # feature element with begin position
123          $end,       # feature element with end position
124          $index,     # feature element with index position
125        ) = @_;
126
127     # Returns an integer.
128
129     my ( $low, $high, $try );
130
131     $low  = 0;
132     $high = scalar @{ $nc_list };
133
134     while ( $low < $high )
135     {
136         $try = int( ( $high + $low ) / 2 );
137
138         if ( $pos < $nc_list->[ $try ]->[ $beg ] ) {
139             $high = $try;
140         } elsif ( $nc_list->[ $try ]->[ $end ] < $pos ) {
141             $low = $try + 1;
142         } else {
143             last;
144         }
145     }
146
147     return $try;
148 }
149
150
151 sub nc_list_count
152 {
153     # Martin A. Hansen, February 2010.
154
155     # Traverses a Nested Containment (NC) list recursively from a
156     # given index begin to a given index end and counts all
157     # features. The count is returned.
158
159     my ( $nc_list,     # NC list
160          $index_beg,   # index begin
161          $index_end,   # index end
162          $index,       # feature element with index position
163        ) = @_;
164
165     # Returns an integer.
166
167     my ( $i, $count );
168
169     for ( $i = $index_beg; $i <= $index_end; $i++ )
170     {
171         $count++;
172     
173         if ( defined $nc_list->[ $i ]->[ $index ] ) {   # sublist exists so recurse to this.
174             $count += nc_list_count( $nc_list->[ $i ]->[ $index ], 0, scalar @{ $nc_list->[ $i ]->[ $index ] } - 1, $index );
175         }
176     }
177
178     return $count;
179 }
180
181
182 sub nc_list_count_interval
183 {
184     # Martin A. Hansen, February 2010.
185
186     # Counts all features in a Nested Containment (NC) list within a
187     # specified interval. The count is returned.
188
189     my ( $nc_list,   # NC list
190          $int_beg,   # interval begin
191          $int_end,   # interval end
192          $beg,       # feature element with begin position
193          $end,       # feature element with end position
194          $index,     # feature element with index position
195        ) = @_;
196
197     # Returns an integer.
198
199     my ( $index_beg, $index_end, $count );
200
201     $index_beg = nc_list_lookup( $nc_list, $int_beg, $beg, $end, $index );
202     $index_end = nc_list_lookup( $nc_list, $int_end, $beg, $end, $index );
203
204     $count = nc_list_count( $nc_list, $index_beg, $index_end, $index );
205
206     return $count;
207 }
208
209
210 sub nc_list_get
211 {
212     # Martin A. Hansen, February 2010.
213
214     # Recursively retrieve all features from a Nested Containment (NC) list
215     # from a specified index begin to a specified index end. The index is 
216     # stripped.
217
218     my ( $nc_list,     # NC list
219          $index_beg,   # index begin
220          $index_end,   # index end
221          $index,       # feature element with index position
222        ) = @_;
223
224     # Returns a list.
225
226     my ( $i, $nc, @features );
227
228     for ( $i = $index_beg; $i <= $index_end; $i++ )
229     {
230         $nc = Storable::dclone( $nc_list->[ $i ] );
231
232         push @features, $nc;
233
234         if ( defined $nc_list->[ $i ]->[ $index ] ) # sublist exists so recurse to this.
235         {  
236             push @features, nc_list_get( $nc_list->[ $i ]->[ $index ], 0, scalar @{ $nc_list->[ $i ]->[ $index ] } - 1, $index );
237
238             delete $nc->[ $index ];
239         }
240     }
241
242     return wantarray ? @features : \@features;
243 }
244
245
246 sub nc_list_get_interval
247 {
248     # Martin A. Hansen, February 2010.
249     
250     # Retrieve all features from a Nested Containment (NC) list from within
251     # a specified interval.
252
253     my ( $nc_list,   # NC list
254          $int_beg,   # interval begin
255          $int_end,   # interval end
256          $beg,       # feature element with begin position
257          $end,       # feature element with end position
258          $index,     # feature element with index position
259        ) = @_;
260
261     # Returns a list.
262
263     my ( $index_beg, $index_end, $features );
264
265     $index_beg = nc_list_lookup( $nc_list, $int_beg, $beg, $end, $index );
266     $index_end = nc_list_lookup( $nc_list, $int_end, $beg, $end, $index );
267
268     $features = nc_list_get( $nc_list, $index_beg, $index_end, $index );
269
270     return wantarray ? @{ $features } : $features;
271 }
272
273
274 sub nc_list_store
275 {
276     my ( $nc_list,   # NC list
277          $file,      # path to file
278        ) = @_;
279
280     # Returns nothing.
281     
282     my ( $fh, $json );
283
284     $json = JSON::XS::encode_json( $nc_list );
285
286     $fh = Maasha::Filesys::file_write_open( $file );
287
288     print $fh $json;
289
290     close $fh;
291 }
292
293
294 sub nc_list_retieve
295 {
296     # Martin A. Hansen, February 2010.
297
298     # Retrieves a Nested Containment (NC) list from a
299     # JSON file.
300
301     my ( $file,   # path to JSON file
302        ) = @_;
303
304     # Returns NC list.
305
306     my ( $fh, $json, $nc_list );
307
308     local $/ = undef;
309
310     $fh = Maasha::Filesys::file_read_open( $file );
311
312     $json = <$fh>;
313
314     close $fh;
315
316     $nc_list = JSON::XS::decode_json( $json );
317
318     return wantarray ? @{ $nc_list } : $nc_list;
319 }
320
321
322 # >>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>><<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
323
324
325 1;