File Coverage

blib/lib/App/RL/Command/coverage.pm
Criterion Covered Total %
statement 93 95 97.8
branch 19 26 73.0
condition n/a
subroutine 11 11 100.0
pod 5 5 100.0
total 128 137 93.4


line stmt bran cond sub pod time code
1             package App::RL::Command::coverage;
2 14     14   8641 use strict;
  14         31  
  14         376  
3 14     14   67 use warnings;
  14         27  
  14         355  
4 14     14   63 use autodie;
  14         30  
  14         73  
5              
6 14     14   68574 use App::RL -command;
  14         30  
  14         128  
7 14     14   4395 use App::RL::Common;
  14         32  
  14         388  
8              
9 14     14   76 use constant abstract => 'output detailed depthes of coverages on chromosomes';
  14         28  
  14         12590  
10              
11             sub opt_spec {
12             return (
13 6     6 1 48 [ "outfile|o=s", "Output filename. [stdout] for screen", ],
14             [ "size|s=s", "chr.sizes", { required => 1 }, ],
15             [ "max|m=i", "count to this depth", { default => 1 }, ],
16             { show_defaults => 1, }
17             );
18             }
19              
20             sub usage_desc {
21 6     6 1 43084 return "runlist coverage [options] ";
22             }
23              
24             sub description {
25 1     1 1 1041 my $desc;
26 1         3 $desc .= ucfirst(abstract) . ".\n";
27 1         3 $desc .= " " x 4 . "Like `runlist cover`, also output depthes of coverages.\n";
28 1         2 $desc .= " " x 4 . "I:1-100\n";
29 1         2 $desc .= " " x 4 . "I(+):90-150\n";
30 1         4 $desc .= " " x 4 . "S288c.I(-):190-200\tSpecies names will be omitted.\n";
31 1         3 return $desc;
32             }
33              
34             sub validate_args {
35 4     4 1 4489 my ( $self, $opt, $args ) = @_;
36              
37 4 100       8 if ( !@{$args} ) {
  4         16  
38 1         4 my $message = "This command need one or more input files.\n\tIt found";
39 1         2 $message .= sprintf " [%s]", $_ for @{$args};
  1         4  
40 1         3 $message .= ".\n";
41 1         10 $self->usage_error($message);
42             }
43 3         6 for ( @{$args} ) {
  3         9  
44 3 50       11 next if lc $_ eq "stdin";
45 3 100       14 if ( !Path::Tiny::path($_)->is_file ) {
46 1         103 $self->usage_error("The input file [$_] doesn't exist.");
47             }
48             }
49              
50 2 50       129 if ( !exists $opt->{outfile} ) {
51 0         0 $opt->{outfile} = Path::Tiny::path( $args->[0] )->absolute . ".yml";
52             }
53             }
54              
55             sub execute {
56 2     2 1 15 my ( $self, $opt, $args ) = @_;
57              
58 2         13 my $length_of = App::RL::Common::read_sizes( $opt->{size} );
59              
60 2         5 my %count_of; # YAML::Sync can't Dump tied hashes
61 2         8 for my $depth ( 0 .. $opt->{max} ) {
62 8 50       20 if ( !exists $count_of{$depth} ) {
63 8         18 $count_of{$depth} = {};
64             }
65             }
66             {
67 2         5 for my $chr ( keys %{$length_of} ) {
  2         3  
  2         10  
68 32         1626 $count_of{0}->{$chr} = App::RL::Common::new_set();
69 32         319 $count_of{0}->{$chr}->add_pair( 1, $length_of->{$chr} );
70             }
71             }
72              
73 2         105 for my $infile ( @{$args} ) {
  2         5  
74 2         5 for my $line ( App::RL::Common::read_lines($infile) ) {
75 10 50       32 next if substr( $line, 0, 1 ) eq "#";
76              
77 10         27 my $info = App::RL::Common::decode_header($line);
78 10 50       23 next unless App::RL::Common::info_is_valid($info);
79              
80 10         35 my $chr_name = $info->{chr};
81 10 50       66 next unless exists $length_of->{$chr_name};
82              
83             # count depth
84 10         24 my $set = App::RL::Common::new_set()->add_pair( $info->{start}, $info->{end} );
85 10         735 $set = $count_of{0}->{$chr_name}->intersect($set);
86 10         3139 DEPTH: for my $cur ( 0 .. $opt->{max} ) {
87 21 100       63 if ( !exists $count_of{$cur}->{$chr_name} ) {
88 5         13 $count_of{$cur}->{$chr_name} = App::RL::Common::new_set();
89             }
90              
91             #
92 21         91 my $iset_cur = $count_of{$cur}->{$chr_name}->intersect($set);
93              
94 21 100       5313 if ( $iset_cur->is_empty ) {
95 9         120 $count_of{$cur}->{$chr_name}->add($set);
96 9         737 $set->clear;
97 9         81 last DEPTH;
98             }
99             else {
100 12         166 $count_of{$cur}->{$chr_name}->add($set);
101 12         1165 $set = $iset_cur;
102             }
103             }
104             }
105             }
106              
107             # remove regions from lower coverages
108 2         20 my $max_depth = List::Util::max( keys %count_of );
109 2         8 for my $i ( 0 .. $max_depth - 1 ) {
110 6         13 for my $j ( $i + 1 .. $max_depth ) {
111 16         167 for my $chr_name ( keys %{ $count_of{$i} } ) {
  16         42  
112 107 100       1038 if ( exists $count_of{$j}->{$chr_name} ) {
113 6         18 $count_of{$i}->{$chr_name}->remove( $count_of{$j}->{$chr_name} );
114             }
115             }
116             }
117             }
118              
119             # IntSpan to runlist
120 2         219 for my $key ( keys %count_of ) {
121 8 100       111 if ( keys %{ $count_of{$key} } == 0 ) {
  8         22  
122 3         6 delete $count_of{$key};
123 3         5 next;
124             }
125 5         7 for my $chr_name ( keys %{ $count_of{$key} } ) {
  5         18  
126 37         1064 $count_of{$key}->{$chr_name} = $count_of{$key}->{$chr_name}->runlist;
127             }
128             }
129              
130             #----------------------------#
131             # Output
132             #----------------------------#
133 2         65 my $out_fh;
134 2 50       9 if ( lc( $opt->{outfile} ) eq "stdout" ) {
135 2         7 $out_fh = *STDOUT;
136             }
137             else {
138 0         0 open $out_fh, ">", $opt->{outfile};
139             }
140              
141 2         3 print {$out_fh} YAML::Syck::Dump( \%count_of );
  2         12  
142 2         271 close $out_fh;
143             }
144              
145             1;