Whether this will prove more efficient is speculative, but as the entire record is parsed in a single call to the regex engine, I think ought to be. It requires 5.8 because of the use of $^N which wasn't available before.
I haven't wrapped it up as a function, I'm putting the gathered statistics into the hash for later processing and I've guessed as to where comment cards are possible, probably incorrectly.
The sequence of regexes may look scarry, but they really aren't if you take the time to look at them and understand what they are doing. Many here are only too willing to explain anything that you don't follow, including myself. I could have littered the regexes with comments, but that just seems to make them look more complicated (to me).
The essence of the technique used here is to follow each capture group with a {?{ $var .= $^N }) code block, to assign or append the captured data as the regex progresses. This greatly simplifies the situation where you have optional capture groups in the regex, which means that you are never sure which part has been captured into which $n variable.
#! perl -slw use strict; require 5.008; use Data::Dumper; use re 'eval'; my $re_comment = qr[^ \# ( \s* [^\n]+ )(?{ $c->{comment} .= $^N; })]x; my $re_stats = qr[^ \s+ ( \d+ [^\n]+ ) \n]x; my $re_seq = qr[^ Sbjct: \s+ ( [^ ]+ ) \s+ \d+ \n]x; my $re_bang = qr[^ \s* ! \s* \n]x; my $re_pair = qr[ $re_seq (?{ $c->{left_instance} .= $^N; }) (?:$re_bang)? $re_seq (?{ $c->{right_instance} .= $^N; }) $re_comment? \n ]x; my $re_record= qr[ $re_stats (?{ $c->{stats} .= $^N }) (?: $re_pair )+ ]x; local $/ = "\n\n\n"; while( <DATA> ) { our $c = {}; print m[$re_record]mo ? Dumper $c : 'Failed to match'; } __DATA__ 140 8778 333 D 140 8778 334 -7 3.60e-56 -259 95.00 Sbjct: AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA 39 +3 ! Sbjct: -AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA 39 +4 Sbjct: AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAGGGGGGGGGCCTT 45 +3 Sbjct: AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAGGGGGGGGGCCTT 45 +4 Sbjct: TTAAAATTCCCCCC-GGGGGG 474 ! Sbjct: TTAAAATTCCCCCCGGGGGGG 475 140 8778 333 D 140 8778 334 -7 3.60e-56 -259 95.00 Sbjct: AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA 39 +3 ! Sbjct: -AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA 39 +4 # some comment Sbjct: AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAGGGGGGGGGCCTT 45 +3 Sbjct: AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAGGGGGGGGGCCTT 45 +4 # some more comment Sbjct: TTAAAATTCCCCCC-GGGGGG 474 ! Sbjct: TTAAAATTCCCCCCGGGGGGG 475 140 8778 333 D 140 8778 334 -7 3.60e-56 -259 95.00 Sbjct: AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA 39 +3 ! Sbjct: -AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA 39 +4 Sbjct: AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAGGGGGGGGGCCTT 45 +3 Sbjct: AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAGGGGGGGGGCCTT 45 +4 Sbjct: TTAAAATTCCCCCC-GGGGGG 474 ! Sbjct: TTAAAATTCCCCCCGGGGGGG 475
Ouput
D:\Perl\test>254442 $VAR1 = { 'right_instance' => '-AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA +AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAG +GGGGGGGGCCTTTTAAAATTCCCCCCGGGGGGG', 'stats' => '140 8778 333 D 140 8778 334 -7 3.60e-56 -259 95. +00', 'left_instance' => 'AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA +AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAGG +GGGGGGGCCTTTTAAAATTCCCCCC-GGGGGG' }; $VAR1 = { 'comment' => ' some comment some more comment', 'right_instance' => '-AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA +AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAG +GGGGGGGGCCTTTTAAAATTCCCCCCGGGGGGG', 'stats' => '140 8778 333 D 140 8778 334 -7 3.60e-56 -259 95. +00', 'left_instance' => 'AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA +AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAGG +GGGGGGGCCTTTTAAAATTCCCCCC-GGGGGG' }; $VAR1 = { 'right_instance' => '-AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA +AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAG +GGGGGGGGCCTTTTAAAATTCCCCCCGGGGGGG', 'stats' => '140 8778 333 D 140 8778 334 -7 3.60e-56 -259 95. +00', 'left_instance' => 'AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA +AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAGG +GGGGGGGCCTTTTAAAATTCCCCCC-GGGGGG' };
In reply to Re: More efficient?
by BrowserUk
in thread Improve code to parse genetic record
by Anonymous Monk
| For: | Use: | ||
| & | & | ||
| < | < | ||
| > | > | ||
| [ | [ | ||
| ] | ] |