File Coverage

blib/lib/CracTools/GenomeMask.pm
Criterion Covered Total %
statement 94 99 94.9
branch 18 30 60.0
condition 2 3 66.6
subroutine 15 15 100.0
pod 10 10 100.0
total 139 157 88.5


line stmt bran cond sub pod time code
1             package CracTools::GenomeMask;
2             {
3             $CracTools::GenomeMask::DIST = 'CracTools';
4             }
5             # ABSTRACT: A bit vector mask over the whole genome
6             $CracTools::GenomeMask::VERSION = '1.25';
7 1     1   13200 use strict;
  1         1  
  1         23  
8 1     1   2 use warnings;
  1         1  
  1         19  
9              
10 1     1   341 use CracTools::BitVector;
  1         2  
  1         36  
11 1     1   373 use CracTools::Utils;
  1         1  
  1         24  
12 1     1   4 use Carp;
  1         1  
  1         689  
13              
14             #You can also define is the genome should be consider as uniquely stranded or as double stranded
15             #with the C argument.
16              
17              
18             sub new {
19 3     3 1 1309 my $class = shift;
20              
21 3         7 my %args = @_;
22              
23             # the genome mask is not stranded by default
24             #my $is_stranded = defined $args{is_stranded}? $args{is_stranded} : 0;
25 3 50       8 my $verbose = defined $args{verbose}? $args{verbose} : 0;
26              
27 3         3 my %bit_vectors;
28              
29 3 100       19 if(defined $args{genome}) {
    100          
    50          
30              
31 1         2 foreach my $chr (keys %{$args{genome}}) {
  1         4  
32 2 50       5 if(!defined $bit_vectors{$chr}) {
33 2         8 $bit_vectors{$chr} = CracTools::BitVector->new($args{genome}->{$chr});
34             } else {
35 0         0 croak "Multiple definition of sequence $chr inf the genome lengths";
36             }
37             }
38             } elsif(defined $args{crac_index_conf}) {
39 1 50       4 print STDERR "Creating GenomeMask from crac index conf file : $args{crac_index_conf}\n" if $verbose;
40 1         5 my $conf_fh = CracTools::Utils::getReadingFileHandle($args{crac_index_conf});
41 1         11 my $nb_chr = <$conf_fh>;
42 1         2 my $nb_chr_found = 0;
43 1         3 while(<$conf_fh>) {
44 24         12 my $chr = $_;
45 24         19 chomp $chr;
46 24         18 my $chr_length = <$conf_fh>;
47 24         13 chomp $chr_length;
48 24 50       22 if(defined $chr_length) {
49 24 50       25 print STDERR "\tCreating bitvecor for chr $chr of length $chr_length\n" if $verbose;
50 24         35 $bit_vectors{$chr} = CracTools::BitVector->new($chr_length);
51 24         57 $nb_chr_found++;
52             } else {
53 0         0 croak "Missing genome length for chromosome $chr";
54             }
55             }
56 1 50       9 croak "There is less chromosome found ($nb_chr_found) in $args{crac_index_conf} than expected ($nb_chr)" if $nb_chr_found < $nb_chr;
57             } elsif(defined $args{sam_reader}) {
58 1         5 my $refseq_lengths = $args{sam_reader}->allRefSeqLengths();
59 1         2 foreach my $chr (keys %{$refseq_lengths}) {
  1         4  
60 24         36 $bit_vectors{$chr} = CracTools::BitVector->new($refseq_lengths->{$chr});
61             }
62             } else {
63 0         0 croak "There is no valid argument to extract the chromosomes names and length";
64             }
65              
66 3         13 my $self = bless {
67             bit_vectors => \%bit_vectors,
68             #is_stranded => $is_stranded,
69             }, $class;
70              
71 3         7 return $self;
72             }
73              
74             #=head2 isStranded
75             #
76             # Description : Return true is genomeMask is double stranded
77             #
78             #=cut
79             #
80             #sub isStranded {
81             # my $self = shift;
82             # return $self->{is_stranded};
83             #}
84              
85             #Arg [2] : Integer (1,-1) - strand
86              
87             sub getBitvector {
88 27     27 1 18 my $self = shift;
89 27         16 my $chr = shift;
90             #my $strand = shift;
91 27 50       42 if(defined $self->{bit_vectors}->{$chr}) {
92 27         44 return $self->{bit_vectors}->{$chr};
93             } else {
94 0         0 carp "There is no bitvector for sequence $chr in the genome mask";
95 0         0 return undef;
96             }
97             }
98              
99              
100             sub getChrLength {
101 3     3 1 41 my $self = shift;
102 3         4 my $chr = shift;
103 3         4 my $bv = $self->getBitvector($chr);
104 3 50       10 return defined $bv? $bv->length : undef;
105             }
106              
107              
108             sub setPos {
109 6     6 1 7 my ($self,$chr,$pos) = @_;
110 6         7 my $bv = $self->getBitvector($chr);
111 6 50       15 $bv->set($pos) if defined $bv;
112             }
113              
114              
115             sub setRegion {
116 1     1 1 3 my ($self,$chr,$start,$end) = @_;
117 1         4 for(my $i = $start; $i <= $end; $i++) {
118 4         5 $self->setPos($chr,$i);
119             }
120             }
121              
122            
123             sub getPos {
124 5     5 1 7 my ($self,$chr,$pos) = @_;
125 5         9 my $bv = $self->getBitvector($chr);
126 5 50       16 return $bv->get($pos) if defined $bv;
127             }
128              
129              
130             sub getPosSetInRegion {
131 2     2 1 3 my ($self,$chr,$start,$end) = @_;
132 2         3 my $bv = $self->getBitvector($chr);
133 2         2 my @pos;
134 2 50       4 if(defined $bv) {
135 2         6 for(my $i = $start; $i <= $end; $i++) {
136 13 100       19 push(@pos,$i) if $bv->get($i) == 1;
137             }
138             }
139 2         6 return \@pos;
140             }
141              
142              
143             sub getNbBitsSetInRegion {
144 1     1 1 2 my $self = shift;
145 1         1 return scalar @{$self->getPosSetInRegion(@_)};
  1         3  
146             }
147              
148              
149             sub rank {
150 2     2 1 957 my ($self,$chr,$pos) = @_;
151 2         3 my $cumulated_bits = 0;
152 2         2 my $i = 0;
153 2         2 my @chr_sorted = sort keys %{$self->{bit_vectors}};
  2         9  
154 2         7 while($chr_sorted[$i] ne $chr) {
155 2         7 $cumulated_bits += $self->getBitvector($chr_sorted[$i])->nb_set;
156 2         5 $i++;
157             }
158 2         3 return $cumulated_bits + $self->getBitvector($chr_sorted[$i])->rank($pos);
159             }
160              
161              
162             sub select {
163 1     1 1 2 my $self = shift;
164 1         1 my $i = shift;
165 1         1 my $cumulated_bits = 0;
166 1         1 my @chr_sorted = sort keys %{$self->{bit_vectors}};
  1         6  
167 1         1 my $j = 0;
168 1   66     6 while($j < @chr_sorted && $cumulated_bits + $self->getBitvector($chr_sorted[$j])->nb_set < $i) {
169 2         3 my $chr = $chr_sorted[$j];
170 2         2 my $bv = $self->getBitvector($chr);
171 2         3 $cumulated_bits += $self->getBitvector($chr)->nb_set;
172 2         6 $j++;
173             }
174 1         1 my $chr = $chr_sorted[$j-1];
175 1         2 my $pos = $self->getBitvector($chr_sorted[$j-1])->select($i - $cumulated_bits + 1);
176 1         3 return ($chr,$pos);
177             }
178              
179             1;
180              
181             __END__