]> git.donarmstrong.com Git - biopieces.git/blob - code_perl/Maasha/Fastq.pm
changed read_solexa
[biopieces.git] / code_perl / Maasha / Fastq.pm
1 package Maasha::Fastq;
2
3 # Copyright (C) 2006-2009 Martin A. Hansen.
4
5 # This program is free software; you can redistribute it and/or
6 # modify it under the terms of the GNU General Public License
7 # as published by the Free Software Foundation; either version 2
8 # of the License, or (at your option) any later version.
9
10 # This program is distributed in the hope that it will be useful,
11 # but WITHOUT ANY WARRANTY; without even the implied warranty of
12 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
13 # GNU General Public License for more details.
14
15 # You should have received a copy of the GNU General Public License
16 # along with this program; if not, write to the Free Software
17 # Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
18
19 # http://www.gnu.org/copyleft/gpl.html
20
21
22 # >>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> DESCRIPTION <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
23
24
25 # Routines for manipulation of FASTQ files and FASTQ entries.
26
27 # http://maq.sourceforge.net/fastq.shtml
28
29
30 # >>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>><<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
31
32
33 use warnings;
34 use strict;
35 use Data::Dumper;
36 use Maasha::Calc;
37 use vars qw( @ISA @EXPORT );
38
39 use constant {
40     SEQ_NAME => 0,
41     SEQ      => 1,
42     SCORES   => 2,
43 };
44
45 @ISA = qw( Exporter );
46
47 use Inline ( C => <<'END_C', DIRECTORY => $ENV{ "BP_TMP" } );
48
49 int phred2score( char c )
50 {
51     /* Martin A. Hansen, July 2009 */
52
53     /* Converts a FASTQ/phred score in octal (a char) to a decimal score, */
54     /* which is returned. */
55
56     /* http://maq.sourceforge.net/fastq.shtml */
57
58     int score = 0;
59
60     score = ( int ) c - 33;
61
62     return score;
63 }
64
65
66 int solexa2score( char c )
67 {
68     /* Martin A. Hansen, July 2009 */
69
70     /* Converts a Solexa score in octal (a char) to a decimal score, */
71     /* which is returned. */
72
73     /* http://maq.sourceforge.net/fastq.shtml */
74     /* $Q = 10 * log(1 + 10 ** (ord($sq) - 64) / 10.0)) / log(10); */
75
76     int score = 0;
77     int ascii = ( int ) c - 64;
78
79     score = 10 * log( 1 + pow( 10, ascii / 10 ) ) / log( 10 );
80
81     return score;
82 }
83
84
85 char score2phred( int score )
86 {
87     /* Martin A. Hansen, July 2009 */
88
89     /* Converts a decimal score in decimal to an octal score (a char), */
90     /* which is returned. */
91
92     /* http://maq.sourceforge.net/fastq.shtml */
93
94     char c;
95
96     if ( score <= 93 ) {
97         c = ( char ) score + 33;
98     } else {
99         c = ( char ) 93 + 33;
100     }
101
102 //    printf( "score: %d   char: %c\n", score, c );
103
104     return c;
105 }
106
107
108 void lowercase_low_scores( char *seq, char *scores, int threshold )
109 {
110     /* Martin A. Hansen, July 2009 */
111
112     /* Given a sequence string and a score string (in FASTQ/Phread range) */
113     /* lowercases all residues where the decimal score is below a given threshold. */
114
115     int i = 0;
116
117     for ( i = 0; i < strlen( seq ); i++ )
118     {
119         if ( phred2score( scores[ i ] ) < threshold ) {
120             seq[ i ] = tolower( seq[ i ] );
121         }
122     }
123 }
124
125
126 void solexa2phred( char *scores )
127 {
128     /* Martin A. Hansen, July 2009 */
129
130     /* Convert Solexa scores to Phred scores for use with FASTQ format.*/
131
132     int  i     = 0;
133     int  score = 0;
134     char c;
135
136     for ( i = 0; i < strlen( scores ); i++ )
137     {
138         score       = solexa2score( scores[ i ] );
139         c           = score2phred( score );
140
141 //        printf( "scores[i]: %c  score: %d  char: %c\n", scores[ i ], score, c );
142
143         scores[ i ] = c;
144     }
145 }
146
147
148 END_C
149
150
151 # >>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>><<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
152
153
154 sub get_entry
155 {
156     # Martin A. Hansen, July 2009.
157
158     # Gets the next FASTQ entry from a given filehandle.
159
160     my ( $fh,   # filehandle
161        ) = @_;
162
163     # Returns a list
164
165     my ( $seq, $seq_name, $qual, $qual_name );
166
167     $seq_name  = <$fh>;
168     $seq       = <$fh>;
169     $qual_name = <$fh>;
170     $qual      = <$fh>;
171
172     return unless $seq;
173
174     chomp $seq;
175     chomp $seq_name;
176     chomp $qual;
177     chomp $qual_name;
178
179     $seq_name =~ s/^@//;
180
181     return wantarray ? ( $seq_name, $seq, $qual ) : [ $seq_name, $seq, $qual ];
182 }
183
184
185 sub put_entry
186 {
187     # Martin A. Hansen, July 2009.
188
189     # Output a FASTQ entry to STDOUT or a filehandle.
190
191     my ( $entry,   # FASTQ entry
192          $fh,      # filehandle - OPTIONAL
193        ) = @_;
194
195     # Returns nothing.
196
197     $fh ||= \*STDOUT;
198
199     print $fh "@" . $entry->[ SEQ_NAME ] . "\n";
200     print $fh $entry->[ SEQ ] . "\n";
201     print $fh "+\n";
202     print $fh $entry->[ SCORES ] . "\n";
203 }
204
205
206 sub fastq2biopiece
207 {
208     # Martin A. Hansen, July 2009.
209     
210     # Converts a FASTQ entry to a Biopiece record, where
211     # the FASTQ quality scores are converted to numerics.
212
213     my ( $entry,     # FASTQ entry,
214        ) = @_;
215
216     # Returns a hash.
217
218     my ( $record );
219
220     $record->{ 'SEQ' }        = $entry->[ SEQ ];
221     $record->{ 'SEQ_NAME' }   = $entry->[ SEQ_NAME ];
222     $record->{ 'SCORES' }     = $entry->[ SCORES ];
223
224     return wantarray ? %{ $record } : $record;
225 }
226
227
228 sub biopiece2fastq
229 {
230     # Martin A. Hansen, July 2009.
231     
232     # Converts a Biopiece record to a FASTQ entry.
233
234     my ( $record,   # Biopiece record
235        ) = @_;
236
237     # Returns a list.
238
239     my ( $list );
240
241     if ( exists $record->{ 'SEQ' } and exists $record->{ 'SEQ_NAME' } and exists $record->{ 'SCORES' } )
242     {
243         $list->[ SEQ_NAME ] = $record->{ 'SEQ_NAME' };
244         $list->[ SEQ ]      = $record->{ 'SEQ' };
245         $list->[ SCORES ]   = $record->{ 'SCORES' };
246     
247         $list->[ SCORES ] =~ s/(\d+);/chr( ( $1 <= 93 ? $1 : 93 ) + 33 )/ge;
248
249         return wantarray ? @{ $list } : $list;
250     }
251
252     return;
253 }
254
255
256 # >>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>><<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<