File Coverage

lib/Bio/Tradis/CombinePlots.pm
Criterion Covered Total %
statement 177 180 98.3
branch 27 34 79.4
condition 5 9 55.5
subroutine 24 24 100.0
pod 0 1 0.0
total 233 248 93.9


line stmt bran cond sub pod time code
1             package Bio::Tradis::CombinePlots;
2             $Bio::Tradis::CombinePlots::VERSION = '1.3.2';
3             # ABSTRACT: Combine multiple plotfiles and generate updated statistics for the combined files
4              
5              
6 1     1   88412 use Moose;
  1         398297  
  1         7  
7 1     1   6722 use strict;
  1         2  
  1         17  
8 1     1   5 use warnings;
  1         2  
  1         25  
9 1     1   764 use File::Temp;
  1         13477  
  1         62  
10 1     1   6 use File::Path qw( remove_tree );
  1         2  
  1         43  
11 1     1   5 use Data::Dumper;
  1         2  
  1         46  
12 1     1   7 use Cwd;
  1         3  
  1         67  
13 1     1   358 use Bio::Tradis::Analysis::Exceptions;
  1         6  
  1         1321  
14              
15             has 'plotfile' => ( is => 'rw', isa => 'Str', required => 1 );
16             has 'combined_dir' => ( is => 'rw', isa => 'Str', default => 'combined' );
17             has '_plot_handle' => (
18             is => 'ro',
19             isa => 'FileHandle',
20             required => 0,
21             lazy => 1,
22             builder => '_build__plot_handle'
23             );
24             has '_stats_handle' => (
25             is => 'ro',
26             isa => 'FileHandle',
27             required => 0,
28             lazy => 1,
29             builder => '_build__stats_handle'
30             );
31             has '_ordered_plot_ids' => (
32             is => 'rw',
33             isa => 'ArrayRef',
34             required => 0,
35             lazy => 1,
36             builder => '_build__ordered_plot_ids'
37             );
38             has '_destination' => (
39             is => 'rw',
40             isa => 'Str',
41             required => 0,
42             lazy => 1,
43             builder => '_build__destination'
44             );
45              
46             sub _build__destination {
47 3     3   69 my $tmp_dir = File::Temp->newdir( DIR=> getcwd, CLEANUP => 0 );
48 3         1648 return $tmp_dir->dirname;
49             }
50              
51             sub _build__stats_handle {
52 3     3   10 my ($self) = @_;
53 3         68 my $filelist = $self->plotfile;
54 3         27 $filelist =~ s/([^\/]+$)//;
55 3         16 my $filename = $1;
56 3         21 $filename =~ s/[^\.]+$/stats/;
57 3         230 open( my $stats, ">", $filename );
58 3         91 return $stats;
59             }
60              
61             sub _build__plot_handle {
62 3     3   10 my ($self) = @_;
63 3         84 my $plot = $self->plotfile;
64 3         166 open( my $plot_h, "<", $plot );
65 3         88 return $plot_h;
66             }
67              
68             sub _build__ordered_plot_ids {
69 3     3   11 my ($self) = @_;
70 3         123 my $filelist = $self->plotfile;
71              
72 3         9375 my @id_order = `awk '{print \$1}' $filelist`;
73 3         35 foreach my $id (@id_order) {
74 5         17 chomp($id);
75             }
76 3         199 return \@id_order;
77             }
78              
79             sub combine {
80 3     3 0 15 my ($self) = @_;
81 3         111 my $ordered_keys = $self->_ordered_plot_ids;
82 3         95 my $plot_handle = $self->_plot_handle;
83 3         92 my $combined_dir = $self->combined_dir;
84              
85 3         17 $self->_write_stats_header;
86              
87              
88 3 100       4390 system("mkdir $combined_dir") unless ( -d "$combined_dir" );
89 3         22 my @tabix_plot;
90              
91 3         60 while ( my $line = <$plot_handle> ) {
92             #parse line into hash. keys = id, len, files. unzips files if needed.
93 5         44 my %plothash = $self->_parse_line($line);
94 5         25 my $id = $plothash{'id'};
95              
96             #create output plot file
97 5         24 my $comb_plot_name = "$combined_dir/$id.insert_site_plot";
98 5         16 my $filelen = $plothash{'len'};
99 5         14 my ( @currentlines, $this_line );
100              
101 5         0 my @full_plot;
102 5         24 foreach my $i ( 0 .. $filelen ) {
103 195         443 @currentlines = ();
104              
105 195         300 foreach my $curr_fh ( @{ $plothash{'files'} } ) {
  195         421  
106 390         839 $this_line = <$curr_fh>;
107 390 50 33     1933 push( @currentlines, $this_line ) if( defined $line && $line ne "");
108             }
109              
110 195         549 my $comb_line = $self->_combine_lines( \@currentlines );
111              
112 195         356 my $plot_values_tabix = $comb_line;
113 195 100 66     1297 $plot_values_tabix =~ s/\s/\t/ if(defined $plot_values_tabix && $plot_values_tabix ne "");
114              
115 195         354 my $tabix_line;
116 195 100       583 if ($id !~ m/^zip_combined/) {
117 94 100 66     369 my $tabix_line = "$id\t$i\t" . $plot_values_tabix if( defined $plot_values_tabix && $plot_values_tabix ne "");
118 94 100       228 push( @tabix_plot, $tabix_line ) if( $comb_line ne "");
119             }
120              
121 195 100       660 push(@full_plot, $comb_line) if ( $comb_line ne '' );
122             }
123              
124 5         336 open( CPLOT, '>', $comb_plot_name );
125 5         78 print CPLOT join("\n", @full_plot);
126 5         224 close(CPLOT);
127              
128 5         43 $self->_write_stats($id, $filelen);
129 5         10432 system("gzip -f $comb_plot_name");
130             }
131              
132              
133 3 100       32 if (@tabix_plot) {
134 2         16 $self->_prepare_and_create_tabix_for_combined_plots(\@tabix_plot);
135             }
136              
137 3         48 File::Temp::cleanup();
138             # double check tmp dir is deleted. cleanup not working properly
139 3         344 remove_tree($self->_destination);
140 3         76 return 1;
141             }
142              
143             sub _prepare_and_create_tabix_for_combined_plots {
144              
145 2     2   9 my ($self, $tabix_plot) = @_;
146              
147 2         9 my $tabix_plot_name = "combined/tabix.insert_site_plot.gz";
148 2         6 my $sorted_tabix_plot_name = "combined/tabix_sorted.insert_site_plot.gz";
149              
150 2 50       2695 open(my $tabix_plot_fh , '|-', " gzip >". $tabix_plot_name) or warn "Couldn't create the initial plot file for tabix";
151 2         14 print $tabix_plot_fh join( "\n", @{ $tabix_plot } );
  2         46  
152 2         2230 close($tabix_plot_fh);
153              
154 2         7620 `cat $tabix_plot_name | gunzip - | sort -k1,1 -k2,2n | bgzip > $sorted_tabix_plot_name && tabix -b 2 -e 2 $sorted_tabix_plot_name`;
155 2         172 unlink($tabix_plot_name);
156              
157             }
158              
159              
160             sub _parse_line {
161 5     5   28 my ( $self, $line ) = @_;
162 5         15 chomp $line;
163 5         70 my @fields = split( /\s+/, $line );
164 5         18 my $id = shift @fields;
165 5         11 my @files = @{ $self->_unzip_plots(\@fields) };
  5         32  
166 5         34 my $len = $self->_get_file_len( \@files );
167 5 50       31 if ( $len == 0 ){
168 0         0 die "\nPlots with ID $id not of equal length.\n";
169             }
170             #build file handles for each file
171 5         17 my @file_hs;
172 5         23 foreach my $f (@files){
173 10         342 open(my $fh, "<", $f);
174 10         49 push(@file_hs, $fh);
175             }
176 5         84 return ( id => $id, len => $len, files => \@file_hs );
177             }
178              
179             sub _get_file_len {
180 5     5   15 my ( $self, $files ) = @_;
181              
182             #check all files are of equal lens and return len if true
183             #wc misses last line - return $l++
184 5         10 my @lens;
185 5         11 for my $f ( @{$files} ) {
  5         16  
186 10         30448 my $wc = `wc $f | awk '{print \$1}'`;
187 10         65 chomp $wc;
188 10         106 push( @lens, $wc );
189             }
190              
191 5         32 my $l = shift @lens;
192 5         17 for my $x (@lens) {
193 5 50       34 return 0 if ( $x != $l );
194             }
195 5         36 return $l+1;
196             }
197              
198             sub _combine_lines {
199 195     195   373 my ( $self, $lines ) = @_;
200              
201 195         411 my @totals = ( 0, 0 );
202 195         300 foreach my $l ( @{$lines} ) {
  195         378  
203 385 100       879 if(!defined($l)){
204 5         18 return "";
205 0         0 next;
206             }
207 380         1454 my @cols = split( /\s+/, $l );
208 380         828 $totals[0] += $cols[0];
209 380         969 $totals[1] += $cols[1];
210             }
211 190         722 return join( " ", @totals );
212             }
213              
214             sub _write_stats_header {
215 3     3   9 my ($self) = @_;
216 3         23 my @fields =
217             ( "ID", "Sequence Length", "Unique Insertion Sites", "Seq Len/UIS" );
218 3         7 print { $self->_stats_handle } join( ",", @fields ) . "\n";
  3         79  
219 3         9 return 1;
220             }
221              
222             sub _write_stats {
223 5     5   21 my ( $self, $id, $seq_len ) = @_;
224 5         297 my $combined_dir = $self->combined_dir;
225 5         19 my $comb_plot = "$combined_dir/$id.insert_site_plot";
226              
227             #my $seq_len = `wc $comb_plot | awk '{print \$1}'`;
228             #chomp($seq_len);
229 5         14589 my $uis = `grep -c -v "0 0" $comb_plot`;
230 5         40 chomp($uis);
231 5         25 my $sl_per_uis = "NaN";
232 5 50       33 $sl_per_uis = $seq_len / $uis if($uis > 0);
233              
234 5         56 my $stats = "$id,$seq_len,$uis,$sl_per_uis\n";
235 5         27 print { $self->_stats_handle } $stats;
  5         299  
236              
237 5         32 return 1;
238             }
239              
240             sub _abs_path_list {
241 5     5   13 my ( $self, $files ) = @_;
242 5         21 my $plot_path = $self->_get_plotfile_path;
243              
244 5         11 my @pathlist;
245 5         10 foreach my $f ( @{$files} ) {
  5         41  
246 10 50       27 if ( $f =~ /^\// ) { push( @pathlist, $f ); }
  0         0  
247 10         35 else { push( @pathlist, $plot_path . $f ); }
248             }
249 5         24 return \@pathlist;
250             }
251              
252             sub _get_plotfile_path {
253 5     5   8 my ($self) = @_;
254 5         121 my $plotfile = $self->plotfile;
255              
256 5         24 my @dirs = split( '/', $plotfile );
257 5         14 pop(@dirs);
258 5         22 my $path2plot = join( '/', @dirs );
259 5         19 return "$path2plot/";
260             }
261              
262             sub _is_gz {
263 10     10   28 my ( $self, $plotname ) = @_;
264              
265 10 100       46 if ( $plotname =~ /\.gz$/ ) {
266 2         21 return 1;
267             }
268             else {
269 8         20 return 0;
270             }
271             }
272              
273             sub _unzip_plots {
274 5     5   14 my ( $self, $files ) = @_;
275 5         241 my $destination_directory = $self->_destination;
276              
277 5         10 my @filelist = @{ $self->_abs_path_list($files) };
  5         20  
278 5         12 my @unz_plots;
279 5         14 foreach my $plotname ( @filelist ) {
280 10 50       155 Bio::Tradis::Analysis::Exceptions::FileNotFound->throw("Cannot find $plotname\n") unless ( -e $plotname );
281 10 100       50 if ( $self->_is_gz($plotname) ) {
282 2         19 $plotname =~ /([^\/]+$)/;
283 2         19 my $unz = $1;
284 2         16 $unz =~ s/\.gz//;
285 2         16 my $unzip_cmd = "gunzip -c $plotname > $destination_directory/$unz";
286 2         7184 system($unzip_cmd);
287 2         63 push(@unz_plots, "$destination_directory/$unz");
288             }
289             else {
290 8         19 push(@unz_plots, $plotname);
291             }
292             }
293 5         43 return \@unz_plots;
294             }
295              
296             __PACKAGE__->meta->make_immutable;
297 1     1   7 no Moose;
  1         2  
  1         7  
298             1;
299              
300             __END__
301              
302             =pod
303              
304             =encoding UTF-8
305              
306             =head1 NAME
307              
308             Bio::Tradis::CombinePlots - Combine multiple plotfiles and generate updated statistics for the combined files
309              
310             =head1 VERSION
311              
312             version 1.3.2
313              
314             =head1 SYNOPSIS
315              
316             Takes a tab-delimited file with an ID as the first column followed by
317             a list of plotfiles to combine per row. The ID will be used to name the new
318             plotfile and as an identifier in the stats file, so ensure these are unique.
319              
320             For example, an input file named plots_to_combine.txt:
321              
322             tradis1 plot1.1.gz plot1.2.gz plot1.3.gz
323             tradis2 plot2.1.gz plot2.2.gz
324             tradis3 plot3.1.gz plot3.2.gz plot3.3.gz plot3.4.gz
325              
326             will produce
327              
328             =over
329              
330             1. a directory named combined with 3 files - tradis1.insertion_site_plot.gz,
331             tradis2.insertion_site_plot.gz, tradis3.insertion_site_plot.gz
332             2. a stats file named plots_to_combine.stats
333              
334             =back
335              
336             =head1 USAGE
337              
338             use Bio::Tradis::CombinePlots;
339            
340             my $pipeline = Bio::Tradis::CombinePlots->new(plotfile => 'abc');
341             $pipeline->combine;
342              
343             =head1 AUTHOR
344              
345             Carla Cummins <path-help@sanger.ac.uk>
346              
347             =head1 COPYRIGHT AND LICENSE
348              
349             This software is Copyright (c) 2013 by Wellcome Trust Sanger Institute.
350              
351             This is free software, licensed under:
352              
353             The GNU General Public License, Version 3, June 2007
354              
355             =cut