Beefy Boxes and Bandwidth Generously Provided by pair Networks
Pathologically Eclectic Rubbish Lister
 
PerlMonks  

Conditionally Substituting multi-line string with single string

by Osiris1975 (Novice)
on Jan 15, 2009 at 20:43 UTC ( [id://736666]=perlquestion: print w/replies, xml ) Need Help??

Osiris1975 has asked for the wisdom of the Perl Monks concerning the following question:

Dear Wise Monks,

SHORT VERSION

How would you write a regex for a conditional statement that searches for a string of the same character (N) that stretches across multiple lines and then replaces this multi -line block of Ns with something else?

LONG VERSION

I am trying to write a program that reads an input file formatted as follows:
>scaffold00001 TGACCAGCGTTACATGTCAACGTTTTTTTAAACATTGAATATTTATTCATCTGTTCTCGA CGTCGCACATTGTGCAAGCCATCAACTTGATCTAATTAAGTATATCCGCTAAAGATCAGC GCCTTTTGTTTTGACAACAACAAGTATCATACCAGCACTTTAACGATGTAGTCAATAAAA NNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNN NNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNN NNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNN TGTCTGCTTCCGTTGATACCTGCGCGAGCCGGTCGTCACGATTCGGTACCTTGCCGTCAA TCAAAAAATGGCAATGATGATCCAACAATGGGACTTGGTCGACAAACTCAGATAAGTCGT CCAAAATACTTCCTCCTTCACACGTTTGCTGGTGCAATGACCAGCCCACGTTTTCCTAGA >scaffold00002 ATTCATGTTGCTCGTCGTCACCTGACCGAGCAGGGCCAGAACCGGGACATGATCCATTTT GGCATCATACAAACCATTTAATAGATGAATGGCGCCAGGGCCGCCAATGGAGAGACAAAC ACCCAAACCGCCTGTTAACTTAGCAGTTGCCGCTGCGGACAAAGCGGCGACTTCCTCATG NNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNN NNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNN CAACTGCTCTTAGTGTGATCTCATTTATCAAAGAGATCAGACTTTGTGAATTCAGATTTT TTCAAGCCATACAACAACTAACCCAATTTAAGAAATACCCACTTATTGCGATTTGCTTTT CTATTAGTTAGCATTTTAAATTGTGAAACGTGCCACTTATAAACAAATTTCCGTCTTCTT
The script should then replace the lines that do not contain a G, A , T or C with a string that exits only on one line. The code I have so far is as follows:
#!/util/bin/perl use strict; use warnings; use File::Copy; ################# #-----Declaration of Arguements-----# my $fasta=$ARGV[0] || die ("Please provide a 454Scaffolds.fna fasta fi +le to parse.\n"); # Argument accepts scaffold fasta file. my $tempfasta="temp.fasta"; my $workingfasta="working.fasta"; my $scaffold; + # Initializing $scaffold globally. my $enumerator; + # Initializing $enumerator globally. #----Main Program-----# copy($fasta, $tempfasta) or die "Could not copy $fasta to $workingfast +a."; open (FILE,"<temp.fasta") || die ("Could not open fasta file!\n"); # O +pen & read fasta file open (WORKFILE,">>working.fasta"); while (my $fastaline=<FILE>) { if($fastaline=~ m/^>/) + # IF first character in line is > assign line to $fastaline then... { my $scaffold_header=$fastaline; + # set $scaffold_header to $fastaline then... $scaffold_header=~ /(>)(\S*)(\s*)(\S*)/; + # divide $ scaffold header components then... $scaffold= $2; + # assign component $2 to $scaffold then... print WORKFILE ">" . "$scaffold" . ".1\n"; + # print $scaffold to screen and start new line. $enumerator=1; } elsif ($fastaline!~ m/G/ and $fastaline!~ m/A/ and $fastaline!~ m/T +/ and $fastaline!~ m/C/) { $enumerator++; print WORKFILE (">" . "$scaffold" . ".$enumerator\n"); } else { print WORKFILE $fastaline; } }; close (FILE); close (WORKFILE);
So, the output I get with this code as is, is close to what I want but not exactly so. This is what the output looks like now:
>scaffold00001.1 TGACCAGCGTTACATGTCAACGTTTTTTTAAACATTGAATATTTATTCATCTGTTCTCGA CGTCGCACATTGTGCAAGCCATCAACTTGATCTAATTAAGTATATCCGCTAAAGATCAGC GCCTTTTGTTTTGACAACAACAAGTATCATACCAGCACTTTAACGATGTAGTCAATAAAA >scaffold00001.2 >scaffold00001.3 >scaffold00001.4 TGTCTGCTTCCGTTGATACCTGCGCGAGCCGGTCGTCACGATTCGGTACCTTGCCGTCAA TCAAAAAATGGCAATGATGATCCAACAATGGGACTTGGTCGACAAACTCAGATAAGTCGT CCAAAATACTTCCTCCTTCACACGTTTGCTGGTGCAATGACCAGCCCACGTTTTCCTAGA >scaffold00002.1 ATTCATGTTGCTCGTCGTCACCTGACCGAGCAGGGCCAGAACCGGGACATGATCCATTTT GGCATCATACAAACCATTTAATAGATGAATGGCGCCAGGGCCGCCAATGGAGAGACAAAC ACCCAAACCGCCTGTTAACTTAGCAGTTGCCGCTGCGGACAAAGCGGCGACTTCCTCATG >scaffold00002.2 >scaffold00002.3 CAACTGCTCTTAGTGTGATCTCATTTATCAAAGAGATCAGACTTTGTGAATTCAGATTTT TTCAAGCCATACAACAACTAACCCAATTTAAGAAATACCCACTTATTGCGATTTGCTTTT CTATTAGTTAGCATTTTAAATTGTGAAACGTGCCACTTATAAACAAATTTCCGTCTTCTT
And this is how I WANT the output to look like:
>scaffold00001.1 TGACCAGCGTTACATGTCAACGTTTTTTTAAACATTGAATATTTATTCATCTGTTCTCGA CGTCGCACATTGTGCAAGCCATCAACTTGATCTAATTAAGTATATCCGCTAAAGATCAGC GCCTTTTGTTTTGACAACAACAAGTATCATACCAGCACTTTAACGATGTAGTCAATAAAA >scaffold00001.2 TGTCTGCTTCCGTTGATACCTGCGCGAGCCGGTCGTCACGATTCGGTACCTTGCCGTCAA TCAAAAAATGGCAATGATGATCCAACAATGGGACTTGGTCGACAAACTCAGATAAGTCGT CCAAAATACTTCCTCCTTCACACGTTTGCTGGTGCAATGACCAGCCCACGTTTTCCTAGA >scaffold00002.1 ATTCATGTTGCTCGTCGTCACCTGACCGAGCAGGGCCAGAACCGGGACATGATCCATTTT GGCATCATACAAACCATTTAATAGATGAATGGCGCCAGGGCCGCCAATGGAGAGACAAAC ACCCAAACCGCCTGTTAACTTAGCAGTTGCCGCTGCGGACAAAGCGGCGACTTCCTCATG >scaffold00002.2 CAACTGCTCTTAGTGTGATCTCATTTATCAAAGAGATCAGACTTTGTGAATTCAGATTTT TTCAAGCCATACAACAACTAACCCAATTTAAGAAATACCCACTTATTGCGATTTGCTTTT CTATTAGTTAGCATTTTAAATTGTGAAACGTGCCACTTATAAACAAATTTCCGTCTTCTT
The problem is that the script is inserting the string I want to replace the Ns with for every line it sees them in, but I want it treat each consecutive line that has the string of N as a single unit. My guess is that I need to replace the:
elsif ($fastaline!~ m/G/ and $fastaline!~ m/A/ and $fastaline!~ m/T/ +and $fastaline!~ m/C/)
With some kind of more complex regular expression. Being that I am new to regex, this is where I am stuck. Any help would be greatly appreciated!

Replies are listed 'Best First'.
Re: Conditionally Substituting multi-line string with single string
by eighty-one (Curate) on Jan 15, 2009 at 21:50 UTC

    I'd approach it differently. For each line, I would check if the line consisted of all N's. If so, set a flag to indicate this, print nothing, and move to the next line

    Repeat until you find a line that is NOT all N's. At that point, print your ">scaffold00002.$something" line, and the process the current line as appropriate.

      Which might be something along the lines of:

      my $flag = 0 ; my $scaffold ; my $enumerator ; while (my $fastaline=<FILE>) { if ($fastaline=~ m/^>(\S*)/) { $scaffold = $1 ; $enumerator = 1 ; $flag = 1 ; } elsif ($fastaline =~ m/[ACGT]/) { if ($flag) { print WORKFILE ">$scaffold.$enumerator\n" ; $enumerator++ ; $flag = 0 ; } ; print WORKFILE $fastaline ; } else { $flag = 1 ; } ; } ;
      NB: this is not checking that the input is well formed: (a) it accepts any line that contains at least one [ACGT] as being a line to keep; (b) it does not check that the lines being dropped are all N; (c) it does not check the exact form of >scaffold lines; (d) it does not check that at least one ACGT line follows each >scaffold line; ... If the input is 100% trusted, that's fine... (if 100% trustworthy input isn't an oxymoron).

Re: Conditionally Substituting multi-line string with single string
by hbm (Hermit) on Jan 16, 2009 at 01:51 UTC
    If your input file isn't too big, you might want to slurp-and-split:
    use strict; use warnings; my @scaffolds; { local $/ = undef; open(IN,"t.txt") or die; @scaffolds = split(/(>scaffold\d+)\n/, <IN>); } close IN; my $i; my $s; foreach (@scaffolds) { if (/^>/) { $s = "$_."; # assemble label for this scaffold $i = 1; # and initialize its counter } else { print map { "$s." . $i++ . "\n" # print incremented label . $_ # and the GACT* stuff } split(/(?:N{4,}\n)+/, $_); # for each entry within the + scaffold } }

    Sorry for changing all the variables on you. And one subtle detail worth noting is the parens in the first split!

    Update:I changed the first split from split(/>scaffold(\d+)/, <IN>); to split(/(>scaffold\d+)\n/, <IN>);. This simplifies the assignment of $s and obviates the stripping of whitespace in map.

Log In?
Username:
Password:

What's my password?
Create A New User
Domain Nodelet?
Node Status?
node history
Node Type: perlquestion [id://736666]
Approved by Corion
help
Chatterbox?
and the web crawler heard nothing...

How do I use this?Last hourOther CB clients
Other Users?
Others meditating upon the Monastery: (2)
As of 2024-04-26 02:52 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    No recent polls found