Re: Bracketing Substring(s) in the String

The code posted so far has relied on doing one substitution at a time, modifying substitutions so that they can handle internal brackets.

I'd like to propose a different approach, but it relies on one feature of the problem that you haven't made explicit: that all the strings you're dealing with, and all the substrings, are uppercase letters only. If so, then what we can do is make each match case-insensitive and lowercase any region that's found to match. Then, simply place brackets at uppercase/lowercase boundaries, and we're set:

sub put_bracket
{
    my    ($str,$ar)    = @_;

    foreach my $subs ( @$ar  )
    {
      my $lsub = lc($subs);
      s/$lsub/$lsub/ig;
    }
    # add brackets
    $str =~ s/(?:(?<=[A-Z])|^)(?=[a-z])/[/g;
    $str =~ s/(?<=[a-z])(?:(?=[A-Z])|$)/]/g;
    # re-uppercase
    $str = uc($str);
    print "$str\n";
    return ;
}
[download]

And this passes all four of your test cases.

But wait! Here's a test case that this code - and all the other code posted to this thread that I've tried - fails on:

my $s5 ='CCACCACCACCTGTC';        my @a5 = qw(CCACC);
put_bracket($s5,\@a5);            # should be [CCACCACCACC]TGTC
[download]

Oh dear, we didn't account for the case when the same substring overlaps itself. How are we going to handle this? Fortunately, it's not impossible. What we need to have happen is basically "repeat the substitution, but don't change anything already all in lowercase, until no changes are made". Fortunately, perl's got a syntax for that:

sub put_bracket
{
    my    ($str,$ar)    = @_;

    foreach my $subs ( @$ar  )
    {
      my $lsub = lc($subs);
      do {} while ($str =~ s/(?!$lsub)(?i:$lsub)/$lsub/g);
    }
    # add brackets
    $str =~ s/(?:(?<=[A-Z])|^)(?=[a-z])/[/g;
    $str =~ s/(?<=[a-z])(?:(?=[A-Z])|$)/]/g;
    # re-uppercase
    $str = uc($str);
    print "$str\n";
    return ;
}
[download]

That new line says:

Repeat as many times as successful:
- Look for a spot not followed exactly by $lsub, followed by $lsub in some case. (in other words, it finds $lsub not all in lowercase)
- Replace this by (all lowercase) $lsub.

--
@/=map{[/./g]}qw/.h_nJ Xapou cets krht ele_ r_ra/;
map{y/X_/\n /;print}map{pop@$_}@/for@/
[download]

Comment on Re: Bracketing Substring(s) in the String Select or Download Code