Perl script to subset multiple DNA sequences - perl

Question

I have a FASTA file of ~500 DNA sequences, each of which has target position for a Single-Neucleotide Polymorphism (SNP) of interest that is known to me.
For each entry in the file, I have a separate tab-delimited text file that has on each line
The FASTA sequence name
The start position
The end position
The SNP position
The sequences and the positions in the text file are in the same order.
The dummy FASTA file is:
>AOS-94_S25_L002_R1_001_trimmed_contig_767
GACACACACTGATTGTTAGTGGTGTACAGACATTGCTTCAAACTGCA
>AOS-94_S25_L002_R1_001_trimmed_contig_2199
TAGGTTTTCTTTCCCATGTCCCCTGAATAACATGGGATTCCCTGTGACTGTGGGGACCCCTGAGAGCCTGGT
>AOS-94_S25_L002_R1_001_trimmed_contig_2585
GATAAGGAGCTCACAGCAACCCACATGAGTTGTCC
and the dummy position file is
AOS-94_S25_L002_R1_001_trimmed_contig_767 5 15 10
AOS-94_S25_L002_R1_001_trimmed_contig_2199 8 19 11
AOS-94_S25_L002_R1_001_trimmed_contig_2585 4 20 18
This is the script I have written and tried
use warnings;
use strict;
# Read in the complete FASTA file:
print "What is the name of the fasta contig file?\n";
my $fasta = <STDIN>;
chomp $fasta;
# Read in file of contig name, start pos, stop pos, SNP pos in tab delimited
text:
print "Name of text file with contig name and SNP position info? \n";
my $text = <STDIN>;
chomp $text;
# Output file
print "What are we calling the output? \n";
my $out= <STDIN>;
chomp $out;
local $/ = "\n>"; #Read by fasta record
my $seq1 = ();
open(FASTA,$fasta) || die "\n Unable to open the file!\n";
open(POS,$text) || die "\n Unable to open the file! \n";
my #fields = <POS>;
while (my $seq = <FASTA>){
chomp $seq;
my #seq = split(/\n/,$seq);
if($seq[0] =~ /^>/){
$seq1 = $seq[0];
}elsif($seq[0] =~ /[^>]/){ #matches any character except the >
$seq1 = ">".$seq[0];
}
for my $pos (#fields){
chomp $pos;
my #field = split(/\t/,$pos);
open(OUTFILE,">>$out");
print OUTFILE "$seq1";
my $subseq = substr $seq[1], $field[1] -1, $field[2] - $field[1];
print OUTFILE "$subseq\n";
}
}
close FASTA;
close POS;
close OUTFILE;
This is what I get out, which is what I sort of want:
>AOS-94_S25_L002_R1_001_trimmed_contig_767
CACACTGATT
>AOS-94_S25_L002_R1_001_trimmed_contig_2199
TTTTCTTTCC
>AOS-94_S25_L002_R1_001_trimmed_contig_2585
AGGAGCTCAC
However, I need to also print out the SNP position (column 4) after the sequence name, e.g.,
>AOS-94_S25_L002_R1_001_trimmed_contig_767
pos=10
CACACTGATT
>AOS-94_S25_L002_R1_001_trimmed_contig_2199
pos=11
TTTTCTTTCC
>AOS-94_S25_L002_R1_001_trimmed_contig_2585
pos=18
AGGAGCTCAC
I tried inserting print OUTFILE "pos= $field[3]\n";after print OUTFILE "$seq1"; and I get the following:
>AOS-94_S25_L002_R1_001_trimmed_contig_767
10
AOS-94_S25_L002_R1_001_trimmed_contig_2199
CACACTGATT
>AOS-94_S25_L002_R1_001_trimmed_contig_2199
10
AOS-94_S25_L002_R1_001_trimmed_contig_2199
TTTTCTTTCC
>AOS-94_S25_L002_R1_001_trimmed_contig_2585
10
AOS-94_S25_L002_R1_001_trimmed_contig_2199
AGGAGCTCAC
Obviously I have messed up my loops, and probably some chomp commands.
For instance, when I print "$seq1" to a file, why does it not need a "\n" included in the printed string? There must already be a hard return in the string?
I know I am missing some basics of how this is structured, but I so far can't figure out how to fix my mistakes. Can anyone provide any suggestions?
Update
Perl code reformatted for legibility
use warnings;
use strict;
# Read in the complete FASTA file:
print "What is the name of the fasta contig file?\n";
my $fasta = <STDIN>;
chomp $fasta;
# Read in file of contig name, start pos, stop pos, SNP pos in tab delimited
text:
print "Name of text file with contig name and SNP position info? \n";
my $text = <STDIN>;
chomp $text;
#Output file
print "What are we calling the output? \n";
my $out = <STDIN>;
chomp $out;
local $/ = "\n>"; # Read by FASTA record
my $seq1 = ();
open( FASTA, $fasta ) || die "\n Unable to open the file!\n";
open( POS, $text ) || die "\n Unable to open the file! \n";
my #fields = <POS>;
while ( my $seq = <FASTA> ) {
chomp $seq;
my #seq = split( /\n/, $seq );
if ( $seq[0] =~ /^>/ ) {
$seq1 = $seq[0];
}
elsif ( $seq[0] =~ /[^>]/ ) { # matches any character except the >
$seq1 = ">" . $seq[0];
}
for my $pos ( #fields ) {
chomp $pos;
my #field = split( /\t/, $pos );
open( OUTFILE, ">>$out" );
print OUTFILE "$seq1";
my $subseq = substr $seq[1], $field[1] - 1, $field[2] - $field[1];
print OUTFILE "$subseq\n";
}
}
close FASTA;
close POS;
close OUTFILE;

