Get shortest and longest sequence in file - perl

Question

I'm trying to get the shortest and longest sequence in a file containing multiple genbank-like entries. example of the file:
LOCUS NM_182854 2912 bp mRNA linear PRI 20-APR-2016
DEFINITION Homo sapiens mRNA.
ACCESSION NM_182854
SOURCE Homo sapiens (human)
ORGANISM Homo sapiens
Eukaryota; Metazoa; Chordata; Craniata; Vertebrata; Euteleostomi;
Mammalia; Eutheria; Euarchontoglires; Primates; Haplorrhini;
Catarrhini; Hominidae; Homo.
ORIGIN
1 gggcgatcag aagcaggtca cacagcctgt ttcctgtttt caaacgggga acttagaaag
61 tggcagcccc tcggcttgtc gccggagctg agaaccaaga gctcgaaggg gccatatgac
//
LOCUS NM_001323410 6992 bp mRNA linear PRI 20-APR-2016
DEFINITION Homo sapiens mRNA.
ACCESSION NM_001323410
SOURCE Homo sapiens (human)
ORGANISM Homo sapiens
Eukaryota; Metazoa; Chordata; Craniata; Vertebrata; Euteleostomi;
Mammalia; Eutheria; Euarchontoglires; Primates; Haplorrhini;
Catarrhini; Hominidae; Homo.
ORIGIN
1 actacttccg gcttccccgc cccgccccgt ccccgggcgt ctccattttg gtctcaggtg
61 tggactcggc aagaaccagc gcaagaggga agcagagtta tagctacccc ggc
//
I'd like to print the accession number, the type of the organism from the shortest sequence and the longest sequence
my code so far:
#!/usr/bin/perl
use strict;
use warnings;
print "enter file path\n";
while (my $line = <>){
chomp $line;
my #record = ($line);
foreach my $file(#record){
open(IN, "$file") or die "\n error opening file \n;/\n";
$/="//";
while (my $line = <IN>){
my #gb_seq = split ("ORIGIN", $line);
my $definition = $gb_seq[0];
my $sequence = $gb_seq[1];
$definition =~ m/ORGANISM[\s\t]+(.+)[\n\s\t]+/;
my $organism = $1;
if ($definition =~ m/ACCESSION[\s\t]+(\D\D_\d\d\d\d\d\d(\d*))[\n\s\t]+/){
my $accession = $1;
$sequence =~ s/\d//g;
$sequence =~ s/[\n\s\t]//g;
my $size = length($sequence);
my #sorted_keys = sort { $a <=> $b } keys my %size;
my $shortest = $sorted_keys[0];
my $longest = $sorted_keys[-1];
print "this is the shortest: $accession $organism size: $shortest\n";
print "this is the longest: $accession $organism size: $longest\n";
}
}}}
exit;
I thought about putting the length in a hash to get the shortest and the longest but something is wrong there. I get these errors:
Use of uninitialized value $organism in concatenation (.) or string at test.pl line 39, <IN> chunk 1
Use of uninitialized value $shortest in concatenation (.) or string at test.pl line 39, <IN> chunk 1.
Use of uninitialized value $longest in concatenation (.) or string at test.pl line 40, <IN> chunk 1.
What part should I change? Thanks

Answer 1

