line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
# |
2
|
|
|
|
|
|
|
# BioPerl module for Bio::SearchIO::Writer::TextResultWriter |
3
|
|
|
|
|
|
|
# |
4
|
|
|
|
|
|
|
# Please direct questions and support issues to |
5
|
|
|
|
|
|
|
# |
6
|
|
|
|
|
|
|
# Cared for by Jason Stajich |
7
|
|
|
|
|
|
|
# |
8
|
|
|
|
|
|
|
# Copyright Jason Stajich |
9
|
|
|
|
|
|
|
# |
10
|
|
|
|
|
|
|
# You may distribute this module under the same terms as perl itself |
11
|
|
|
|
|
|
|
|
12
|
|
|
|
|
|
|
# POD documentation - main docs before the code |
13
|
|
|
|
|
|
|
|
14
|
|
|
|
|
|
|
=head1 NAME |
15
|
|
|
|
|
|
|
|
16
|
|
|
|
|
|
|
Bio::SearchIO::Writer::TextResultWriter - Object to implement writing |
17
|
|
|
|
|
|
|
a Bio::Search::ResultI in Text. |
18
|
|
|
|
|
|
|
|
19
|
|
|
|
|
|
|
=head1 SYNOPSIS |
20
|
|
|
|
|
|
|
|
21
|
|
|
|
|
|
|
use Bio::SearchIO; |
22
|
|
|
|
|
|
|
use Bio::SearchIO::Writer::TextResultWriter; |
23
|
|
|
|
|
|
|
|
24
|
|
|
|
|
|
|
my $in = Bio::SearchIO->new(-format => 'blast', |
25
|
|
|
|
|
|
|
-file => shift @ARGV); |
26
|
|
|
|
|
|
|
|
27
|
|
|
|
|
|
|
my $writer = Bio::SearchIO::Writer::TextResultWriter->new(); |
28
|
|
|
|
|
|
|
my $out = Bio::SearchIO->new(-writer => $writer); |
29
|
|
|
|
|
|
|
$out->write_result($in->next_result); |
30
|
|
|
|
|
|
|
|
31
|
|
|
|
|
|
|
=head1 DESCRIPTION |
32
|
|
|
|
|
|
|
|
33
|
|
|
|
|
|
|
This object implements the SearchWriterI interface which will produce |
34
|
|
|
|
|
|
|
a set of Text for a specific Bio::Search::Report::ReportI interface. |
35
|
|
|
|
|
|
|
|
36
|
|
|
|
|
|
|
You can also provide the argument -filters =E \%hash to filter the at |
37
|
|
|
|
|
|
|
the hsp, hit, or result level. %hash is an associative array which |
38
|
|
|
|
|
|
|
contains any or all of the keys (HSP, HIT, RESULT). The values |
39
|
|
|
|
|
|
|
pointed to by these keys would be references to a subroutine which |
40
|
|
|
|
|
|
|
expects to be passed an object - one of Bio::Search::HSP::HSPI, |
41
|
|
|
|
|
|
|
Bio::Search::Hit::HitI, and Bio::Search::Result::ResultI respectively. |
42
|
|
|
|
|
|
|
Each function needs to return a boolean value as to whether or not the |
43
|
|
|
|
|
|
|
passed element should be included in the output report - true if it is |
44
|
|
|
|
|
|
|
to be included, false if it to be omitted. |
45
|
|
|
|
|
|
|
|
46
|
|
|
|
|
|
|
For example to filter on sequences in the database which are too short |
47
|
|
|
|
|
|
|
for your criteria you would do the following. |
48
|
|
|
|
|
|
|
|
49
|
|
|
|
|
|
|
Define a hit filter method |
50
|
|
|
|
|
|
|
|
51
|
|
|
|
|
|
|
sub hit_filter { |
52
|
|
|
|
|
|
|
my $hit = shift; |
53
|
|
|
|
|
|
|
return $hit->length E 100; # test if length of the hit sequence |
54
|
|
|
|
|
|
|
# long enough |
55
|
|
|
|
|
|
|
} |
56
|
|
|
|
|
|
|
my $writer = Bio::SearchIO::Writer::TextResultWriter->new( |
57
|
|
|
|
|
|
|
-filters => { 'HIT' =E \&hit_filter } |
58
|
|
|
|
|
|
|
); |
59
|
|
|
|
|
|
|
|
60
|
|
|
|
|
|
|
Another example would be to filter HSPs on percent identity, let's |
61
|
|
|
|
|
|
|
only include HSPs which are 75% identical or better. |
62
|
|
|
|
|
|
|
|
63
|
|
|
|
|
|
|
sub hsp_filter { |
64
|
|
|
|
|
|
|
my $hsp = shift; |
65
|
|
|
|
|
|
|
return $hsp->percent_identity E 75; |
66
|
|
|
|
|
|
|
} |
67
|
|
|
|
|
|
|
my $writer = Bio::SearchIO::Writer::TextResultWriter->new( |
68
|
|
|
|
|
|
|
-filters => { 'HSP' =E \&hsp_filter } |
69
|
|
|
|
|
|
|
); |
70
|
|
|
|
|
|
|
|
71
|
|
|
|
|
|
|
See L for more info on the filter method. |
72
|
|
|
|
|
|
|
|
73
|
|
|
|
|
|
|
|
74
|
|
|
|
|
|
|
This module will use the module Text::Wrap if it is installed to wrap |
75
|
|
|
|
|
|
|
the Query description line. If you do not have Text::Wrap installed |
76
|
|
|
|
|
|
|
this module will work fine but you won't have the Query line wrapped. |
77
|
|
|
|
|
|
|
You will see a warning about this when you first instantiate a |
78
|
|
|
|
|
|
|
TextResultWriter - to avoid these warnings from showing up, simply set |
79
|
|
|
|
|
|
|
the verbosity upon initialization to -1 like this: my $writer = new |
80
|
|
|
|
|
|
|
Bio::SearchIO::Writer::TextResultWriter(-verbose =E -1); |
81
|
|
|
|
|
|
|
|
82
|
|
|
|
|
|
|
=head1 FEEDBACK |
83
|
|
|
|
|
|
|
|
84
|
|
|
|
|
|
|
=head2 Mailing Lists |
85
|
|
|
|
|
|
|
|
86
|
|
|
|
|
|
|
User feedback is an integral part of the evolution of this and other |
87
|
|
|
|
|
|
|
Bioperl modules. Send your comments and suggestions preferably to |
88
|
|
|
|
|
|
|
the Bioperl mailing list. Your participation is much appreciated. |
89
|
|
|
|
|
|
|
|
90
|
|
|
|
|
|
|
bioperl-l@bioperl.org - General discussion |
91
|
|
|
|
|
|
|
http://bioperl.org/wiki/Mailing_lists - About the mailing lists |
92
|
|
|
|
|
|
|
|
93
|
|
|
|
|
|
|
=head2 Support |
94
|
|
|
|
|
|
|
|
95
|
|
|
|
|
|
|
Please direct usage questions or support issues to the mailing list: |
96
|
|
|
|
|
|
|
|
97
|
|
|
|
|
|
|
I |
98
|
|
|
|
|
|
|
|
99
|
|
|
|
|
|
|
rather than to the module maintainer directly. Many experienced and |
100
|
|
|
|
|
|
|
reponsive experts will be able look at the problem and quickly |
101
|
|
|
|
|
|
|
address it. Please include a thorough description of the problem |
102
|
|
|
|
|
|
|
with code and data examples if at all possible. |
103
|
|
|
|
|
|
|
|
104
|
|
|
|
|
|
|
=head2 Reporting Bugs |
105
|
|
|
|
|
|
|
|
106
|
|
|
|
|
|
|
Report bugs to the Bioperl bug tracking system to help us keep track |
107
|
|
|
|
|
|
|
of the bugs and their resolution. Bug reports can be submitted via the |
108
|
|
|
|
|
|
|
web: |
109
|
|
|
|
|
|
|
|
110
|
|
|
|
|
|
|
https://github.com/bioperl/bioperl-live/issues |
111
|
|
|
|
|
|
|
|
112
|
|
|
|
|
|
|
=head1 AUTHOR - Jason Stajich |
113
|
|
|
|
|
|
|
|
114
|
|
|
|
|
|
|
Email jason@bioperl.org |
115
|
|
|
|
|
|
|
|
116
|
|
|
|
|
|
|
=head1 APPENDIX |
117
|
|
|
|
|
|
|
|
118
|
|
|
|
|
|
|
The rest of the documentation details each of the object methods. |
119
|
|
|
|
|
|
|
Internal methods are usually preceded with a _ |
120
|
|
|
|
|
|
|
|
121
|
|
|
|
|
|
|
=cut |
122
|
|
|
|
|
|
|
|
123
|
|
|
|
|
|
|
|
124
|
|
|
|
|
|
|
# Let the code begin... |
125
|
|
|
|
|
|
|
|
126
|
|
|
|
|
|
|
|
127
|
|
|
|
|
|
|
package Bio::SearchIO::Writer::TextResultWriter; |
128
|
1
|
|
|
1
|
|
801
|
use vars qw($MaxNameLen $MaxDescLen $AlignmentLineWidth $DescLineLen $TextWrapLoaded); |
|
1
|
|
|
|
|
1
|
|
|
1
|
|
|
|
|
54
|
|
129
|
1
|
|
|
1
|
|
4
|
use strict; |
|
1
|
|
|
|
|
1
|
|
|
1
|
|
|
|
|
43
|
|
130
|
|
|
|
|
|
|
|
131
|
|
|
|
|
|
|
# Object preamble - inherits from Bio::Root::RootI |
132
|
|
|
|
|
|
|
|
133
|
|
|
|
|
|
|
BEGIN { |
134
|
1
|
|
|
1
|
|
1
|
$MaxDescLen = 65; |
135
|
1
|
|
|
|
|
1
|
$AlignmentLineWidth = 60; |
136
|
1
|
|
|
|
|
1
|
eval { require Text::Wrap; $TextWrapLoaded = 1;}; |
|
1
|
|
|
|
|
361
|
|
|
1
|
|
|
|
|
1826
|
|
137
|
1
|
50
|
|
|
|
17
|
if( $@ ) { |
138
|
0
|
|
|
|
|
0
|
$TextWrapLoaded = 0; |
139
|
|
|
|
|
|
|
} |
140
|
|
|
|
|
|
|
} |
141
|
|
|
|
|
|
|
|
142
|
1
|
|
|
1
|
|
491
|
use POSIX; |
|
1
|
|
|
|
|
4191
|
|
|
1
|
|
|
|
|
4
|
|
143
|
|
|
|
|
|
|
|
144
|
1
|
|
|
1
|
|
1908
|
use base qw(Bio::Root::Root Bio::SearchIO::SearchWriterI); |
|
1
|
|
|
|
|
1
|
|
|
1
|
|
|
|
|
289
|
|
145
|
|
|
|
|
|
|
|
146
|
|
|
|
|
|
|
=head2 new |
147
|
|
|
|
|
|
|
|
148
|
|
|
|
|
|
|
Title : new |
149
|
|
|
|
|
|
|
Usage : my $obj = Bio::SearchIO::Writer::TextResultWriter->new(); |
150
|
|
|
|
|
|
|
Function: Builds a new Bio::SearchIO::Writer::TextResultWriter object |
151
|
|
|
|
|
|
|
Returns : Bio::SearchIO::Writer::TextResultWriter |
152
|
|
|
|
|
|
|
Args : -filters => hashref with any or all of the keys (HSP HIT RESULT) |
153
|
|
|
|
|
|
|
which have values pointing to a subroutine reference |
154
|
|
|
|
|
|
|
which will expect to get a Hit,HSP, Result object respectively |
155
|
|
|
|
|
|
|
-no_wublastlinks => boolean. Do not display WU-BLAST lines even if |
156
|
|
|
|
|
|
|
they are parsed out |
157
|
|
|
|
|
|
|
Links = (1) |
158
|
|
|
|
|
|
|
|
159
|
|
|
|
|
|
|
=cut |
160
|
|
|
|
|
|
|
|
161
|
|
|
|
|
|
|
sub new { |
162
|
1
|
|
|
1
|
1
|
13
|
my($class,@args) = @_; |
163
|
|
|
|
|
|
|
|
164
|
1
|
|
|
|
|
7
|
my $self = $class->SUPER::new(@args); |
165
|
1
|
|
|
|
|
6
|
my ($filters,$nowublastlinks) = $self->_rearrange([qw(FILTERS |
166
|
|
|
|
|
|
|
NO_WUBLASTLINKS)], |
167
|
|
|
|
|
|
|
@args); |
168
|
1
|
50
|
|
|
|
4
|
if( defined $filters ) { |
169
|
0
|
0
|
|
|
|
0
|
if( !ref($filters) =~ /HASH/i ) { |
170
|
0
|
|
|
|
|
0
|
$self->warn("Did not provide a hashref for the FILTERS option, ignoring."); |
171
|
|
|
|
|
|
|
} else { |
172
|
0
|
|
|
|
|
0
|
while( my ($type,$code) = each %{$filters} ) { |
|
0
|
|
|
|
|
0
|
|
173
|
0
|
|
|
|
|
0
|
$self->filter($type,$code); |
174
|
|
|
|
|
|
|
} |
175
|
|
|
|
|
|
|
} |
176
|
|
|
|
|
|
|
} |
177
|
1
|
|
|
|
|
4
|
$self->no_wublastlinks(! $nowublastlinks); |
178
|
1
|
50
|
|
|
|
3
|
unless( $TextWrapLoaded ) { |
179
|
0
|
|
|
|
|
0
|
$self->warn("Could not load Text::Wrap - the Query Description will not be line wrapped\n"); |
180
|
|
|
|
|
|
|
} else { |
181
|
1
|
|
|
|
|
1
|
$Text::Wrap::columns = $MaxDescLen; |
182
|
|
|
|
|
|
|
} |
183
|
1
|
|
|
|
|
2
|
return $self; |
184
|
|
|
|
|
|
|
} |
185
|
|
|
|
|
|
|
|
186
|
|
|
|
|
|
|
|
187
|
|
|
|
|
|
|
=head2 to_string |
188
|
|
|
|
|
|
|
|
189
|
|
|
|
|
|
|
Purpose : Produces data for each Search::Result::ResultI in a string. |
190
|
|
|
|
|
|
|
: This is an abstract method. For some useful implementations, |
191
|
|
|
|
|
|
|
: see ResultTableWriter.pm, HitTableWriter.pm, |
192
|
|
|
|
|
|
|
: and HSPTableWriter.pm. |
193
|
|
|
|
|
|
|
Usage : print $writer->to_string( $result_obj, @args ); |
194
|
|
|
|
|
|
|
Argument : $result_obj = A Bio::Search::Result::ResultI object |
195
|
|
|
|
|
|
|
: @args = any additional arguments used by your implementation. |
196
|
|
|
|
|
|
|
Returns : String containing data for each search Result or any of its |
197
|
|
|
|
|
|
|
: sub-objects (Hits and HSPs). |
198
|
|
|
|
|
|
|
Throws : n/a |
199
|
|
|
|
|
|
|
|
200
|
|
|
|
|
|
|
=cut |
201
|
|
|
|
|
|
|
|
202
|
|
|
|
|
|
|
sub to_string { |
203
|
1
|
|
|
1
|
1
|
2
|
my ($self,$result,$num) = @_; |
204
|
1
|
|
50
|
|
|
2
|
$num ||= 0; |
205
|
1
|
50
|
|
|
|
3
|
return unless defined $result; |
206
|
1
|
|
|
|
|
2
|
my $links = $self->no_wublastlinks; |
207
|
1
|
|
|
|
|
7
|
my ($resultfilter,$hitfilter, $hspfilter) = ( $self->filter('RESULT'), |
208
|
|
|
|
|
|
|
$self->filter('HIT'), |
209
|
|
|
|
|
|
|
$self->filter('HSP') ); |
210
|
1
|
50
|
33
|
|
|
4
|
return '' if( defined $resultfilter && ! &{$resultfilter}($result) ); |
|
0
|
|
|
|
|
0
|
|
211
|
|
|
|
|
|
|
|
212
|
1
|
|
|
|
|
1
|
my ($qtype,$dbtype,$dbseqtype,$type); |
213
|
1
|
|
|
|
|
7
|
my $alg = $result->algorithm; |
214
|
|
|
|
|
|
|
|
215
|
1
|
50
|
|
|
|
3
|
my $wublast = ($result->algorithm_version =~ /WashU/) ? 1 : 0; |
216
|
|
|
|
|
|
|
|
217
|
|
|
|
|
|
|
# This is actually wrong for the FASTAs I think |
218
|
1
|
50
|
0
|
|
|
7
|
if( $alg =~ /T(FAST|BLAST)([XY])/i ) { |
|
|
0
|
0
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
219
|
1
|
|
|
|
|
1
|
$qtype = $dbtype = 'translated'; |
220
|
1
|
|
|
|
|
2
|
$dbseqtype = $type = 'PROTEIN'; |
221
|
|
|
|
|
|
|
} elsif( $alg =~ /T(FAST|BLAST)N/i ) { |
222
|
0
|
|
|
|
|
0
|
$qtype = ''; |
223
|
0
|
|
|
|
|
0
|
$dbtype = 'translated'; |
224
|
0
|
|
|
|
|
0
|
$type = 'PROTEIN'; |
225
|
0
|
|
|
|
|
0
|
$dbseqtype = 'NUCLEOTIDE'; |
226
|
|
|
|
|
|
|
} elsif( $alg =~ /(FAST|BLAST)N/i || |
227
|
|
|
|
|
|
|
$alg =~ /(WABA|EXONERATE)/i ) { |
228
|
0
|
|
|
|
|
0
|
$qtype = $dbtype = ''; |
229
|
0
|
|
|
|
|
0
|
$type = $dbseqtype = 'NUCLEOTIDE'; |
230
|
|
|
|
|
|
|
} elsif( $alg =~ /(FAST|BLAST)P/ || |
231
|
|
|
|
|
|
|
$alg =~ /SSEARCH|(HMM|SEARCH|PFAM)/i ) { |
232
|
0
|
|
|
|
|
0
|
$qtype = $dbtype = ''; |
233
|
0
|
|
|
|
|
0
|
$type = $dbseqtype = 'PROTEIN'; |
234
|
|
|
|
|
|
|
} elsif( $alg =~ /(FAST|BLAST)[XY]/i ) { |
235
|
0
|
|
|
|
|
0
|
$qtype = 'translated'; |
236
|
0
|
|
|
|
|
0
|
$dbtype = 'PROTEIN'; |
237
|
0
|
|
|
|
|
0
|
$dbseqtype = $type = 'PROTEIN'; |
238
|
|
|
|
|
|
|
} else { |
239
|
0
|
|
|
|
|
0
|
print STDERR "algorithm was ", $result->algorithm, " couldn't match\n"; |
240
|
|
|
|
|
|
|
} |
241
|
|
|
|
|
|
|
|
242
|
|
|
|
|
|
|
|
243
|
1
|
50
|
|
|
|
6
|
my %baselens = ( 'Sbjct:' => ( $dbtype eq 'translated' ) ? 3 : 1, |
|
|
50
|
|
|
|
|
|
244
|
|
|
|
|
|
|
'Query:' => ( $qtype eq 'translated' ) ? 3 : 1); |
245
|
|
|
|
|
|
|
|
246
|
1
|
|
|
|
|
1
|
my $str; |
247
|
1
|
50
|
33
|
|
|
5
|
if( ! defined $num || $num <= 1 ) { |
248
|
1
|
|
|
|
|
1
|
$str = &{$self->start_report}($result); |
|
1
|
|
|
|
|
3
|
|
249
|
|
|
|
|
|
|
} |
250
|
|
|
|
|
|
|
|
251
|
1
|
|
|
|
|
1
|
$str .= &{$self->title}($result); |
|
1
|
|
|
|
|
3
|
|
252
|
1
|
|
|
|
|
3
|
$str .= $result->algorithm . " " . $result->algorithm_version . "\n\n\n"; |
253
|
1
|
|
33
|
|
|
3
|
$str .= $result->algorithm_reference || $self->algorithm_reference($result); |
254
|
1
|
|
|
|
|
4
|
$str .= &{$self->introduction}($result); |
|
1
|
|
|
|
|
3
|
|
255
|
|
|
|
|
|
|
|
256
|
|
|
|
|
|
|
|
257
|
1
|
|
|
|
|
3
|
$str .= qq{ |
258
|
|
|
|
|
|
|
Score E |
259
|
|
|
|
|
|
|
Sequences producing significant alignments: (bits) value |
260
|
|
|
|
|
|
|
}; |
261
|
1
|
|
|
|
|
1
|
my $hspstr = ''; |
262
|
1
|
50
|
|
|
|
12
|
if( $result->can('rewind')) { |
263
|
1
|
|
|
|
|
3
|
$result->rewind(); # support stream based parsing routines |
264
|
|
|
|
|
|
|
} |
265
|
1
|
|
|
|
|
3
|
while( my $hit = $result->next_hit ) { |
266
|
20
|
50
|
33
|
|
|
38
|
next if( defined $hitfilter && ! &{$hitfilter}($hit) ); |
|
0
|
|
|
|
|
0
|
|
267
|
20
|
|
|
|
|
39
|
my $nm = $hit->name(); |
268
|
20
|
50
|
|
|
|
37
|
$self->debug( "no $nm for name (".$hit->description(). "\n") |
269
|
|
|
|
|
|
|
unless $nm; |
270
|
20
|
|
|
|
|
18
|
my ($gi,$acc) = &{$self->id_parser}($nm); |
|
20
|
|
|
|
|
32
|
|
271
|
20
|
|
|
|
|
31
|
my $p = "%-$MaxDescLen". "s"; |
272
|
20
|
|
|
|
|
14
|
my $descsub; |
273
|
20
|
|
|
|
|
38
|
my $desc = sprintf("%s %s",$nm,$hit->description); |
274
|
20
|
50
|
|
|
|
30
|
if( length($desc) - 3 > $MaxDescLen) { |
275
|
20
|
|
|
|
|
36
|
$descsub = sprintf($p, |
276
|
|
|
|
|
|
|
substr($desc,0,$MaxDescLen-3) . |
277
|
|
|
|
|
|
|
"..."); |
278
|
|
|
|
|
|
|
} else { |
279
|
0
|
|
|
|
|
0
|
$descsub = sprintf($p,$desc); |
280
|
|
|
|
|
|
|
} |
281
|
20
|
0
|
|
|
|
50
|
$str .= $wublast ? sprintf("%s %-4s %s\n", |
|
|
0
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
282
|
|
|
|
|
|
|
$descsub, |
283
|
|
|
|
|
|
|
defined $hit->raw_score ? $hit->raw_score : ' ', |
284
|
|
|
|
|
|
|
defined $hit->significance ? $hit->significance : '?') : |
285
|
|
|
|
|
|
|
sprintf("%s %-4s %s\n", |
286
|
|
|
|
|
|
|
$descsub, |
287
|
|
|
|
|
|
|
defined $hit->bits ? $hit->bits: ' ', |
288
|
|
|
|
|
|
|
defined $hit->significance ? $hit->significance : '?'); |
289
|
20
|
|
|
|
|
41
|
my @hsps = $hit->hsps; |
290
|
20
|
50
|
|
|
|
35
|
if( @hsps ) { |
291
|
20
|
50
|
|
|
|
37
|
$hspstr .= sprintf(">%s %s\n%9sLength = %d\n\n", |
292
|
|
|
|
|
|
|
$hit->name, |
293
|
|
|
|
|
|
|
defined $hit->description ? $hit->description : '', |
294
|
|
|
|
|
|
|
'', # empty is for the %9s in the str formatting |
295
|
|
|
|
|
|
|
$hit->length); |
296
|
|
|
|
|
|
|
|
297
|
20
|
|
|
|
|
28
|
foreach my $hsp ( @hsps ) { |
298
|
21
|
50
|
33
|
|
|
40
|
next if( defined $hspfilter && ! &{$hspfilter}($hsp) ); |
|
0
|
|
|
|
|
0
|
|
299
|
21
|
|
|
|
|
39
|
$hspstr .= sprintf(" Score = %4s bits (%s), Expect = %s", |
300
|
|
|
|
|
|
|
$hsp->bits, $hsp->score, $hsp->evalue); |
301
|
21
|
50
|
|
|
|
39
|
if( $hsp->pvalue ) { |
302
|
0
|
|
|
|
|
0
|
$hspstr .= ", P = ".$hsp->pvalue; |
303
|
|
|
|
|
|
|
} |
304
|
21
|
|
|
|
|
22
|
$hspstr .= "\n"; |
305
|
21
|
|
|
|
|
33
|
$hspstr .= sprintf(" Identities = %d/%d (%d%%)", |
306
|
|
|
|
|
|
|
( $hsp->frac_identical('total') * |
307
|
|
|
|
|
|
|
$hsp->length('total')), |
308
|
|
|
|
|
|
|
$hsp->length('total'), |
309
|
|
|
|
|
|
|
POSIX::floor($hsp->frac_identical('total') |
310
|
|
|
|
|
|
|
* 100)); |
311
|
|
|
|
|
|
|
|
312
|
21
|
50
|
|
|
|
46
|
if( $type eq 'PROTEIN' ) { |
313
|
21
|
|
|
|
|
36
|
$hspstr .= sprintf(", Positives = %d/%d (%d%%)", |
314
|
|
|
|
|
|
|
( $hsp->frac_conserved('total') * |
315
|
|
|
|
|
|
|
$hsp->length('total')), |
316
|
|
|
|
|
|
|
$hsp->length('total'), |
317
|
|
|
|
|
|
|
POSIX::floor($hsp->frac_conserved('total') * 100)); |
318
|
|
|
|
|
|
|
|
319
|
|
|
|
|
|
|
} |
320
|
21
|
50
|
|
|
|
37
|
if( $hsp->gaps ) { |
321
|
0
|
|
|
|
|
0
|
$hspstr .= sprintf(", Gaps = %d/%d (%d%%)", |
322
|
|
|
|
|
|
|
$hsp->gaps('total'), |
323
|
|
|
|
|
|
|
$hsp->length('total'), |
324
|
|
|
|
|
|
|
POSIX::floor(100 * $hsp->gaps('total') / |
325
|
|
|
|
|
|
|
$hsp->length('total'))); |
326
|
|
|
|
|
|
|
} |
327
|
21
|
|
|
|
|
24
|
$hspstr .= "\n"; |
328
|
21
|
|
|
|
|
28
|
my ($hframe,$qframe) = ( $hsp->hit->frame, |
329
|
|
|
|
|
|
|
$hsp->query->frame); |
330
|
21
|
|
|
|
|
36
|
my ($hstrand,$qstrand) = ($hsp->hit->strand,$hsp->query->strand); |
331
|
|
|
|
|
|
|
# so TBLASTX will have Query/Hit frames |
332
|
|
|
|
|
|
|
# BLASTX will have Query frame |
333
|
|
|
|
|
|
|
# TBLASTN will have Hit frame |
334
|
21
|
50
|
33
|
|
|
45
|
if( $hstrand || $qstrand ) { |
335
|
21
|
|
|
|
|
20
|
$hspstr .= " Frame = "; |
336
|
21
|
|
|
|
|
14
|
my ($signq, $signh); |
337
|
21
|
50
|
|
|
|
26
|
unless( $hstrand ) { |
338
|
0
|
|
|
|
|
0
|
$hframe = undef; |
339
|
|
|
|
|
|
|
# if strand is null or 0 then it is protein |
340
|
|
|
|
|
|
|
# and this no frame |
341
|
|
|
|
|
|
|
} else { |
342
|
21
|
100
|
|
|
|
27
|
$signh = $hstrand < 0 ? '-' : '+'; |
343
|
|
|
|
|
|
|
} |
344
|
21
|
50
|
|
|
|
24
|
unless( $qstrand ) { |
345
|
0
|
|
|
|
|
0
|
$qframe = undef; |
346
|
|
|
|
|
|
|
# if strand is null or 0 then it is protein |
347
|
|
|
|
|
|
|
} else { |
348
|
21
|
100
|
|
|
|
25
|
$signq =$qstrand < 0 ? '-' : '+'; |
349
|
|
|
|
|
|
|
} |
350
|
|
|
|
|
|
|
# remember bioperl stores frames as 0,1,2 (GFF way) |
351
|
|
|
|
|
|
|
# BLAST reports reports as 1,2,3 so |
352
|
|
|
|
|
|
|
# we have to add 1 to the frame values |
353
|
21
|
50
|
33
|
|
|
96
|
if( defined $hframe && ! defined $qframe) { |
|
|
50
|
33
|
|
|
|
|
354
|
0
|
|
|
|
|
0
|
$hspstr .= "$signh".($hframe+1); |
355
|
|
|
|
|
|
|
} elsif( defined $qframe && ! defined $hframe) { |
356
|
0
|
|
|
|
|
0
|
$hspstr .= "$signq".($qframe+1); |
357
|
|
|
|
|
|
|
} else { |
358
|
21
|
|
|
|
|
67
|
$hspstr .= sprintf(" %s%d / %s%d", |
359
|
|
|
|
|
|
|
$signq,$qframe+1, |
360
|
|
|
|
|
|
|
$signh, $hframe+1); |
361
|
|
|
|
|
|
|
} |
362
|
|
|
|
|
|
|
} |
363
|
|
|
|
|
|
|
|
364
|
21
|
50
|
33
|
|
|
118
|
if( $links && |
|
|
|
33
|
|
|
|
|
365
|
|
|
|
|
|
|
$hsp->can('links') && defined(my $lnks = $hsp->links) ) { |
366
|
0
|
|
|
|
|
0
|
$hspstr .= sprintf(" Links = %s\n",$lnks); |
367
|
|
|
|
|
|
|
} |
368
|
21
|
|
|
|
|
20
|
$hspstr .= "\n\n"; |
369
|
|
|
|
|
|
|
|
370
|
21
|
100
|
50
|
|
|
30
|
my @hspvals = ( {'name' => 'Query:', |
|
|
100
|
50
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
371
|
|
|
|
|
|
|
'seq' => $hsp->query_string, |
372
|
|
|
|
|
|
|
'start' => ( $qstrand >= 0 ? |
373
|
|
|
|
|
|
|
$hsp->query->start : |
374
|
|
|
|
|
|
|
$hsp->query->end), |
375
|
|
|
|
|
|
|
'end' => ($qstrand >= 0 ? |
376
|
|
|
|
|
|
|
$hsp->query->end : |
377
|
|
|
|
|
|
|
$hsp->query->start), |
378
|
|
|
|
|
|
|
'index' => 0, |
379
|
|
|
|
|
|
|
'direction' => $qstrand || 1 |
380
|
|
|
|
|
|
|
}, |
381
|
|
|
|
|
|
|
{ 'name' => ' 'x6, # this might need to adjust for long coordinates?? |
382
|
|
|
|
|
|
|
'seq' => $hsp->homology_string, |
383
|
|
|
|
|
|
|
'start' => undef, |
384
|
|
|
|
|
|
|
'end' => undef, |
385
|
|
|
|
|
|
|
'index' => 0, |
386
|
|
|
|
|
|
|
'direction' => 1 |
387
|
|
|
|
|
|
|
}, |
388
|
|
|
|
|
|
|
{ 'name' => 'Sbjct:', |
389
|
|
|
|
|
|
|
'seq' => $hsp->hit_string, |
390
|
|
|
|
|
|
|
'start' => ($hstrand >= 0 ? |
391
|
|
|
|
|
|
|
$hsp->hit->start : $hsp->hit->end), |
392
|
|
|
|
|
|
|
'end' => ($hstrand >= 0 ? |
393
|
|
|
|
|
|
|
$hsp->hit->end : $hsp->hit->start), |
394
|
|
|
|
|
|
|
'index' => 0, |
395
|
|
|
|
|
|
|
'direction' => $hstrand || 1 |
396
|
|
|
|
|
|
|
} |
397
|
|
|
|
|
|
|
); |
398
|
|
|
|
|
|
|
|
399
|
|
|
|
|
|
|
|
400
|
|
|
|
|
|
|
# let's set the expected length (in chars) of the starting number |
401
|
|
|
|
|
|
|
# in an alignment block so we can have things line up |
402
|
|
|
|
|
|
|
# Just going to try and set to the largest |
403
|
|
|
|
|
|
|
|
404
|
85
|
|
|
|
|
83
|
my ($numwidth) = sort { $b <=> $a }(length($hspvals[0]->{'start'}), |
405
|
|
|
|
|
|
|
length($hspvals[0]->{'end'}), |
406
|
|
|
|
|
|
|
length($hspvals[2]->{'start'}), |
407
|
21
|
|
|
|
|
91
|
length($hspvals[2]->{'end'})); |
408
|
21
|
|
|
|
|
24
|
my $count = 0; |
409
|
21
|
|
|
|
|
38
|
while ( $count <= $hsp->length('total') ) { |
410
|
21
|
|
|
|
|
30
|
foreach my $v ( @hspvals ) { |
411
|
63
|
|
|
|
|
89
|
my $piece = substr($v->{'seq'}, $v->{'index'} +$count, |
412
|
|
|
|
|
|
|
$AlignmentLineWidth); |
413
|
63
|
|
|
|
|
41
|
my $cp = $piece; |
414
|
63
|
|
|
|
|
59
|
my $plen = scalar ( $cp =~ tr/\-//); |
415
|
63
|
|
|
|
|
56
|
my ($start,$end) = ('',''); |
416
|
63
|
100
|
|
|
|
105
|
if( defined $v->{'start'} ) { |
417
|
42
|
|
|
|
|
42
|
$start = $v->{'start'}; |
418
|
|
|
|
|
|
|
# since strand can be + or - use the direction |
419
|
|
|
|
|
|
|
# to signify which whether to add or substract from end |
420
|
|
|
|
|
|
|
my $d = $v->{'direction'} * ( $AlignmentLineWidth - $plen )* |
421
|
42
|
|
|
|
|
56
|
$baselens{$v->{'name'}}; |
422
|
42
|
50
|
|
|
|
51
|
if( length($piece) < $AlignmentLineWidth ) { |
423
|
|
|
|
|
|
|
$d = (length($piece) - $plen) * $v->{'direction'} * |
424
|
42
|
|
|
|
|
54
|
$baselens{$v->{'name'}}; |
425
|
|
|
|
|
|
|
} |
426
|
42
|
|
|
|
|
41
|
$end = $v->{'start'} + $d - $v->{'direction'}; |
427
|
42
|
|
|
|
|
30
|
$v->{'start'} += $d; |
428
|
|
|
|
|
|
|
} |
429
|
|
|
|
|
|
|
$hspstr .= sprintf("%s %-".$numwidth."s %s %s\n", |
430
|
63
|
|
|
|
|
207
|
$v->{'name'}, |
431
|
|
|
|
|
|
|
$start, |
432
|
|
|
|
|
|
|
$piece, |
433
|
|
|
|
|
|
|
$end |
434
|
|
|
|
|
|
|
); |
435
|
|
|
|
|
|
|
} |
436
|
21
|
|
|
|
|
19
|
$count += $AlignmentLineWidth; |
437
|
21
|
|
|
|
|
33
|
$hspstr .= "\n"; |
438
|
|
|
|
|
|
|
} |
439
|
|
|
|
|
|
|
} |
440
|
20
|
|
|
|
|
75
|
$hspstr .= "\n"; |
441
|
|
|
|
|
|
|
} |
442
|
|
|
|
|
|
|
} |
443
|
1
|
|
|
|
|
20
|
$str .= "\n\n".$hspstr; |
444
|
|
|
|
|
|
|
|
445
|
1
|
|
33
|
|
|
5
|
$str .= sprintf(qq{ Database: %s |
|
|
|
50
|
|
|
|
|
446
|
|
|
|
|
|
|
Posted date: %s |
447
|
|
|
|
|
|
|
Number of letters in database: %s |
448
|
|
|
|
|
|
|
Number of sequences in database: %s |
449
|
|
|
|
|
|
|
|
450
|
|
|
|
|
|
|
Matrix: %s |
451
|
|
|
|
|
|
|
}, |
452
|
|
|
|
|
|
|
$result->database_name(), |
453
|
|
|
|
|
|
|
$result->get_statistic('posted_date') || |
454
|
|
|
|
|
|
|
POSIX::strftime("%b %d, %Y %I:%M %p",localtime), |
455
|
|
|
|
|
|
|
&_numwithcommas($result->database_letters()), |
456
|
|
|
|
|
|
|
&_numwithcommas($result->database_entries()), |
457
|
|
|
|
|
|
|
$result->get_parameter('matrix') || ''); |
458
|
|
|
|
|
|
|
|
459
|
1
|
50
|
|
|
|
3
|
if( defined (my $open = $result->get_parameter('gapopen')) ) { |
460
|
0
|
|
0
|
|
|
0
|
$str .= sprintf("Gap Penalties Existence: %d, Extension: %d\n", |
|
|
|
0
|
|
|
|
|
461
|
|
|
|
|
|
|
$open || 0, $result->get_parameter('gapext') || 0); |
462
|
|
|
|
|
|
|
} |
463
|
|
|
|
|
|
|
|
464
|
|
|
|
|
|
|
# skip those params we've already output |
465
|
1
|
|
|
|
|
5
|
foreach my $param ( grep { ! /matrix|gapopen|gapext/i } |
|
3
|
|
|
|
|
10
|
|
466
|
|
|
|
|
|
|
$result->available_parameters ) { |
467
|
2
|
|
|
|
|
5
|
$str .= "$param: ". $result->get_parameter($param) ."\n"; |
468
|
|
|
|
|
|
|
|
469
|
|
|
|
|
|
|
} |
470
|
1
|
|
|
|
|
2
|
$str .= "Search Statistics\n"; |
471
|
|
|
|
|
|
|
# skip posted date, we already output it |
472
|
1
|
|
|
|
|
5
|
foreach my $stat ( sort grep { ! /posted_date/ } |
|
27
|
|
|
|
|
28
|
|
473
|
|
|
|
|
|
|
$result->available_statistics ) { |
474
|
26
|
|
|
|
|
35
|
my $expect = $result->get_parameter('expect'); |
475
|
26
|
|
|
|
|
31
|
my $v = $result->get_statistic($stat); |
476
|
26
|
100
|
|
|
|
59
|
if( $v =~ /^\d+$/ ) { |
477
|
18
|
|
|
|
|
18
|
$v = &_numwithcommas($v); |
478
|
|
|
|
|
|
|
} |
479
|
26
|
100
|
66
|
|
|
65
|
if( defined $expect && |
480
|
|
|
|
|
|
|
$stat eq 'seqs_better_than_cutoff' ) { |
481
|
1
|
|
|
|
|
3
|
$str .= "seqs_better_than_$expect: $v\n"; |
482
|
|
|
|
|
|
|
} else { |
483
|
25
|
|
|
|
|
75
|
my $v = |
484
|
|
|
|
|
|
|
$str .= "$stat: $v\n"; |
485
|
|
|
|
|
|
|
} |
486
|
|
|
|
|
|
|
} |
487
|
1
|
|
|
|
|
3
|
$str .= "\n\n"; |
488
|
1
|
|
|
|
|
13
|
return $str; |
489
|
|
|
|
|
|
|
} |
490
|
|
|
|
|
|
|
|
491
|
|
|
|
|
|
|
|
492
|
|
|
|
|
|
|
=head2 start_report |
493
|
|
|
|
|
|
|
|
494
|
|
|
|
|
|
|
Title : start_report |
495
|
|
|
|
|
|
|
Usage : $index->start_report( CODE ) |
496
|
|
|
|
|
|
|
Function: Stores or returns the code to |
497
|
|
|
|
|
|
|
write the start of the block, the block |
498
|
|
|
|
|
|
|
and the start of the block of HTML. Useful |
499
|
|
|
|
|
|
|
for (for instance) specifying alternative |
500
|
|
|
|
|
|
|
HTML if you are embedding the output in |
501
|
|
|
|
|
|
|
an HTML page which you have already started. |
502
|
|
|
|
|
|
|
(For example a routine returning a null string). |
503
|
|
|
|
|
|
|
Returns \&default_start_report (see below) if not |
504
|
|
|
|
|
|
|
set. |
505
|
|
|
|
|
|
|
Example : $index->start_report( \&my_start_report ) |
506
|
|
|
|
|
|
|
Returns : ref to CODE if called without arguments |
507
|
|
|
|
|
|
|
Args : CODE |
508
|
|
|
|
|
|
|
|
509
|
|
|
|
|
|
|
=cut |
510
|
|
|
|
|
|
|
|
511
|
|
|
|
|
|
|
sub start_report { |
512
|
1
|
|
|
1
|
1
|
1
|
my( $self, $code ) = @_; |
513
|
1
|
50
|
|
|
|
3
|
if ($code) { |
514
|
0
|
|
|
|
|
0
|
$self->{'_start_report'} = $code; |
515
|
|
|
|
|
|
|
} |
516
|
1
|
|
50
|
|
|
8
|
return $self->{'_start_report'} || \&default_start_report; |
517
|
|
|
|
|
|
|
} |
518
|
|
|
|
|
|
|
|
519
|
|
|
|
|
|
|
=head2 default_start_report |
520
|
|
|
|
|
|
|
|
521
|
|
|
|
|
|
|
Title : default_start_report |
522
|
|
|
|
|
|
|
Usage : $self->default_start_report($result) |
523
|
|
|
|
|
|
|
Function: The default method to call when starting a report. |
524
|
|
|
|
|
|
|
Returns : sting |
525
|
|
|
|
|
|
|
Args : First argument is a Bio::Search::Result::ResultI |
526
|
|
|
|
|
|
|
|
527
|
|
|
|
|
|
|
=cut |
528
|
|
|
|
|
|
|
|
529
|
|
|
|
|
|
|
sub default_start_report { |
530
|
1
|
|
|
1
|
1
|
1
|
my ($result) = @_; |
531
|
1
|
|
|
|
|
2
|
return ""; |
532
|
|
|
|
|
|
|
} |
533
|
|
|
|
|
|
|
|
534
|
|
|
|
|
|
|
=head2 title |
535
|
|
|
|
|
|
|
|
536
|
|
|
|
|
|
|
Title : title |
537
|
|
|
|
|
|
|
Usage : $self->title($CODE) |
538
|
|
|
|
|
|
|
|
539
|
|
|
|
|
|
|
Function: Stores or returns the code to provide HTML for the given |
540
|
|
|
|
|
|
|
BLAST report that will appear at the top of the BLAST report |
541
|
|
|
|
|
|
|
HTML output. Useful for (for instance) specifying |
542
|
|
|
|
|
|
|
alternative routines to write your own titles. |
543
|
|
|
|
|
|
|
Returns \&default_title (see below) if not |
544
|
|
|
|
|
|
|
set. |
545
|
|
|
|
|
|
|
Example : $index->title( \&my_title ) |
546
|
|
|
|
|
|
|
Returns : ref to CODE if called without arguments |
547
|
|
|
|
|
|
|
Args : CODE |
548
|
|
|
|
|
|
|
|
549
|
|
|
|
|
|
|
=cut |
550
|
|
|
|
|
|
|
|
551
|
|
|
|
|
|
|
sub title { |
552
|
1
|
|
|
1
|
1
|
1
|
my( $self, $code ) = @_; |
553
|
1
|
50
|
|
|
|
3
|
if ($code) { |
554
|
0
|
|
|
|
|
0
|
$self->{'_title'} = $code; |
555
|
|
|
|
|
|
|
} |
556
|
1
|
|
50
|
|
|
5
|
return $self->{'_title'} || \&default_title; |
557
|
|
|
|
|
|
|
} |
558
|
|
|
|
|
|
|
|
559
|
|
|
|
|
|
|
=head2 default_title |
560
|
|
|
|
|
|
|
|
561
|
|
|
|
|
|
|
Title : default_title |
562
|
|
|
|
|
|
|
Usage : $self->default_title($result) |
563
|
|
|
|
|
|
|
Function: Provides HTML for the given BLAST report that will appear |
564
|
|
|
|
|
|
|
at the top of the BLAST report output. |
565
|
|
|
|
|
|
|
Returns : empty for text implementation |
566
|
|
|
|
|
|
|
Args : First argument is a Bio::Search::Result::ResultI |
567
|
|
|
|
|
|
|
|
568
|
|
|
|
|
|
|
=cut |
569
|
|
|
|
|
|
|
|
570
|
|
|
|
|
|
|
sub default_title { |
571
|
1
|
|
|
1
|
1
|
2
|
my ($result) = @_; |
572
|
1
|
|
|
|
|
2
|
return ""; |
573
|
|
|
|
|
|
|
# The HTML implementation |
574
|
|
|
|
|
|
|
# return sprintf( |
575
|
|
|
|
|
|
|
# qq{Bioperl Reformatted HTML of %s Search Report for %s}, |
576
|
|
|
|
|
|
|
# $result->algorithm, |
577
|
|
|
|
|
|
|
# $result->query_name()); |
578
|
|
|
|
|
|
|
} |
579
|
|
|
|
|
|
|
|
580
|
|
|
|
|
|
|
|
581
|
|
|
|
|
|
|
=head2 introduction |
582
|
|
|
|
|
|
|
|
583
|
|
|
|
|
|
|
Title : introduction |
584
|
|
|
|
|
|
|
Usage : $self->introduction($CODE) |
585
|
|
|
|
|
|
|
|
586
|
|
|
|
|
|
|
Function: Stores or returns the code to provide HTML for the given |
587
|
|
|
|
|
|
|
BLAST report detailing the query and the |
588
|
|
|
|
|
|
|
database information. |
589
|
|
|
|
|
|
|
Useful for (for instance) specifying |
590
|
|
|
|
|
|
|
routines returning alternative introductions. |
591
|
|
|
|
|
|
|
Returns \&default_introduction (see below) if not |
592
|
|
|
|
|
|
|
set. |
593
|
|
|
|
|
|
|
Example : $index->introduction( \&my_introduction ) |
594
|
|
|
|
|
|
|
Returns : ref to CODE if called without arguments |
595
|
|
|
|
|
|
|
Args : CODE |
596
|
|
|
|
|
|
|
|
597
|
|
|
|
|
|
|
=cut |
598
|
|
|
|
|
|
|
|
599
|
|
|
|
|
|
|
sub introduction { |
600
|
1
|
|
|
1
|
1
|
1
|
my( $self, $code ) = @_; |
601
|
1
|
50
|
|
|
|
2
|
if ($code) { |
602
|
0
|
|
|
|
|
0
|
$self->{'_introduction'} = $code; |
603
|
|
|
|
|
|
|
} |
604
|
1
|
|
50
|
|
|
8
|
return $self->{'_introduction'} || \&default_introduction; |
605
|
|
|
|
|
|
|
} |
606
|
|
|
|
|
|
|
|
607
|
|
|
|
|
|
|
=head2 default_introduction |
608
|
|
|
|
|
|
|
|
609
|
|
|
|
|
|
|
Title : default_introduction |
610
|
|
|
|
|
|
|
Usage : $self->default_introduction($result) |
611
|
|
|
|
|
|
|
Function: Outputs HTML to provide the query |
612
|
|
|
|
|
|
|
and the database information |
613
|
|
|
|
|
|
|
Returns : string containing HTML |
614
|
|
|
|
|
|
|
Args : First argument is a Bio::Search::Result::ResultI |
615
|
|
|
|
|
|
|
Second argument is string holding literature citation |
616
|
|
|
|
|
|
|
|
617
|
|
|
|
|
|
|
=cut |
618
|
|
|
|
|
|
|
|
619
|
|
|
|
|
|
|
sub default_introduction { |
620
|
1
|
|
|
1
|
1
|
1
|
my ($result) = @_; |
621
|
|
|
|
|
|
|
|
622
|
1
|
|
|
|
|
3
|
return sprintf( |
623
|
|
|
|
|
|
|
qq{ |
624
|
|
|
|
|
|
|
Query= %s |
625
|
|
|
|
|
|
|
(%s letters) |
626
|
|
|
|
|
|
|
|
627
|
|
|
|
|
|
|
Database: %s |
628
|
|
|
|
|
|
|
%s sequences; %s total letters |
629
|
|
|
|
|
|
|
}, |
630
|
|
|
|
|
|
|
&_linewrap($result->query_name . " " . |
631
|
|
|
|
|
|
|
$result->query_description), |
632
|
|
|
|
|
|
|
&_numwithcommas($result->query_length), |
633
|
|
|
|
|
|
|
$result->database_name(), |
634
|
|
|
|
|
|
|
&_numwithcommas($result->database_entries()), |
635
|
|
|
|
|
|
|
&_numwithcommas($result->database_letters()), |
636
|
|
|
|
|
|
|
); |
637
|
|
|
|
|
|
|
} |
638
|
|
|
|
|
|
|
|
639
|
|
|
|
|
|
|
=head2 end_report |
640
|
|
|
|
|
|
|
|
641
|
|
|
|
|
|
|
Title : end_report |
642
|
|
|
|
|
|
|
Usage : $self->end_report() |
643
|
|
|
|
|
|
|
Function: The method to call when ending a report, this is |
644
|
|
|
|
|
|
|
mostly for cleanup for formats which require you to |
645
|
|
|
|
|
|
|
have something at the end of the document () |
646
|
|
|
|
|
|
|
for HTML |
647
|
|
|
|
|
|
|
Returns : string |
648
|
|
|
|
|
|
|
Args : none |
649
|
|
|
|
|
|
|
|
650
|
|
|
|
|
|
|
=cut |
651
|
|
|
|
|
|
|
|
652
|
|
|
|
|
|
|
sub end_report { |
653
|
1
|
|
|
1
|
1
|
3
|
return ""; |
654
|
|
|
|
|
|
|
} |
655
|
|
|
|
|
|
|
|
656
|
|
|
|
|
|
|
|
657
|
|
|
|
|
|
|
# copied from Bio::Index::Fasta |
658
|
|
|
|
|
|
|
# useful here as well |
659
|
|
|
|
|
|
|
|
660
|
|
|
|
|
|
|
=head2 id_parser |
661
|
|
|
|
|
|
|
|
662
|
|
|
|
|
|
|
Title : id_parser |
663
|
|
|
|
|
|
|
Usage : $index->id_parser( CODE ) |
664
|
|
|
|
|
|
|
Function: Stores or returns the code used by record_id to |
665
|
|
|
|
|
|
|
parse the ID for record from a string. Useful |
666
|
|
|
|
|
|
|
for (for instance) specifying a different |
667
|
|
|
|
|
|
|
parser for different flavours of FASTA file. |
668
|
|
|
|
|
|
|
Returns \&default_id_parser (see below) if not |
669
|
|
|
|
|
|
|
set. If you supply your own id_parser |
670
|
|
|
|
|
|
|
subroutine, then it should expect a fasta |
671
|
|
|
|
|
|
|
description line. An entry will be added to |
672
|
|
|
|
|
|
|
the index for each string in the list returned. |
673
|
|
|
|
|
|
|
Example : $index->id_parser( \&my_id_parser ) |
674
|
|
|
|
|
|
|
Returns : ref to CODE if called without arguments |
675
|
|
|
|
|
|
|
Args : CODE |
676
|
|
|
|
|
|
|
|
677
|
|
|
|
|
|
|
=cut |
678
|
|
|
|
|
|
|
|
679
|
|
|
|
|
|
|
sub id_parser { |
680
|
20
|
|
|
20
|
1
|
15
|
my( $self, $code ) = @_; |
681
|
|
|
|
|
|
|
|
682
|
20
|
50
|
|
|
|
25
|
if ($code) { |
683
|
0
|
|
|
|
|
0
|
$self->{'_id_parser'} = $code; |
684
|
|
|
|
|
|
|
} |
685
|
20
|
|
50
|
|
|
89
|
return $self->{'_id_parser'} || \&default_id_parser; |
686
|
|
|
|
|
|
|
} |
687
|
|
|
|
|
|
|
|
688
|
|
|
|
|
|
|
|
689
|
|
|
|
|
|
|
|
690
|
|
|
|
|
|
|
=head2 default_id_parser |
691
|
|
|
|
|
|
|
|
692
|
|
|
|
|
|
|
Title : default_id_parser |
693
|
|
|
|
|
|
|
Usage : $id = default_id_parser( $header ) |
694
|
|
|
|
|
|
|
Function: The default Fasta ID parser for Fasta.pm |
695
|
|
|
|
|
|
|
Returns $1 from applying the regexp /^>\s*(\S+)/ |
696
|
|
|
|
|
|
|
to $header. |
697
|
|
|
|
|
|
|
Returns : ID string |
698
|
|
|
|
|
|
|
Args : a fasta header line string |
699
|
|
|
|
|
|
|
|
700
|
|
|
|
|
|
|
=cut |
701
|
|
|
|
|
|
|
|
702
|
|
|
|
|
|
|
sub default_id_parser { |
703
|
20
|
|
|
20
|
1
|
15
|
my ($string) = @_; |
704
|
20
|
|
|
|
|
13
|
my ($gi,$acc); |
705
|
20
|
50
|
|
|
|
44
|
if( $string =~ s/gi\|(\d+)\|?// ) |
706
|
0
|
|
|
|
|
0
|
{ $gi = $1; $acc = $1;} |
|
0
|
|
|
|
|
0
|
|
707
|
|
|
|
|
|
|
|
708
|
20
|
50
|
|
|
|
89
|
if( $string =~ /(\w+)\|([A-Z\d\.\_]+)(\|[A-Z\d\_]+)?/ ) { |
709
|
20
|
50
|
|
|
|
55
|
$acc = defined $2 ? $2 : $1; |
710
|
|
|
|
|
|
|
} else { |
711
|
0
|
|
|
|
|
0
|
$acc = $string; |
712
|
0
|
|
|
|
|
0
|
$acc =~ s/^\s+(\S+)/$1/; |
713
|
0
|
|
|
|
|
0
|
$acc =~ s/(\S+)\s+$/$1/; |
714
|
|
|
|
|
|
|
} |
715
|
20
|
|
|
|
|
31
|
return ($gi,$acc); |
716
|
|
|
|
|
|
|
} |
717
|
|
|
|
|
|
|
|
718
|
0
|
0
|
|
0
|
0
|
0
|
sub MIN { $a <=> $b ? $a : $b; } |
719
|
0
|
0
|
|
0
|
0
|
0
|
sub MAX { $a <=> $b ? $b : $a; } |
720
|
|
|
|
|
|
|
|
721
|
|
|
|
|
|
|
|
722
|
|
|
|
|
|
|
=head2 algorithm_reference |
723
|
|
|
|
|
|
|
|
724
|
|
|
|
|
|
|
Title : algorithm_reference |
725
|
|
|
|
|
|
|
Usage : my $reference = $writer->algorithm_reference($result); |
726
|
|
|
|
|
|
|
Function: Returns the appropriate Bibliographic reference for the |
727
|
|
|
|
|
|
|
algorithm format being produced |
728
|
|
|
|
|
|
|
Returns : String |
729
|
|
|
|
|
|
|
Args : L to reference |
730
|
|
|
|
|
|
|
|
731
|
|
|
|
|
|
|
|
732
|
|
|
|
|
|
|
=cut |
733
|
|
|
|
|
|
|
|
734
|
|
|
|
|
|
|
sub algorithm_reference{ |
735
|
0
|
|
|
0
|
1
|
0
|
my ($self,$result) = @_; |
736
|
0
|
0
|
0
|
|
|
0
|
return '' if( ! defined $result || !ref($result) || |
|
|
|
0
|
|
|
|
|
737
|
|
|
|
|
|
|
! $result->isa('Bio::Search::Result::ResultI')) ; |
738
|
0
|
0
|
|
|
|
0
|
if( $result->algorithm =~ /BLAST/i ) { |
|
|
0
|
|
|
|
|
|
739
|
0
|
|
|
|
|
0
|
my $res = $result->algorithm . ' '. $result->algorithm_version. "\n"; |
740
|
0
|
0
|
|
|
|
0
|
if( $result->algorithm_version =~ /WashU/i ) { |
741
|
0
|
|
|
|
|
0
|
return $res .qq{ |
742
|
|
|
|
|
|
|
Copyright (C) 1996-2000 Washington University, Saint Louis, Missouri USA. |
743
|
|
|
|
|
|
|
All Rights Reserved. |
744
|
|
|
|
|
|
|
|
745
|
|
|
|
|
|
|
Reference: Gish, W. (1996-2000) http://blast.wustl.edu |
746
|
|
|
|
|
|
|
}; |
747
|
|
|
|
|
|
|
} else { |
748
|
0
|
|
|
|
|
0
|
return $res . qq{ |
749
|
|
|
|
|
|
|
Reference: Altschul, Stephen F., Thomas L. Madden, Alejandro A. Schaffer, |
750
|
|
|
|
|
|
|
Jinghui Zhang, Zheng Zhang, Webb Miller, and David J. Lipman (1997), |
751
|
|
|
|
|
|
|
"Gapped BLAST and PSI-BLAST: a new generation of protein database search |
752
|
|
|
|
|
|
|
programs", Nucleic Acids Res. 25:3389-3402. |
753
|
|
|
|
|
|
|
}; |
754
|
|
|
|
|
|
|
} |
755
|
|
|
|
|
|
|
} elsif( $result->algorithm =~ /FAST/i ) { |
756
|
0
|
|
|
|
|
0
|
return $result->algorithm. " ". $result->algorithm_version . "\n". |
757
|
|
|
|
|
|
|
"\nReference: Pearson et al, Genomics (1997) 46:24-36\n"; |
758
|
|
|
|
|
|
|
} else { |
759
|
0
|
|
|
|
|
0
|
return ''; |
760
|
|
|
|
|
|
|
} |
761
|
|
|
|
|
|
|
} |
762
|
|
|
|
|
|
|
|
763
|
|
|
|
|
|
|
# from Perl Cookbook 2.17 |
764
|
|
|
|
|
|
|
sub _numwithcommas { |
765
|
23
|
|
|
23
|
|
24
|
my $num = reverse( $_[0] ); |
766
|
23
|
|
|
|
|
63
|
$num =~ s/(\d{3})(?=\d)(?!\d*\.)/$1,/g; |
767
|
23
|
|
|
|
|
48
|
return scalar reverse $num; |
768
|
|
|
|
|
|
|
} |
769
|
|
|
|
|
|
|
|
770
|
|
|
|
|
|
|
sub _linewrap { |
771
|
1
|
|
|
1
|
|
1
|
my ($str) = @_; |
772
|
1
|
50
|
|
|
|
5
|
if($TextWrapLoaded) { |
773
|
1
|
|
|
|
|
5
|
return Text::Wrap::wrap("","",$str); # use Text::Wrap |
774
|
0
|
|
|
|
|
0
|
} else { return $str; } # cannot wrap |
775
|
|
|
|
|
|
|
} |
776
|
|
|
|
|
|
|
=head2 Methods Bio::SearchIO::SearchWriterI |
777
|
|
|
|
|
|
|
|
778
|
|
|
|
|
|
|
L inherited methods. |
779
|
|
|
|
|
|
|
|
780
|
|
|
|
|
|
|
=head2 filter |
781
|
|
|
|
|
|
|
|
782
|
|
|
|
|
|
|
Title : filter |
783
|
|
|
|
|
|
|
Usage : $writer->filter('hsp', \&hsp_filter); |
784
|
|
|
|
|
|
|
Function: Filter out either at HSP,Hit,or Result level |
785
|
|
|
|
|
|
|
Returns : none |
786
|
|
|
|
|
|
|
Args : string => data type, |
787
|
|
|
|
|
|
|
CODE reference |
788
|
|
|
|
|
|
|
|
789
|
|
|
|
|
|
|
|
790
|
|
|
|
|
|
|
=cut |
791
|
|
|
|
|
|
|
|
792
|
|
|
|
|
|
|
=head2 no_wublastlinks |
793
|
|
|
|
|
|
|
|
794
|
|
|
|
|
|
|
Title : no_wublastlinks |
795
|
|
|
|
|
|
|
Usage : $obj->no_wublastlinks($newval) |
796
|
|
|
|
|
|
|
Function: Get/Set boolean value regarding whether or not to display |
797
|
|
|
|
|
|
|
Link = (1) |
798
|
|
|
|
|
|
|
type output in the report output (WU-BLAST only) |
799
|
|
|
|
|
|
|
Returns : boolean |
800
|
|
|
|
|
|
|
Args : on set, new boolean value (a scalar or undef, optional) |
801
|
|
|
|
|
|
|
|
802
|
|
|
|
|
|
|
|
803
|
|
|
|
|
|
|
=cut |
804
|
|
|
|
|
|
|
|
805
|
|
|
|
|
|
|
sub no_wublastlinks{ |
806
|
2
|
|
|
2
|
1
|
3
|
my $self = shift; |
807
|
|
|
|
|
|
|
|
808
|
2
|
100
|
|
|
|
8
|
return $self->{'no_wublastlinks'} = shift if @_; |
809
|
1
|
|
|
|
|
2
|
return $self->{'no_wublastlinks'}; |
810
|
|
|
|
|
|
|
} |
811
|
|
|
|
|
|
|
|
812
|
|
|
|
|
|
|
|
813
|
|
|
|
|
|
|
1; |