~ubuntu-branches/ubuntu/trusty/bioperl/trusty

« back to all changes in this revision

Viewing changes to Bio/AlignIO/phylip.pm

  • Committer: Package Import Robot
  • Author(s): Charles Plessy
  • Date: 2013-09-22 13:39:48 UTC
  • mfrom: (3.1.11 sid)
  • Revision ID: package-import@ubuntu.com-20130922133948-c6z62zegjyp7ztou
Tags: 1.6.922-1
* New upstream release.
* Replaces and Breaks grinder (<< 0.5.3-3~) because of overlaping contents.
  Closes: #722910
* Stop Replacing and Breaking bioperl ( << 1.6.9 ): not needed anymore. 

Show diffs side-by-side

added added

removed removed

Lines of Context:
50
50
 
51
51
Long IDs up to 50 characters are supported by flag -longid =E<gt>
52
52
1. ID strings can be surrounded by single quoted. They are mandatory
53
 
only if the IDs contain spaces. 
 
53
only if the IDs contain spaces.
54
54
 
55
55
=head1 FEEDBACK
56
56
 
57
 
=head2 Support 
 
57
=head2 Support
58
58
 
59
59
Please direct usage questions or support issues to the mailing list:
60
60
 
61
61
I<bioperl-l@bioperl.org>
62
62
 
63
 
rather than to the module maintainer directly. Many experienced and 
64
 
reponsive experts will be able look at the problem and quickly 
65
 
address it. Please include a thorough description of the problem 
 
63
rather than to the module maintainer directly. Many experienced and
 
64
reponsive experts will be able look at the problem and quickly
 
65
address it. Please include a thorough description of the problem
66
66
with code and data examples if at all possible.
67
67
 
68
68
=head2 Reporting Bugs
176
176
 
177
177
    my $aln =  Bio::SimpleAlign->new(-source => 'phylip');
178
178
 
179
 
    # skip blank lines until we see header line
180
 
    # if we see a non-blank line that isn't the seqcount and residuecount line
 
179
    # First, parse up through the header.
 
180
    # If we see a non-blank line that isn't the seqcount and residuecount line
181
181
    # then bail out of next_aln (return)
182
 
    HEADER: while ($entry = $self->_readline) {
183
 
        next if $entry =~ /^\s?$/; 
184
 
        if ($entry =~ /\s*(\d+)\s+(\d+)/) {
 
182
    while ($entry = $self->_readline) {
 
183
        if ($entry =~ /^\s?$/) {
 
184
            next;
 
185
        } elsif ($entry =~ /\s*(\d+)\s+(\d+)/) {
185
186
            ($seqcount, $residuecount) = ($1, $2);
186
 
 
 
187
            last;
 
188
        } else {
 
189
                $self->warn ("Failed to parse PHYLIP: Did not see a sequence count and residue count.");
 
190
            return;
187
191
        }
188
 
        last HEADER;
189
192
    }
190
 
    return unless $seqcount and $residuecount;
191
193
 
192
 
    # first alignment section
 
194
    # First alignment section. We expect to see a name and (part of) a sequence.
193
195
    my $idlen = $self->idlength;
194
196
    $count = 0;
195
 
    my $iter = 1;
196
 
    my $interleaved = $self->interleaved;
197
 
    while( $entry = $self->_readline) {
198
 
        last if( $entry =~ /^\s?$/ && $interleaved );
199
 
 
200
 
    # we've hit the next entry.
201
 
        if( $entry =~ /^\s+(\d+)\s+(\d+)\s*$/) {
202
 
            $self->_pushback($entry);
203
 
            last;
204
 
        }
205
 
        if( $self->longid  && $entry =~ /\w/ ) {
206
 
            if ($entry =~ /'/) {
207
 
                $entry =~ /^\s*'([^']+)'\s+(.+)$/;
208
 
                $name = $1;
209
 
                $str = $2;
210
 
            } else {
211
 
                $entry =~ /^\s*([^\s]+)\s+(.+)$/;
212
 
                $name = $1;
213
 
                $str = $2;
214
 
            }
215
 
#           $name =~ s/[\s\/]/_/g; # not sure how wise is it to do this
216
 
            $name =~ s/_+$//; # remove any trailing _'s
217
 
            
218
 
            push @names, $name;
219
 
            $str =~ s/\s//g;
220
 
            $count = scalar @names;
221
 
            $hash{$count} = $str;
222
 
 
223
 
        } elsif( $entry =~ /^\s+(.+)$/ ) {
224
 
            $interleaved = 0;
225
 
            $str = $1;
226
 
            $str =~ s/\s//g;
227
 
            $count = scalar @names;
228
 
            $hash{$count} .= $str;
229
 
        } elsif( $entry =~ /^(.{$idlen})\s*(.*)\s$/ ||
230
 
                 $entry =~ /^(.{$idlen})(\S{$idlen}\s+.+)\s$/ # Handle weirdness when id is too long
231
 
                 ) {
232
 
            $name = $1;
233
 
            $str = $2;
234
 
            $name =~ s/[\s\/]/_/g;
235
 
            $name =~ s/_+$//; # remove any trailing _'s
236
 
 
237
 
            push @names, $name;
238
 
            $str =~ s/\s//g;
239
 
            $count = scalar @names;
240
 
            $hash{$count} = $str;
241
 
        } elsif( $interleaved ) {
242
 
            if( $entry =~ /^(\S+)\s+(.+)/ ||
243
 
                $entry =~ /^(.{$idlen})(.*)\s$/ ) {
244
 
                $name = $1;
245
 
                $str = $2;
246
 
                $name =~ s/[\s\/]/_/g;
247
 
                $name =~ s/_+$//; # remove any trailing _'s
248
 
                push @names, $name;
249
 
                $str =~ s/\s//g;
250
 
                $count = scalar @names;
251
 
                $hash{$count} = $str;
252
 
            } else {
253
 
                $self->debug("unmatched line: $entry");
254
 
            }
255
 
        }
256
 
        $self->throw("Not a valid interleaved PHYLIP file!") if $count > $seqcount;
257
 
    }