Answer 1

There are many problems with your code
Your comments don't correspond to the code. For instance, you have Read in the complete FASTA file when the code just accepts the file name from STDIN and trims it. It is usually best to write clean code with well-chosen identifiers; that way the program explains itself
You are using the two-parameter form of open and global file handles. You also don't have the reason for failure in the die string, and you have a newline at the end, which will prevent Perl from giving you the source file name and line number where the error occurred
Something like
open( FASTA, $fasta ) || die "\n Unable to open the file!\n"
should be
open my $fasta_fh, '<', $fasta_file or die qq{Unable to open "$fasta_file" for input: $!}
and
open( OUTFILE, ">>$out" );
should be
open my $out_fh, '>>', $output_file or die qq{Unable to open "$output_file" for appending: $!}
You should avoid putting quotes around variable names.
print OUTFILE "$seq1"
should be
print OUTFILE $seq1
You set the input record separator to "\n>". That means that every time you call <FASTA> Perl will read up to the next occurrence of that string. It also means that chomp will remove exactly that string from the end of the line, if it is there
The biggest problem is that you never reset $/ before reading from POS. Remember that its setting affects every readline (or <>) and every chomp. And because your $text file probably contains no > characters at the start of a line, you will read the entire file in one go
That is why you are seeing newlines in your output without asking for them. You have read the whole file, together with all embedded newlines, and chomp is useless here because you have modified the string that it removes
local is named that way for a reason. It alters the value temporarily and locally to the current scope. But your "current scope" is the entirety of the rest of the file and you are reading both files with the modified terminator
Use some braces { ... } to limit the scope of the local modification. Alternatively, because file handles in more recent versions of Perl behave as IO::Handle objects, you can write
$fasta_fh->input_record_separator("\n>")
and the change will apply only to that file handle, and there is no need to localise $/ at all
Here's an amended version of your program which also addresses some poor choices of identifier as well as a few other things. Please note that this code is untested. I am working on the train at present and can only check what I'm writing mentally
Note that things like while ( <$fasta_fh> ) and for ( #pos_records ) use the default variable $_ when no loop variable is specified. Likewise, operators like chomp and split will apply to $_ when the corresponding parameter is missing. That way there is never any need to mention any variable explicitly, and it leads to more concise and readable code. $_ is equivalent to it in the English language
I encourage you to understand what the things you're writing actually do. It is becoming common practice to copy code from one part of the internet and offer it to some kind souls elsewhere to get it working for you. That isn't "learning to program", and you will not understand anything unless you study the language and put your mind to it
And please take more care with laying out your code. I hope you can see that the edit I made to your question, and the code in my solution, is more more comfortable to read than the program that you posted? While you're welcome to make your own job as awkward as you like, it's unfair and impolite to offer a mess like that to a world of total strangers whom you're asking for free programming help. A nice middle line is to alter your editor to use an indent of four spaces when the tab key is pressed. Never use tab characters in source code!
use strict;
use warnings 'all';
print "Name of the FASTA contig file: ";
chomp( my $fasta_file = <STDIN> );
print "Name file with SNP position info: ";
chomp( my $pos_file = <STDIN> );
print "Name of the output file: ";
chomp( my $out_file = <STDIN> );
open my $out_fh, '>', $out_file die qq{Unable to open "$out_file" for output: $!};
my #pos_records = do {
open $pos_, '<', $pos_file or die qq{Unable to open "$pos_file" for input: $!};
<$pos_fh>;
};
chomp #pos_records; # Remove all newlines
{
open my $fasta_fh, '<', $fasta_file or die qq{Unable to open "$fasta_file" for input: $!};
local $/ = "\n>"; # Reading FASTA format now
while ( <$fasta_fh> ) {
chomp; # Remove "">\n" from the end
my ( $header, $seq ) = split /\n/; # Separate the two lines
$header =~ s/^>?/>/; # Replace any chomped >
for ( #pos_records ) {
my ( $name, $beg, $end, $pos ) = split /\t/;
my $subseq = substr $seq, $beg-1, $end-$beg;
print $out_fh "$header\n";
print $out_fh "pos=$pos\n";
print $out_fh "$subseq\n";
}
}
} # local $/ expires here
close $out_fh or die $!;

