Bracketing Substring(s) in the String

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

Replies are listed 'Best First'.
Re: Bracketing Substring(s) in the String by sgifford (Prior) on Aug 25, 2005 at 16:48 UTC
The problem is that once you've added the brackets, `index` doesn't match anymore. Regular expressions can deal with this more easily. This code allows optional brackets between letters to find the substrings, then it "de-nests" the brackets to get the results you give above. `sub put_bracket { my ($str,$ar) = @_; foreach my $subs ( @$ar ) { # Construct a regexp with [\[\]] between all the letters my $newsub = join('[\[\]]?',split(//,$subs)); $str =~ s/($newsub)/[$1]/g; } # Now de-nest the brackets in the string my $depth = 0; my $newstr = ''; foreach my $c (split(//,$str)) { if ($c eq "\[") { $newstr .= $c if ($depth++ == 0); } elsif ($c eq "\]") { $newstr .= $c if (--$depth == 0); } else { $newstr .= $c; } } print "$newstr\n"; return ; }` [download]	[reply] [d/l] [select]
Re^2: Bracketing Substring(s) in the String by monkfan (Curate) on Oct 28, 2005 at 07:16 UTC
Dear sgifford, First of all I want to apologize for having have to come back to you to ask this question after some time. Since your solution above is so important to me, I need to turn to you for this. I truly don't know how to go about it. I hope you won't mind. Your code above provide 99% correct solutions, except the following case. Example 1: `#Given: my $s5 ='CTGGGTATGGGT'; my @a5 = qw(GTATG TGGGT);` [download] Your code above returns `C[TGGGTATGGGT]` [download] Instead of this the correct one: `CTGG[GTATGGGT]` [download] The explanation is as follows TGGGT occur twice in $s5. `$s5 = "CTGGGTATGGGT"; TGGGT GTATG -- \|--- Only this two satisfy. TGGGT -- Since it follows order and delim of the given array.` [download] Now why the latter is the correct answer. It is because in the array `@a5 = qw(GTATG TGGGT),` the string "TGGGT" comes after "GTATG", thus the bracketed region should also follow the order of the given array and the span delimited also by the array. By that I mean, the bracketed regions -- be it disjointed or overlapped -- should always start with first element of the array and end with the last element of the array. Let me give another examples, hope it clarifies. Read more... (2 kB) I would also need to state that the size length of the string in the array is always fixed. In our examples they are always of length 5. Is there a way I can modify your code above so that it can handle such case? Hope to hear from you again. I'll try not to bother you again after this. Read more... (931 Bytes) Update 2 : I think I've got the solution. Thanks so much sgifford, sorry for the trouble. Read more... (556 Bytes) Regards, Edward	[reply] [d/l] [select]
Re: Bracketing Substring(s) in the String by thundergnat (Deacon) on Aug 25, 2005 at 16:32 UTC
Rather than inserting the brackets as the substrings are found, you could keep track of the indicies of the substrings, filter out interior indicies for overlapping substrings, then insert the brackets at the remaining indicies. Lessee... somthing like... #!/usr/bin/perl -w use strict; my $s1 ='CCCATCTGTCCTTATTTGCTG'; my @a1 = qw(ATCTG ATTTG); my $s2 ='ACCCATCTGTCCTTGGCCAT'; my @a2 = qw(CCATC); my $s3 ='CCACCAGCACCTGTC'; my @a3 = qw(CCACC CCAGC GCACC); my $s4 ='CCCAACACCTGCTGCCT'; my @a4 = qw(CCAAC ACACC); put_bracket($s1,\@a1); put_bracket($s2,\@a2); put_bracket($s3,\@a3); put_bracket($s4,\@a4); sub put_bracket { my ($str,$ar) = @_; my $slen = length $ar->[0]; my @brackets; foreach my $subs ( @$ar ) { my $idx = index($str,$subs); my $bgn = $idx; my $end = $idx + $slen + 1; push @brackets, ($bgn, $end); } my @filtered = $brackets[0]; for (1..$#brackets-1) { push @filtered, $brackets[$_] if ($brackets[$_] < $brackets[$_+1] and $brackets[$_-1] < $brackets[$_]); } push @filtered, $brackets[-1]; while (@filtered) { substr($str, pop @filtered, 0, ']'); substr($str, pop @filtered, 0, '['); } print $str,"\n"; return; } [download] Edit: Note that the above could return some incorrect brackets if all of the substrings are not the same length. It is probably moot though, as I see you assume that all of the substrings are the same length in your original example	[reply] [d/l]
Re: Bracketing Substring(s) in the String by sapnac (Beadle) on Aug 25, 2005 at 17:36 UTC
`map{$s1 =~ s/$_/[$_]/g} @a1; map{$s2 =~ s/$_/[$_]/g} @a2; map{$s3 =~ s/$_/[$_]/g} @a3; map{$s4 =~ s/$_/[$_]/g} @a4; print join("\n",$s1,$s2,$s3,$s4)."\n"; gives; CCC[ATCTG]TCCTT[ATTTG]CTG AC[CCATC]TGTCCTTGGCCAT [CCACC]A[GCACC]TGTC C[CCAAC]ACCTGCTGCCT Is this what you want? If not, Please give what is expected to happen +for the last 2 strings. Hope this helps!` [download]	[reply] [d/l]
Re: Bracketing Substring(s) in the String by anonymized user 468275 (Curate) on Aug 25, 2005 at 15:27 UTC
The code itself is okay, except that that arrays 3 and 4 do not contain a non-overlapping set of substrings of the string they are operating on and will therefore not meet the substitution criteria later in the program. To get the desired result: `my @a3 = qw( CCACCAGCACC ); my @a4 = qw( CCAACACC );` [download] One world, one people	[reply] [d/l]
Re^2: Bracketing Substring(s) in the String by InfiniteSilence (Curate) on Aug 25, 2005 at 16:30 UTC
Take a closer look at the actual original strings. The second two strings match multiple substrings, so the desired output actually shows this, but in a sort-of-confusing way. Take this example: `STRING ------- GCGCTCGACGC SUBSTRINGS ---------- GCGC ACG == [GCGC]TC[ACG]C` [download] But, when we have OVERLAPPING sequences the output should 'mash-up' a bit: `STRING ------- GCGCTCGACGC SUBSTRINGS ---------- GCGC GCTC == [GCGCTC]GACGC` [download] Do you see how GCGC AND GCTC MERGE into one single substring for the desired output? So I think the algorithm should look like this: Make as many straight matches as you can If your match is within a string that has already been matched, modify that match to include the new match Can you imagine how messy this would look if you had 100 substrings and a main string running 10,000 letters long (which I assume is possible because this stuff looks like gene sequence data)? Celebrate Intellectual Diversity	[reply] [d/l] [select]
Re: Bracketing Substring(s) in the String by robertlandrum (Initiate) on Aug 25, 2005 at 22:11 UTC
Not exactly superman code, but it does what you want. sub put_bracket { my $s = shift; my @m = @_; my @indexes = (); for my $match (@m) { my $lm = 0; while(1) { my $i = index($s,$match,$lm); last if($i eq "-1"); push(@indexes,$i..($i+length($match)-1)); $lm = $i+1; } } my %tmp = map { $_ => 1 } @indexes; my @s = sort {$a <=> $b} keys %tmp; my $n = ''; my @chars = split(//,$s); my $marked = 0; for my $i (0..$#chars) { if($marked && $i == $s[0]) { shift @s; } elsif($i == $s[0]) { $n .= "["; shift @s; $marked = 1; } elsif($marked) { $n .= "]"; $marked = 0; } $n .= $chars[$i]; } return $n; } [download]	[reply] [d/l]
Re: Bracketing Substring(s) in the String by Anonymous Monk on Aug 25, 2005 at 22:12 UTC
`$ perl -le' my @x = ( [ q/CCCATCTGTCCTTATTTGCTG/, [ qw(ATCTG ATTTG) ] ], [ q/ACCCATCTGTCCTTGGCCAT/, [ qw(CCATC) ] ], [ q/CCACCAGCACCTGTC/, [ qw(CCACC CCAGC GCACC) ] ], [ q/CCCAACACCTGCTGCCT/, [ qw(CCAAC ACACC) ] ], ); for ( @x ) { my $str = $_->[0]; for my $subs ( @{ $_->[1] } ) { ( $regex = $subs ) =~ s/(.)(?=.)/$1\[][]?/g; $str =~ s{($regex)}{ ( $1 =~ /]/ ? "" : "[" ) . "$subs]" }eg; } print $str; } ' CCC[ATCTG]TCCTT[ATTTG]CTG AC[CCATC]TGTCCTTGGCCAT [CCACCAGCACC]TGTC C[CCAACACC]TGCTGCCT` [download]	[reply] [d/l]
Re: Bracketing Substring(s) in the String by fizbin (Chaplain) on Aug 26, 2005 at 16:07 UTC
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]	[reply] [d/l] [select]