258
 
 
259
 
    if( $interleaved ) {
260
 
        # interleaved sections
261
 
        $count = 0;
262
 
        while( $entry = $self->_readline) {
263
 
            # finish current entry
264
 
            if($entry =~/\s*\d+\s+\d+/){
265
 
                $self->_pushback($entry);
266
 
                last;
267
 
            }
268
 
            $count = 0, next if $entry =~ /^\s$/;
269
 
            $entry =~ /\s*(.*)$/ && do {
270
 
                $str = $1;
271
 
                $str =~ s/\s//g;
272
 
                $count++;
273
 
                $hash{$count} .= $str;
274
 
            };
275
 
            $self->throw("Not a valid interleaved PHYLIP file! [$count,$seqcount] ($entry)") if $count > $seqcount;
276
 
        }
277
 
    }
278
 
    return if scalar @names < 1;
279
 
 
280
 
    # sequence creation
281
 
    $count = 0;
282
 
    foreach $name ( @names ) {
283
 
        $count++;
284
 
        if( $name =~ /(\S+)\/(\d+)-(\d+)/ ) {
285
 
            $seqname = $1;
286
 
            $start = $2;
287
 
            $end = $3;
288
 
        } else {
289
 
            $seqname=$name;
290
 
            $start = 1;
291
 
            $str = $hash{$count};
292
 
#           $str =~ s/[^A-Za-z]//g;
293
 
            #$end = length($str);
294
 
        }
295
 
        # consistency test
296
 
        $self->throw("Length of sequence [$seqname] is not [$residuecount] it is ".CORE::length($hash{$count})."! ")
297
 
            unless CORE::length($hash{$count}) == $residuecount;
298
 
 
299
 
        $seq = Bio::LocatableSeq->new('-seq'           => $hash{$count},
300
 
                                      '-display_id'    => $seqname,
301
 
                                      '-start'         => $start,
302
 
                                      (defined $end) ? ('-end'           => $end) : (),
303
 
                                      '-alphabet'      => $self->alphabet,
304
 
                                      );
305
 
        $aln->add_seq($seq);
306
 
 
307
 
   }
308
 
   return $aln if $aln->num_sequences;
309
 
   return;
 