We need to find extreme-length entries while being able to identify the record they belong to. Reading records by // is again a nice idea. However, then each record is a string and pulling the sequence out of it directly is harder than breaking it into lines first. Thus we may as well go line by line, given that there are clear markers for everything needed.
A choice of data structure is important and depends on the purpose. Here I organize data so that it is easy to work with, into a hash with elements
%block = ( 'accession' => { 'type' => type, 'sequence' => sequence }, ... )
The search to perform once the data is read in would be greatly aided by organizing this by 'sequence' (instead of by 'accession'), but that would make it very hard to work with. I presume that this may end up being used for more, and that a small loss of speed is not of consequence. If the sole objective here were to answer the specific question with optimal performance other approaches would be more suitable. Comments follow the code.
use warnings;
use strict;
use feature qw(say);
my $file = 'data_seqs.txt';
open my $fh, '<', $file or die "Can't open $file -- $!";
# Hash, helper variables, flag (inside a sequence?), sequence-end marker
my (%block, $accession, $sequence);
my $is_seq = 0;
my $end_marker = qr(\s*//); # marks end of sequence: //
while (my $line = <$fh>)
{
chomp($line);
next if $line =~ /^\s*$/; # skip empty lines
if ($line =~ /$end_marker/) { # done with the sequence
$is_seq = 0;
$sequence = '';
next;
}
if ($line =~ /^\s*ACCESSION\s*(\w+)/) {
$accession = $1;
}
elsif ($line =~ /^\s*ORGANISM\s*(.+)/) {
$block{$accession}{'type'} = $1;
}
elsif ($line =~ /^\s*ORIGIN/) { # start sequence on next line
$is_seq = 1;
}
elsif ($is_seq) { # read (and add to) sequence
if ($line =~ /^\s*\d+\s*(.*)/) {
$block{$accession}{'sequence'} .= $1;
}
else { warn "Not sequence? Line: $line " }
}
}
# Identify keys for max and min lenght. Initialize with any keys
my ($max, $min) = keys %block;
foreach my $acc (keys %block)
{
my $current_len = length($block{$acc}{'sequence'});
if ( $current_len > length($block{$max}{'sequence'}) ) {
$max = $acc;
}
if ( $current_len < length($block{$min}{'sequence'}) ) {
$min = $acc;
}
}
say "Maximum length sequence: ACCESSION: $max, ORGANISM: " . $block{$max}{'type'};
say "Minimum length sequence: ACCESSION: $min, ORGANISM: " . $block{$min}{'type'};
use Data::Dumper;
print Dumper(\%block);
This prints (Dumper's printout omitted)
Maximum length sequence: ACCESSION: NM_182854, ORGANISM Homo sapiens
Minimum length sequence: ACCESSION: NM_001323410, ORGANISM Homo sapiens
A comment on searching efficiency
One common approach would be to first build a reverse lookup hash, then use a library, say from List::Utils, to find max and min, then look up where they belong. For this we do need to build the lookup hash and we'd use the library twice, while searching through it by hand as above makes one pass over the structure and is also simpler. Another option would be to have hash top-level keys be sequences and then directly find max and min. However, such hash would be considerably harder to work with.
Yet another approach would be to organize data into a structure that would allow more efficient retrieval of this specific information, probably based on arrays.
However, the efficiency gain doesn't seem to justify the great loss of convenience. If the speed turns out to be a problem then this should be considered.
If you need to work with multiple files just change the loop to while (<>) and submit them on the command line. All lines from all of them will then be read line by line and the code stays the same.
It may be that I misunderstood some terms. I don't remove empty spaces from the "sequence", and use words on the first line only for "type", just to name a couple of candidates. These are easy to adjust, please let me know.

Answer 2

You state that you want two pieces of data - the accession and the organism - for the longest and shortest sequence. This means your hash values need to store two elements. As well as that, when you use '//' as a record separator, the '//' still appears on the end of each record. So, when you filter out whitespace and digits from you sequence, you're still left with '//' on the end. When I ran your code through the debugger, I was finding the lengths were all out by 2 because of this.
A couple of other things:
When using regexs, use 'extended mode', /x, so you can include whitespace for readabillity
you presume a successful match when you dig out $definition - better to test your regexs and assign on match, die on missmatch
Rather than store the length in the hash (and lose the sequence itself), you might as well store the sequence and calculate the lengths later;
I renamed the variable $line to $chunk as it contains several lines
All the stuff to do with calculating the shortest and longest and printing the resuts needs to move out of the loop. In its place, you simply need to make an entry into the hash. As described above, the hash values need to be an array with two values - the accession and the organism.
You remove digits from the sequence in one command and then whitespace from the sequence in another - might as well do them both togeather. While we're at it, might as well remove the '/'s on the end of the record.
Given the mods above, I get;
use v5.14;
use warnings;
print "Enter file path: ";
chomp(my $filename = <>);
open(IN, $filename) or die "\n error opening file \n;/\n";
$/ = "//" ;
my %organisms ;
while (my $chunk = <IN>) {
next if $chunk =~ /^\s*\n\s*$/ ;
my ($definition , $sequence) = split "ORIGIN", $chunk ;
my $organism ;
$definition =~ m/ ORGANISM [\s\t]+ (.+) [\n\s\t]+ /x
? $organism = $1
: die "Couldnt find ORGANISM line" ;
my $accession ;
$definition =~ m/ ACCESSION [\s\t]+ (\D\D _ \d{6} (\d*)) [\n\s\t]+ /x
? $accession = $1
: die "Cant find ACCESSION line" ;
$sequence =~ s/[\d\n\s\t\/]//g;
$organisms{ $sequence } = [ $accession , $organism ] ;
}
my #sorted_keys = sort { length $a <=> length $b } keys %organisms ;
my $shortest = $sorted_keys[0];
my $longest = $sorted_keys[-1];
say "this is the shortest: ", $organisms{$shortest}->[0],
", ", $organisms{$shortest}->[1],
" size: ", length $shortest, "\n",
" sequence: ", $shortest ;
say "this is the longest: ", $organisms{$longest}->[0],
", ", $organisms{$longest}->[1],
" size: ", length $longest, "\n",
" sequence: ", $longest ;
exit;
when ran on your data, it produces;
$ ./sequence.pl
Enter file path: data.txt
this is the shortest: NM_001323410, Homo sapiens size: 113
sequence: actacttccggcttccccgccccgccccgtccccgggcgtctccattttggtctcaggtgtggactcggcaagaaccagcgcaagagggaagcagagttatagctaccccggc
this is the longest: NM_182854, Homo sapiens size: 120
sequence: gggcgatcagaagcaggtcacacagcctgtttcctgttttcaaacggggaacttagaaagtggcagcccctcggcttgtcgccggagctgagaaccaagagctcgaaggggccatatgac
UPDATE
The problem with the code above is that if the same sequence appears in two chunks, then data is going to be overwritten in the hash and lost. Below is an updated version that stores data in an array of arrays which will advoid the problem. It produces exactly the same output:
use v5.14;
use warnings;
print "Enter file path: ";
chomp(my $filename = <>);
open(IN, $filename) or die "\n error opening file \n;/\n";
$/ = "//" ;
my #organisms ;
while (my $chunk = <IN>) {
next if $chunk =~ /^\s*\n\s*$/ ;
my ($definition , $sequence) = split "ORIGIN", $chunk ;
my $organism ;
$definition =~ m/ ORGANISM [\s\t]+ (.+) [\n\s\t]+ /x
? $organism = $1
: die "Couldnt find ORGANISM line" ;
my $accession ;
$definition =~ m/ ACCESSION [\s\t]+ (\D\D _ \d{6} (\d*)) [\n\s\t]+ /x
? $accession = $1
: die "Cant find ACCESSION line" ;
$sequence =~ s/[\d\n\s\t\/]//g;
push #organisms, [$organism , $accession , $sequence] ;
}
my #sorted_organisms = sort { length $a->[2] <=> length $b->[2] } #organisms ;
my ($organism , $accession , $sequence) = #{ $sorted_organisms[0] };
say "this is the shortest: $accession, $organism, size: ",
length $sequence, "\n", " sequence: ", $sequence ;
($organism , $accession , $sequence) = #{ $sorted_organisms[-1] };
say "this is the longest: $accession, $organism, size: ",
length $sequence, "\n", " sequence: ", $sequence ;
exit;