File Coverage

lib/App/SimulateReads/Quality.pm
Criterion Covered Total %
statement 30 44 68.1
branch 3 4 75.0
condition n/a
subroutine 8 11 72.7
pod 0 2 0.0
total 41 61 67.2


line stmt bran cond sub pod time code
1             package App::SimulateReads::Quality;
2             # ABSTRACT: Class to simulate quality entries
3              
4 6     6   37 use App::SimulateReads::Base 'class';
  6         11  
  6         110  
5 6     6   2643 use App::SimulateReads::Quality::Handle;
  6         32784  
  6         3902  
6              
7             our $VERSION = '0.06'; # VERSION
8              
9             #-------------------------------------------------------------------------------
10             # Moose attributes
11             #-------------------------------------------------------------------------------
12             has 'quality_profile' => (is => 'ro', isa => 'My:QualityP', required => 1, coerce => 1);
13             has 'read_size' => (is => 'ro', isa => 'My:IntGt0', required => 1);
14             has '_quality_by_system' => (
15             is => 'ro',
16             isa => 'My:QualityH',
17             builder => '_build_quality_by_system',
18             lazy_build => 1
19             );
20             has '_gen_quality' => (
21             is => 'ro',
22             isa => 'CodeRef',
23             builder => '_build_gen_quality',
24             lazy_build => 1
25             );
26              
27             sub BUILD {
28 70     70 0 130 my $self = shift;
29             ## Just to ensure that the lazy attributes are built before &new returns
30 70 50       1810 $self->_quality_by_system if $self->quality_profile ne 'poisson';
31             }
32              
33             #-------------------------------------------------------------------------------
34             # Phred score table for poisson distribution simulation
35             #-------------------------------------------------------------------------------
36             my @PHRED_SCORE = (
37             {
38             score => ['I', 'H', 'G', 'F', 'E', 'D', 'C', 'B', 'A', '@', '?'],
39             size => 11,
40             ratio => 1.5
41             },
42             {
43             score => ['>', '=', '<', ';', ':', '9', '8', '7', '6', '5'],
44             size => 10,
45             ratio => 2
46             },
47             {
48             score => ['4', '3', '2', '1', '0', '/', '.', '-', ',', '+'],
49             size => 10,
50             ratio => 2
51             },
52             {
53             score => ['*', ')', '(', '\'', '&', '%', '$', '#', '"', '!'],
54             size => 10,
55             ratio => 1
56             }
57             );
58              
59             #=== CLASS METHOD ============================================================
60             # CLASS: Quality
61             # METHOD: _build_gen_quality (BUILDER)
62             # PARAMETERS: Void
63             # RETURNS: $fun CodeRef
64             # DESCRIPTION: Dynamic linkage for quality profile generator
65             # THROWS: no exceptions
66             # COMMENTS: none
67             # SEE ALSO: n/a
68             #===============================================================================
69             sub _build_gen_quality {
70 34     34   77 my $self = shift;
71 34         54 my $fun;
72              
73 34         1009 given ($self->quality_profile) {
74 34         137 when ('poisson') {
75 34     2375   269 $fun = sub { $self->_gen_quality_by_poisson_dist };
  2375         5288  
76             }
77 0         0 default {
78 0     0   0 $fun = sub { $self->_gen_quality_by_system };
  0         0  
79             }
80             }
81              
82 34         909 return $fun;
83             } ## --- end sub _build_gen_quality
84              
85             #=== CLASS METHOD ============================================================
86             # CLASS: Quality
87             # METHOD: _build_quality_by_system (BUILDER)
88             # PARAMETERS: Void
89             # RETURNS: $quality_by_system My:QualityH
90             # DESCRIPTION: Searches into the paths for quality_profile.perldata where is
91             # found the quality distribution for a given system
92             # THROWS: If quality_profile not found, or a given system is not stored
93             # in the database, throws an exception
94             # COMMENTS: none
95             # SEE ALSO: n/a
96             #===============================================================================
97             sub _build_quality_by_system {
98 0     0   0 my $self = shift;
99 0         0 my $db = App::SimulateReads::Quality::Handle->new;
100 0         0 my ($matrix, $deepth) = $db->retrievedb($self->quality_profile, $self->read_size);
101 0         0 return { matrix => $matrix, deepth => $deepth };
102             } ## --- end sub _build_quality_by_system
103              
104             sub gen_quality {
105 2375     2375 0 44376 my $self = shift;
106 2375         59941 my $gen_quality = $self->_gen_quality;
107 2375         4029 return $gen_quality->();
108             } ## --- end sub gen_quality
109              
110             #=== CLASS METHOD ============================================================
111             # CLASS: Quality
112             # METHOD: _gen_quality_by_system (PRIVATE)
113             # PARAMETERS: Void
114             # RETURNS: \$quality Ref Str
115             # DESCRIPTION: Calcultes a quality string by raffle inside a quality matrix -
116             # where each position is a vector encoding a distribution. So
117             # if the string length is 100 bases, it needs to raffle 100 times.
118             # The more present is a given quality, the more chance to be raffled
119             # it will be
120             # THROWS: no exceptions
121             # COMMENTS: none
122             # SEE ALSO: n/a
123             #===============================================================================
124             sub _gen_quality_by_system {
125 0     0   0 my $self = shift;
126              
127 0         0 my $quality_matrix = $self->_quality_by_system->{matrix};
128 0         0 my $quality_deepth = $self->_quality_by_system->{deepth};
129 0         0 my $quality;
130              
131 0         0 for (my $i = 0; $i < $self->read_size; $i++) {
132 0         0 $quality .= $quality_matrix->[$i][int(rand($quality_deepth))];
133             }
134              
135 0         0 return \$quality;
136             } ## --- end sub _gen_quality_by_system
137              
138             #=== CLASS METHOD ============================================================
139             # CLASS: Quality
140             # METHOD: _gen_quality_by_poisson_dist
141             # PARAMETERS: Void
142             # RETURNS: \$quality Ref Str
143             # DESCRIPTION: Calculates quality based in a cumulative poisson distribution
144             # THROWS: no exceptions
145             # COMMENTS: It uses the @PHRED_SCORE table to simulate a proportion score
146             # similar to the poisson distribution
147             # SEE ALSO: _poisson_dist
148             #===============================================================================
149             sub _gen_quality_by_poisson_dist {
150 2375     2375   3031 my $self = shift;
151 2375         2849 my $quality;
152 2375         57344 return $self->_poisson_dist(\$quality, $self->read_size, scalar @PHRED_SCORE);
153             } ## --- end sub _gen_quality_by_poisson_dist
154              
155             #=== CLASS METHOD ============================================================
156             # CLASS: Quality
157             # METHOD: _poisson_dist
158             # PARAMETERS: $quality_ref Str Ref, $size Int > 0, $countdown Int >= 0
159             # RETURNS: $quality_ref Str Ref
160             # DESCRIPTION: Recursive routine that generates a quality string based in a
161             # uniform random raffle into @PHRED_SCORE partitions. It works as
162             # a poisson CDF
163             # THROWS: no exceptions
164             # COMMENTS: none
165             # SEE ALSO: _gen_quality_by_poisson_dist
166             #===============================================================================
167             sub _poisson_dist {
168 11875     11875   17194 my ($self, $quality_ref, $size, $countdown) = @_;
169 11875 100       24059 return $quality_ref if not $countdown;
170              
171 9500         14431 my $ratio = $PHRED_SCORE[4 - $countdown]{ratio};
172 9500         15215 my $part = int($size / $ratio) + ($size % $ratio);
173 9500         12591 my $score = $PHRED_SCORE[4 - $countdown]{score};
174 9500         11995 my $score_size = $PHRED_SCORE[4 - $countdown]{size};
175              
176 9500         15445 for (my $i = 0; $i < $part; $i++) {
177 23750         46133 $$quality_ref .= $score->[int(rand($score_size))];
178             }
179              
180 9500         17286 return $self->_poisson_dist($quality_ref, $size - $part, $countdown - 1);
181             } ## --- end sub _poisson_dist
182              
183             __END__
184              
185             =pod
186              
187             =encoding UTF-8
188              
189             =head1 NAME
190              
191             App::SimulateReads::Quality - Class to simulate quality entries
192              
193             =head1 VERSION
194              
195             version 0.06
196              
197             =head1 AUTHOR
198              
199             Thiago L. A. Miller <tmiller@mochsl.org.br>
200              
201             =head1 COPYRIGHT AND LICENSE
202              
203             This software is Copyright (c) 2017 by Teaching and Research Institute from Sírio-Libanês Hospital.
204              
205             This is free software, licensed under:
206              
207             The GNU General Public License, Version 3, June 2007
208              
209             =cut