197
 
 
198
    while ($entry = $self->_readline) {
 
199
        if ($entry =~ /^\s?$/) { # eat the newlines
 
200
            next;
 
201
        }
 
202
 
 
203
        # Names can be in a few different formats:
 
204
        # 1. they can be traditional phylip: 10 chars long, period. If this is the case, that name can have spaces.
 
205
        # 2. they can be hacked with a long ID, as passed in with the flag -longid.
 
206
        # 3. if there is a long ID, the name can have spaces as long as it is wrapped in single quotes.
 
207
        if ($self->longid()) { # 2 or 3
 
208
            if ($entry =~ /^'(.+)'\s+(.+)$/) { # 3. name has single quotes.
 
209
                $name = $1;
 
210
                $str = $2;
 
211
            } else {    # 2. name does not have single quotes, so should not have spaces.
 
212
                # therefore, the first part of the line is the name and the rest is the seq.
 
213
                # make sure that the line does not lead with extra spaces.
 
214
                $entry =~ s/^\s+//;
 
215
                ($name, $str) = split (/\s+/,$entry, 2);
 
216
            }
 
217
        } else { # 1. traditional phylip.
 
218
            $entry =~ /^(.{10})\s+(.+)$/;
 
219
            $name = $1;
 
220
            $str = $2;
 
221
            $name =~ s/\s+$//; # eat any trailing spaces
 
222
            $name =~ s/\s+/_/g;
 
223
        }
 
224
        push @names, $name;
 
225
        #clean sequence of spaces:
 
226
        $str =~ s/\s+//g;
 
227
 
 
228
        # are we sequential? If so, we should keep adding to the sequence until we've got all the residues.
 
229
        if (($self->interleaved) == 0) {
 
230
            while (length($str) < $residuecount) {
 
231
                $entry = $self->_readline;
 
232
                $str .= $entry;
 
233
                $str =~ s/\s+//g;
 
234
                if ($entry =~ /^\s*$/) { # we ran into a newline before we got a complete sequence: bail!
 
235
                    $self->warn("Failed to parse PHYLIP: Sequence $name was shorter than expected: " . length($str) . " instead of $residuecount.");
 
236
                    last;
 
237
                }
 
238
            }
 
239
        }
 
240
        $hash{$count} = $str;
 
241
 
 
242
        $count++;
 
243
        # if we've read as many seqs as we're supposed to, move on.
 
244
        if ($count == $seqcount) {
 
245
            last;
 
246
        }
 
247
    }
 
248
 
 
249
    # if we are interleaved, we're going to keep seeing chunks of sequence until we get all of it.
 
250
    if ($self->interleaved) {
 
251
        while (length($hash{$seqcount-1}) < $residuecount) {
 
252
            $count = 0;
 
253
            while ($entry = $self->_readline) {
 
254
                if ($entry =~ /^\s*$/) { # eat newlines
 
255
                    if ($count != 0) { # there was a newline at an unexpected place!
 
256
                        $self->warn("Failed to parse PHYLIP: Interleaved file is missing a segment: saw $count, expected $seqcount.");
 
257
                        return;
 
258
                    }
 
259
                    next;
 
260
                } else { # start taking in chunks
 
261
                    $entry =~ s/\s//g;
 
262
                    $hash{$count} .= $entry;
 
263
                    $count++;
 
264
                }
 
265
                if ($count >= $seqcount) { # we've read all of the sequences for this chunk, so move on.
 
266
                    last;
 
267
                }
 
268
            }
 
269
        }
 
270
    }
 
271
    if ((scalar @names) != $seqcount) {
 
272
        $self->warn("Failed to parse PHYLIP: Did not see the correct number of seqs: saw " . scalar(@names) . ", expected $seqcount.");
 
273
        return;
 
274
    }
 
275
    for ($count=0; $count<$seqcount; $count++) {
 
276
        $str = $hash{$count};
 
277
        my $seqname = $names[$count];
 
278
        if (length($str) != $residuecount) {
 
279
            $self->warn("Failed to parse PHYLIP: Sequence $seqname was the wrong length: " . length($str) . " instead of $residuecount.");
 
280
        }
 
281
        $seq = Bio::LocatableSeq->new('-seq'  => $hash{$count},
 
282
                          '-display_id'    => $seqname);
 
283
        $aln->add_seq($seq);
 
284
    }
 
285
    return $aln;
310
286
}
311
287
 
312
 
 
313
288
=head2 write_aln
314
289
 
315
290
 Title   : write_aln
356
331
        foreach $seq ( $aln->each_seq() ) {
357
332
            $name = $aln->displayname($seq->get_nse);
358
333
            if ($self->longid) {
359
 
                $self->warn("The lenght of the name is over 50 chars long [$name]") 
360
 
                    if length($name) > 50; 
 
334
                $self->warn("The length of the name is over 50 chars long [$name]")
 
335
                    if length($name) > 50;
361
336
                $name = "'$name'  "
362
337
            } else {
363
338
                $name = substr($name, 0, $idlength) if length($name) > $idlength;
404
379
                    # last
405
380
                    if( $index < $numtags) {
406
381
                        # space to print!
407
 
                        $self->_print (sprintf("%s ",substr($hash{$name},
 
382
                        $self->_print (sprintf("%s",substr($hash{$name},
408
383
                                                            $tempcount)));
409
384
                        $tempcount += $tag_length;
410
385
                    }