3 # BioPerl module for Bio::AlignIO::clustalw
5 # based on the Bio::SeqIO modules
6 # by Ewan Birney <birney@ebi.ac.uk>
7 # and Lincoln Stein <lstein@cshl.org>
8 # and the Bio::SimpleAlign module of Ewan Birney
10 # Copyright Peter Schattner
12 # You may distribute this module under the same terms as perl itself
15 # POD documentation - main docs before the code
19 Bio::AlignIO::clustalw - clustalw sequence input/output stream
23 Do not use this module directly. Use it via the Bio::AlignIO class.
27 This object can transform Bio::Align::AlignI objects to and from clustalw
34 User feedback is an integral part of the evolution of this and other
35 Bioperl modules. Send your comments and suggestions preferably to one
36 of the Bioperl mailing lists. Your participation is much appreciated.
38 bioperl-l@bioperl.org - General discussion
39 http://bioperl.org/wiki/Mailing_lists - About the mailing lists
43 Please direct usage questions or support issues to the mailing list:
45 I<bioperl-l@bioperl.org>
47 rather than to the module maintainer directly. Many experienced and
48 reponsive experts will be able look at the problem and quickly
49 address it. Please include a thorough description of the problem
50 with code and data examples if at all possible.
54 Report bugs to the Bioperl bug tracking system to help us keep track
55 the bugs and their resolution. Bug reports can be submitted via the
58 http://bugzilla.open-bio.org/
60 =head1 AUTHORS - Peter Schattner
62 Email: schattner@alum.mit.edu
67 The rest of the documentation details each of the object
68 methods. Internal methods are usually preceded with a _
72 # Let the code begin...
74 package Bio
::AlignIO
::clustalw
;
75 use vars
qw($LINELENGTH $CLUSTALPRINTVERSION);
80 $CLUSTALPRINTVERSION = '1.81';
81 use base qw(Bio::AlignIO);
86 Usage : $alignio = Bio::AlignIO->new(-format => 'clustalw',
88 Function: returns a new Bio::AlignIO object to handle clustalw files
89 Returns : Bio::AlignIO::clustalw object
90 Args : -verbose => verbosity setting (-1, 0, 1, 2)
91 -file => name of file to read in or to write, with ">"
92 -fh => alternative to -file param - provide a filehandle
93 to read from or write to
94 -format => alignment format to process or produce
95 -percentages => display a percentage of identity
96 in each line of the alignment (clustalw only)
97 -linelength=> alignment output line length (default 60)
102 my ( $self, @args ) = @_;
103 $self->SUPER::_initialize
(@args);
104 my ( $percentages, $ll ) =
105 $self->_rearrange( [qw(PERCENTAGES LINELENGTH)], @args );
106 defined $percentages && $self->percentages($percentages);
107 $self->line_length( $ll || $LINELENGTH );
113 Usage : $aln = $stream->next_aln()
114 Function: returns the next alignment in the stream
115 Returns : Bio::Align::AlignI object
118 See L<Bio::Align::AlignI> for details
126 while ( $first_line = $self->_readline ) {
127 last if $first_line !~ /^$/;
129 $self->_pushback($first_line);
130 if ( defined( $first_line = $self->_readline )
131 && $first_line !~ /CLUSTAL/ )
134 "trying to parse a file which does not start with a CLUSTAL header"
138 my $aln = Bio
::SimpleAlign
->new(
139 -source
=> 'clustalw',
140 -verbose
=> $self->verbose
144 $self->{_lastline
} = '';
145 my ($first_block, $seen_block) = (0,0);
146 while ( defined( $_ = $self->_readline ) ) {
147 next if (/^\s+$/ && !$first_block);
148 if (/^\s$/) { # line contains no description
153 # break the loop if we come to the end of the current alignment
154 # and push back the CLUSTAL header
156 $self->_pushback($_);
160 my ( $seqname, $aln_line ) = ( '', '' );
161 if (/^\s*(\S+)\s*\/\s
*(\d
+)-(\d
+)\s
+(\S
+)\s
*$/ox
) {
164 ( $seqname, $aln_line ) = ( "$1:$2-$3", $4 );
166 # } elsif( /^\s*(\S+)\s+(\S+)\s*$/ox ) { without trailing numbers
168 elsif (/^\s*(\S+)\s+(\S+)\s*\d*\s*$/ox) { # with numbers
169 ( $seqname, $aln_line ) = ( $1, $2 );
170 if ( $seqname =~ /^[\*\.\+\:]+$/ ) {
171 $self->{_lastline
} = $_;
176 $self->{_lastline
} = $_;
180 if ( !$seen_block ) {
181 if (exists $order{$seqname}) {
182 $self->warn("Duplicate sequence : $seqname\n".
183 "Can't guarantee alignment quality");
186 $order{$seqname} = $order++;
190 $alignments{$seqname} .= $aln_line;
193 my ( $sname, $start, $end );
194 foreach my $name ( sort { $order{$a} <=> $order{$b} } keys %alignments ) {
195 if ( $name =~ /(\S+):(\d+)-(\d+)/ ) {
196 ( $sname, $start, $end ) = ( $1, $2, $3 );
199 ( $sname, $start ) = ( $name, 1 );
200 my $str = $alignments{$name};
201 $str =~ s/[^A-Za-z]//g;
204 my $seq = Bio
::LocatableSeq
->new(
205 -seq
=> $alignments{$name},
213 # not sure if this should be a default option - or we can pass in
214 # an option to do this in the future? --jason stajich
215 # $aln->map_chars('\.','-');
217 # no sequences added, so just return
218 return $aln if $aln->num_sequences;
225 Usage : $stream->write_aln(@aln)
226 Function: writes the clustalw-format object (.aln) into the stream
227 Returns : 1 for success and 0 for error
228 Args : Bio::Align::AlignI object
233 my ( $self, @aln ) = @_;
234 my ( $count, $length, $seq, @seq, $tempcount, $line_len );
235 $line_len = $self->line_length || $LINELENGTH;
236 foreach my $aln (@aln) {
237 if ( !$aln || !$aln->isa('Bio::Align::AlignI') ) {
239 "Must provide a Bio::Align::AlignI object when calling write_aln"
243 my $matchline = $aln->match_line;
244 if ( $self->force_displayname_flat ) {
245 $aln->set_displayname_flat(1);
248 sprintf( "CLUSTAL W(%s) multiple sequence alignment\n\n\n",
249 $CLUSTALPRINTVERSION )
251 $length = $aln->length();
252 $count = $tempcount = 0;
253 @seq = $aln->each_seq();
255 foreach $seq (@seq) {
256 $max = length( $aln->displayname( $seq->get_nse() ) )
257 if ( length( $aln->displayname( $seq->get_nse() ) ) > $max );
260 while ( $count < $length ) {
261 my ( $linesubstr, $first ) = ( '', 1 );
262 foreach $seq (@seq) {
265 # Following lines are to suppress warnings
266 # if some sequences in the alignment are much longer than others.
269 my $seqchars = $seq->seq();
271 if ( length($seqchars) >= ( $count + $line_len ) ) {
272 $substring = substr( $seqchars, $count, $line_len );
275 substr( $matchline, $count, $line_len );
280 elsif ( length($seqchars) >= $count ) {
281 $substring = substr( $seqchars, $count );
283 $linesubstr = substr( $matchline, $count );
292 "%-" . $max . "s %s\n",
293 $aln->displayname( $seq->get_nse() ), $substring
298 my $percentages = '';
299 if ( $self->percentages ) {
300 my ($strcpy) = ($linesubstr);
301 my $count = ( $strcpy =~ tr/\*// );
303 sprintf( "\t%d%%", 100 * ( $count / length($linesubstr) ) );
307 "%-" . $max . "s %s%s\n",
308 '', $linesubstr, $percentages
311 $self->_print( sprintf("\n\n") ) or return;
315 $self->flush if $self->_flush_on_write && defined $self->_fh;
322 Usage : $obj->percentages($newval)
323 Function: Set the percentages flag - whether or not to show percentages in
325 Returns : value of percentages
326 Args : newvalue (optional)
332 my ( $self, $value ) = @_;
333 if ( defined $value ) {
334 $self->{'_percentages'} = $value;
336 return $self->{'_percentages'};
342 Usage : $obj->line_length($newval)
343 Function: Set the alignment output line length
344 Returns : value of line_length
345 Args : newvalue (optional)
351 my ( $self, $value ) = @_;
352 if ( defined $value ) {
353 $self->{'_line_length'} = $value;
355 return $self->{'_line_length'};