Match and Extract String with Regex

[monkfan]

Dear fellow monks,
I have these two strings:

my $str1 = 'AT1G71260';
my $str2 = 'AT1G71260_|_chr1';

How can I extract element of $str2 that match with $str1, such that in the end the extraction just give this as results:

my $results = 'AT1G71260';

Note that these two strings can contain any characters (even whitespace, semicolon(;), etc) and of any lengths.

[ikegami]

Are you asking to find the Longest Common Subsequence (LCS) of the strings? Searching for that should reveal nodes on the topic.

Or if all you want to do is check if $str1 is in $str2, then index will do the trick.

if (index($str2, $str1) >= 0) {
   ...
}

[erroneousBollock]

Searching for (Longest Common Subsequence) should reveal nodes on the topic.

... only if they understand how/why Longest Common Subsequence is a generalisation of Longest Common Substring.

While it's an interesting area in which to educate oneself, String::LCSS does exactly what you need.

-David

[lima1]

String::LCSS does exactly what you need.

I don't want to bash String::LCSS, but the implementation seems to be the naive O(n^3) algorithm instead of the O(mn) dynamic programming solution (http://en.wikipedia.org/wiki/Longest_common_substring_problem). A quick and dirty (and not thoroughly tested) implementation is much faster (although probably buggy).

sub lcss2 {
    my ($s, $t) = @_; 
    my $z = 0;
    my $m = length $s; 
    my $n = length $t; 
    my @S = (undef, split(//, $s));
    my @T = (undef, split(//, $t));
    my @L; 
    my @ret;
 
    for my $i ( 1 .. $m ) { 
        for my $j ( 1 .. $n ) { 
            if ($S[$i] eq $T[$j]) {
                $L[$i-1][$j-1] ||= 0;  
                $L[$i][$j] = $L[$i-1][$j-1] + 1;
                if ($L[$i][$j] > $z) {
                    $z = $L[$i][$j];
                    @ret = (); 
                }
                if ($L[$i][$j] == $z) {
                    push @ret,substr($s, ($i-$z), $z);
                }
            }
        }
    }   
#    warn Dumper \@L;
    return join '*', @ret;
}

my $s1 = '6'x 200 . 'zyzxx';
my $s2 = '5'x 200 . 'abczyzefg';
my $count = 1;

timethese($count, {
    'String::LCSS' => sub { String::LCSS::lcss( $s1, $s2 ) },
    'dynprog' => sub { lcss2( $s1, $s2 )},
});

Update: Took the opportunity to learn XS and wrote String::LCSS_XS.

[mwah]

If it's only that simple kind of problem that you mentioned (find one string in another string), then Ikegami's solution (index) should suffice. If you need to do that by regex, try:

  ...
  my $str1 = 'AT1G7. +126[0]*';
  my $str2 = 'AT1G7. +126[0]*_|_chr1';
  ...
  (my $results) = $str2 =~ /\Q$str1/g;
  print $results if $results;
  ...

Regards

mwa

[lima1]

If you just want to extract the TAIR id, you could use this regex:

my ($tair_id) = $str2 =~ /(AT\dG\d{5})/i;

If you want to fetch the alternative splice form suffixes as well (e.g. AT1G71260.1), you could use:

my ($tair_id) = $str2 =~ /(AT\dG\d{5}(?:\.\d+)?)/i;