Answer 2

Okay, with a couple very minor edits, your code worked perfectly. This is the solution that worked for me:
#!/usr/bin/perl
use strict;
use warnings;
print "Name of the FASTA contig file: ";
chomp( my $fasta_file = <STDIN> );
print "Name file with SNP position info: ";
chomp( my $pos_file = <STDIN> );
print "Name of the output file: ";
chomp( my $out_file = <STDIN> );
open my $out_fh, '>', $out_file or die qq{Unable to open "out_file" for output: $!};
my #pos_records = do {
open my $pos_, '<' , $pos_file or die qq{Unable to open "$pos_file" for input: $!};
<$pos_>;
};
chomp #pos_records; #remove all newlines
{
open my $fasta_fh, '<', $fasta_file or die qq{Unable to open "$fasta_file" for input: $!};
local $/ = "\n>"; #Reading FASTA format now
for ( <$fasta_fh> ) {
chomp; #Remove ">\n" from the end
my ( $header, $seq) = split /\n/; #separate the two lines
$header = ">$header" unless $header =~ /^>/; # Replace any chomped >
for ( #pos_records ) {
my ($name,$beg,$end,$pos) = split /\t/;
my $subseq = substr $seq, $beg-1, $end-$beg;
my $final_SNP = $end - $pos;
if($header =~ /$name/){
print $out_fh "$header\n";
print $out_fh "pos=$final_SNP\n";
print $out_fh "$subseq\n";
}
}
}
} #local expires here
close $out_fh or die $!;
The only substantive thing I changed was the addition of an if statement. Without that, each fasta sequence was being written three times, each one with one with one of the three SNP positions. I also slightly changed what I was doing to notate the SNP position, which after excising the sequence, was actually $end - $pos and not just $pos.
Again, I can't thank you enough, as it is obvious you spent a fair bit of time helping me. For what its worth, I sincerely appreciate it. Your solution will serve as a template for my future efforts (which will likely be similar manipulations of fasta files), and your explanations have helped me to better understand things like what local does in a way that my pea brain can comprehend.