| 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; |