# Highlighting or coloring certain words / substrings appearing in a larger string

I have one longer string, longString, and a set $S$ of shorter strings {ss1,ss2,ss3,...}. I'd like to print out longString but where the positions of the shorter strings are indicated in some nice way. For example, perhaps we could color the characters in the longer string with a specific specified color for each shorter string. I.e. where would would have an array like {{ss1,'Red'},{ss2,'Green'},{ss3,'Blue'},...} and would then color words appearing in longString Red if the word is ss1, Blue if the word is ss2, and so forth. The idea would be to shade Brown / etc. overlap regions if they occur.

Is this possible?

One can use StringPosition to return the first and last character position for a set of substrings or words appearing in a larger string, for example:

StringPosition["TheBrownFox", {"Brown","Fox"}]

out: {{4, 8}, {9, 11}}


Now, one of the more interesting parts of this question, IMO, is how we handle overlaps between substrings / words (i.e. ss1, ss2, ss3, etc.). For example, if we add the nonsense word "wnFo" to the previous example, we have overlapping words:

testString = TheBrownFox;
StringPosition[testString, {"Brown","Fox","wnFo"}]

out: {{4, 8}, {7, 10}, {9, 11}}


So we need to do a kind of "surgery" on the output list for StringPosition s.t. there is never a situation where we have {..., {integerOne, intTwo}, {intThree, intFour}, ...} where it is NOT the case that intOne < intTwo < intThree < intFour.

Update: Please see Kuba's very slick answer to my question concerning how one might do this: Identifying and isolating sections of overlap in a set of integer intervals

I am inspired by this example https://reference.wolfram.com/mathematica/example/HighlightWordsOfAGivenLength.html where words of a certain length are highlighted and bolded.

-
– Kuba Apr 1 '14 at 8:30
Second that link - very slick methods presented in Kuba's answer. – ciao Apr 1 '14 at 8:32
@rasher Yeah, I'm going through it now! – Bob2Alice Apr 1 '14 at 8:34
@Kuba I really like your mark function - is there a good way to kind of map it over a large number of instances in the format given by StringPosition? What happens if there is a collision where two words specifying different colors overlap? – Bob2Alice Apr 1 '14 at 8:37
As I think the handling of overlaps is the demanding part of your question I'd suggest to make an example with overlaps to provide a good test case for that... – Albert Retey Apr 1 '14 at 8:45

Using the code for mark, from linked question:

f[string_, cases_] := Module[{pos, agg, res},

pos = StringPosition[string, cases];

agg = {Switch[#[[ 1, 2]], 1, Blue, 2, Brown, _, Red],
#[[ ;; , {1}]]
} & /@ GatherBy[Tally@Flatten[Range @@@ pos], Last];

mark[string, agg]
]

f["TheBrownFox", {"TheBrown", "BrownFox"}]
f["TheBrownFox", {"The", "Fox"}]
f["TheBrownFox", {"The", "eBrownF", "eBrownFox"}]


Detecting overlaps is based on my code from Identifying sections of overlaps in a set of integer intervals

-
Shouldn't this already handle any situation where there is an overlap between two or more of the substrings? – Bob2Alice Apr 1 '14 at 10:07
I see, so you were talking about assigning a different color if we have somwething like: f["TheBrownFox", {"The", "eBrownF", "eBrownFox"}] – Bob2Alice Apr 1 '14 at 10:11
That's really great. I also noticed that you can take the coloration specification, like Blue and write {Large,Blue} or {Bold, Blue}, which is quite nice. – Bob2Alice Apr 1 '14 at 10:17
@Bob2Alice p.s. It is good to hold on with an accpet a day or two. Accept may discorage others, and there could be better ideas :) Yes, it's nice ;P – Kuba Apr 1 '14 at 10:18
Ok, I'm reluctantly unaccept, lol. If you wouldn't mind, could you add a brief descriptor for your algorithm for detecting the overlap? I'd just like to make sure I understand. – Bob2Alice Apr 1 '14 at 10:21

Here is another way to achieve what you want. It is neither very elegant nor very efficient, but should do what I think you try to achieve:

highlight[text_String, rules_List] :=
Module[{positions, overlap = Underlined},

positions = SortBy[
Flatten[Thread[StringPosition[text, #1] -> #2] & @@@ rules, 1],
First
];

positions = positions //. {
{h___, {s1_, e1_} -> c1_, {s2_, e2_} -> c2_, t___} /;
s2 <= e1 :> {
h,
{s1, Min[e1, s2] - 1} -> c1,
{Min[e1, s2], Max[e1, s2]} -> overlap,
If[e2 >= Max[e1, s2]+1, {Max[e1, s2]+1, e2} -> c2,Unevaluated[Sequence[]]],
t
}
};

StringReplacePart[text,
ToString[Style[StringTake[text, #1], #2], StandardForm] & @@@ positions,
positions[[All, 1]]
]
];

highlight[
"The brown, brown fox with overlapping matches...",
{"brown" -> Brown, "fox" -> Red, "app" -> Gray, "lap" -> Orange, "erlapp" -> Green}
]


The "difficult" part with the overlapping strings I tried to solve with a potentially inefficient pattern matching construct in a ReplaceRepeated (//.). Overlaps are unerlined in the above code but you could of course change that. If efficiency does matter or my approach turns out too be to naive you could try to combine my function with a smarter way to handle these overlaps...

-