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.3';
3             # ABSTRACT: Combine multiple plotfiles and generate updated statistics for the combined files
4              
5              
6 1     1   93314 use Moose;
  1         409374  
  1         8  
7 1     1   7180 use strict;
  1         2  
  1         24  
8 1     1   5 use warnings;
  1         2  
  1         22  
9 1     1   817 use File::Temp;
  1         13878  
  1         66  
10 1     1   7 use File::Path qw( remove_tree );
  1         1  
  1         36  
11 1     1   5 use Data::Dumper;
  1         2  
  1         34  
12 1     1   4 use Cwd;
  1         2  
  1         41  
13 1     1   331 use Bio::Tradis::Analysis::Exceptions;
  1         7  
  1         1427  
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   64 my $tmp_dir = File::Temp->newdir( DIR=> getcwd, CLEANUP => 0 );
48 3         1504 return $tmp_dir->dirname;
49             }
50              
51             sub _build__stats_handle {
52 3     3   8 my ($self) = @_;
53 3         54 my $filelist = $self->plotfile;
54 3         29 $filelist =~ s/([^\/]+$)//;
55 3         14 my $filename = $1;
56 3         17 $filename =~ s/[^\.]+$/stats/;
57 3         229 open( my $stats, ">", $filename );
58 3         79 return $stats;
59             }
60              
61             sub _build__plot_handle {
62 3     3   9 my ($self) = @_;
63 3         69 my $plot = $self->plotfile;
64 3         152 open( my $plot_h, "<", $plot );
65 3         73 return $plot_h;
66             }
67              
68             sub _build__ordered_plot_ids {
69 3     3   8 my ($self) = @_;
70 3         64 my $filelist = $self->plotfile;
71              
72 3         9433 my @id_order = `awk '{print \$1}' $filelist`;
73 3         38 foreach my $id (@id_order) {
74 5         20 chomp($id);
75             }
76 3         166 return \@id_order;
77             }
78              
79             sub combine {
80 3     3 0 11 my ($self) = @_;
81 3         79 my $ordered_keys = $self->_ordered_plot_ids;
82 3         92 my $plot_handle = $self->_plot_handle;
83 3         67 my $combined_dir = $self->combined_dir;
84              
85 3         15 $self->_write_stats_header;
86              
87              
88 3 100       10361 system("mkdir $combined_dir") unless ( -d "$combined_dir" );
89 3         25 my @tabix_plot;
90              
91 3         59 while ( my $line = <$plot_handle> ) {
92             #parse line into hash. keys = id, len, files. unzips files if needed.
93 5         45 my %plothash = $self->_parse_line($line);
94 5         24 my $id = $plothash{'id'};
95              
96             #create output plot file
97 5         25 my $comb_plot_name = "$combined_dir/$id.insert_site_plot";
98 5         16 my $filelen = $plothash{'len'};
99 5         18 my ( @currentlines, $this_line );
100              
101 5         0 my @full_plot;
102 5         24 foreach my $i ( 0 .. $filelen ) {
103 195         329 @currentlines = ();
104              
105 195         237 foreach my $curr_fh ( @{ $plothash{'files'} } ) {
  195         316  
106 390         666 $this_line = <$curr_fh>;
107 390 50 33     1555 push( @currentlines, $this_line ) if( defined $line && $line ne "");
108             }
109              
110 195         428 my $comb_line = $self->_combine_lines( \@currentlines );
111              
112 195         278 my $plot_values_tabix = $comb_line;
113 195 100 66     938 $plot_values_tabix =~ s/\s/\t/ if(defined $plot_values_tabix && $plot_values_tabix ne "");
114              
115 195         306 my $tabix_line;
116 195 100       411 if ($id !~ m/^zip_combined/) {
117 94 100 66     498 my $tabix_line = "$id\t$i\t" . $plot_values_tabix if( defined $plot_values_tabix && $plot_values_tabix ne "");
118 94 100       270 push( @tabix_plot, $tabix_line ) if( $comb_line ne "");
119             }
120              
121 195 100       500 push(@full_plot, $comb_line) if ( $comb_line ne '' );
122             }
123              
124 5         373 open( CPLOT, '>', $comb_plot_name );
125 5         66 print CPLOT join("\n", @full_plot);
126 5         175 close(CPLOT);
127              
128 5         42 $self->_write_stats($id, $filelen);
129 5         10765 system("gzip -f $comb_plot_name");
130             }
131              
132              
133 3 100       31 if (@tabix_plot) {
134 2         22 $self->_prepare_and_create_tabix_for_combined_plots(\@tabix_plot);
135             }
136              
137 3         44 File::Temp::cleanup();
138             # double check tmp dir is deleted. cleanup not working properly
139 3         344 remove_tree($self->_destination);
140 3         89 return 1;
141             }
142              
143             sub _prepare_and_create_tabix_for_combined_plots {
144              
145 2     2   10 my ($self, $tabix_plot) = @_;
146              
147 2         8 my $tabix_plot_name = "combined/tabix.insert_site_plot.gz";
148 2         7 my $sorted_tabix_plot_name = "combined/tabix_sorted.insert_site_plot.gz";
149              
150 2 50       2922 open(my $tabix_plot_fh , '|-', " gzip >". $tabix_plot_name) or warn "Couldn't create the initial plot file for tabix";
151 2         16 print $tabix_plot_fh join( "\n", @{ $tabix_plot } );
  2         56  
152 2         2559 close($tabix_plot_fh);
153              
154 2         7662 `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         188 unlink($tabix_plot_name);
156              
157             }
158              
159              
160             sub _parse_line {
161 5     5   24 my ( $self, $line ) = @_;
162 5         15 chomp $line;
163 5         58 my @fields = split( /\s+/, $line );
164 5         19 my $id = shift @fields;
165 5         12 my @files = @{ $self->_unzip_plots(\@fields) };
  5         32  
166 5         26 my $len = $self->_get_file_len( \@files );
167 5 50       23 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         14 my @file_hs;
172 5         14 foreach my $f (@files){
173 10         336 open(my $fh, "<", $f);
174 10         44 push(@file_hs, $fh);
175             }
176 5         90 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         9 my @lens;
185 5         17 for my $f ( @{$files} ) {
  5         15  
186 10         28415 my $wc = `wc $f | awk '{print \$1}'`;
187 10         66 chomp $wc;
188 10         91 push( @lens, $wc );
189             }
190              
191 5         33 my $l = shift @lens;
192 5         17 for my $x (@lens) {
193 5 50       36 return 0 if ( $x != $l );
194             }
195 5         34 return $l+1;
196             }
197              
198             sub _combine_lines {
199 195     195   354 my ( $self, $lines ) = @_;
200              
201 195         307 my @totals = ( 0, 0 );
202 195         220 foreach my $l ( @{$lines} ) {
  195         312  
203 385 100       707 if(!defined($l)){
204 5         24 return "";
205 0         0 next;
206             }
207 380         1164 my @cols = split( /\s+/, $l );
208 380         686 $totals[0] += $cols[0];
209 380         664 $totals[1] += $cols[1];
210             }
211 190         613 return join( " ", @totals );
212             }
213              
214             sub _write_stats_header {
215 3     3   8 my ($self) = @_;
216 3         16 my @fields =
217             ( "ID", "Sequence Length", "Unique Insertion Sites", "Seq Len/UIS" );
218 3         6 print { $self->_stats_handle } join( ",", @fields ) . "\n";
  3         61  
219 3         8 return 1;
220             }
221              
222             sub _write_stats {
223 5     5   15 my ( $self, $id, $seq_len ) = @_;
224 5         292 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         15102 my $uis = `grep -c -v "0 0" $comb_plot`;
230 5         35 chomp($uis);
231 5         17 my $sl_per_uis = "NaN";
232 5 50       33 $sl_per_uis = $seq_len / $uis if($uis > 0);
233              
234 5         61 my $stats = "$id,$seq_len,$uis,$sl_per_uis\n";
235 5         22 print { $self->_stats_handle } $stats;
  5         289  
236              
237 5         36 return 1;
238             }
239              
240             sub _abs_path_list {
241 5     5   14 my ( $self, $files ) = @_;
242 5         19 my $plot_path = $self->_get_plotfile_path;
243              
244 5         8 my @pathlist;
245 5         11 foreach my $f ( @{$files} ) {
  5         44  
246 10 50       30 if ( $f =~ /^\// ) { push( @pathlist, $f ); }
  0         0  
247 10         36 else { push( @pathlist, $plot_path . $f ); }
248             }
249 5         22 return \@pathlist;
250             }
251              
252             sub _get_plotfile_path {
253 5     5   12 my ($self) = @_;
254 5         111 my $plotfile = $self->plotfile;
255              
256 5         24 my @dirs = split( '/', $plotfile );
257 5         11 pop(@dirs);
258 5         18 my $path2plot = join( '/', @dirs );
259 5         21 return "$path2plot/";
260             }
261              
262             sub _is_gz {
263 10     10   26 my ( $self, $plotname ) = @_;
264              
265 10 100       39 if ( $plotname =~ /\.gz$/ ) {
266 2         11 return 1;
267             }
268             else {
269 8         20 return 0;
270             }
271             }
272              
273             sub _unzip_plots {
274 5     5   16 my ( $self, $files ) = @_;
275 5         224 my $destination_directory = $self->_destination;
276              
277 5         10 my @filelist = @{ $self->_abs_path_list($files) };
  5         21  
278 5         10 my @unz_plots;
279 5         16 foreach my $plotname ( @filelist ) {
280 10 50       145 Bio::Tradis::Analysis::Exceptions::FileNotFound->throw("Cannot find $plotname\n") unless ( -e $plotname );
281 10 100       67 if ( $self->_is_gz($plotname) ) {
282 2         14 $plotname =~ /([^\/]+$)/;
283 2         10 my $unz = $1;
284 2         9 $unz =~ s/\.gz//;
285 2         11 my $unzip_cmd = "gunzip -c $plotname > $destination_directory/$unz";
286 2         6302 system($unzip_cmd);
287 2         54 push(@unz_plots, "$destination_directory/$unz");
288             }
289             else {
290 8         17 push(@unz_plots, $plotname);
291             }
292             }
293 5         36 return \@unz_plots;
294             }
295              
296             __PACKAGE__->meta->make_immutable;
297 1     1   8 no Moose;
  1         1  
  1         9  
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.3
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