19
$\begingroup$

I would like to apply Style to strings that are matched, for example, with one or more specified patterns or regular expressions, a string or a list of both, whatever.

I've already written a function that works fine with small text samples, but it is slow and it has problems to export ( a RTF ) correctly, cause a formatting problem.

Highlight[pattern_, style_] := 
 s_String :> (Row[{##}] & @@ 
    StringReplace[s, t : pattern :> style[t], IgnoreCase -> False])

So for example try it with a short text:

txt = Import["http://www.google.com"] // 
   StringReplace[#, {"\t", "\r\n", "\n"} -> ""] &;

txt /. Highlight[RegularExpression["[A-Z][a-z]+"], Style[#, Blue] &]

The output looks like:

string replace with styles

My scenario:

  • Issue 1: the input text is a long string, i.e ~500KB so far.
  • Issue 2: I want to be able send a list of patterns without drastically impacting the runtime or the normal behavior of the kernel. (Right now when I render more than one pattern in a large text sample with the current code, the kernel crashes).
  • Issue 3: It seems that the programming using these pattern replaces are so slow.

Is there a better way to run this pattern matching, or a more efficient approach to find and highlight specific text?

UPDATE: Sharing some kind of my input based on the comments:

txt = ExampleData[{"Text", "AeneidEnglish"}];
somewords = 
  DictionaryLookup[RegularExpression[".*tion"]] // Take[#, 200] &;

In[536]:= AbsoluteTiming[
 txt /. Highlight[somewords, Style[#, Blue] &];]

Out[536]= {7.84513, Null}

Based on a list of words, and RegularExpression for the pattern argument, it seems to be the method is doing the necessary work, so far. Apparently this method is the fastest.

$\endgroup$
19
  • 1
    $\begingroup$ Seen this? $\endgroup$ Oct 30, 2015 at 9:39
  • $\begingroup$ So I tried using your Highlight rule on ExampleData[{"Text", AeneidEnglish"}], which is about 600 kB, and it was pretty fast (~50 ms). However, trying to export the result to RTF took quite a while. Is the issue with the export step? $\endgroup$
    – Pillsy
    Oct 30, 2015 at 10:13
  • $\begingroup$ @J.M. Yes, before asking my function is almost the same like MrWizard's $\endgroup$ Oct 30, 2015 at 13:26
  • $\begingroup$ Yes, my problem here @Pillsy it seems to be the export and in addition if I send a list big enough of strings $\endgroup$ Oct 30, 2015 at 13:27
  • 1
    $\begingroup$ @d555 HTML might be worth a try, then, since Word can import that. $\endgroup$
    – Pillsy
    Oct 30, 2015 at 14:45

3 Answers 3

11
+150
$\begingroup$

There is another way that is on my machine almost 500x faster then your solution. The idea is to look how Mathematica represents colored strings and use this directly.

When we colorize an input string by selecting text and using the Format menu, we can create something like this

Mathematica graphics

Now, press Ctrl+Shift+E to see the underlying expression.

Cell[BoxData["\"\<Hello 
  \!\(\*StyleBox[\"my\",FontColor->RGBColor[1, 0, 0]]\)
  friend\>\""], "Input"]

I have put the important part in the second like and you see, it's only an inline style-box that is used.

In your updated question, you used a list of words to highlight and for this task, there is another approach useful:

  • we create a function that takes a string and returns the same colorized string when it is in your list of words. Otherwise, it just returns the same string
  • we split your input into words and apply this function to each word
  • we rebuild all words into a string again which now contains normal text and highlighted words.

For this purpose, I use a Module that on-the-fly creates local functions that do the highlighting. This is important, because with each call to highlight you might want to provide a different list of words to highlight. Therefore, the function doHighlight needs to be rebuilt on every call.

Sounds expensive? It is not and the implementation is only a few lines long:

highlight[txt_, words_] := Module[{colorize, doHighlight},
  colorize[str_] := "\!\(\*StyleBox[\"" <> str <> 
    "\",FontColor->RGBColor[0, 0, 1]]\)";
  SetAttributes[doHighlight, {Listable}];
  (doHighlight[#] := colorize[#]) & /@ words;
  doHighlight[s_] := s;
  StringRiffle[doHighlight[StringSplit[txt]]]
]

Let's test it

Mathematica graphics

Now let us time this with the same input that Peter Roberge used. His function needed 3.7 seconds on my machine.

txt = ExampleData[{"Text", "AeneidEnglish"}];
somewords = DictionaryLookup[RegularExpression["[A-Z][a-z]+"]];

output = highlight[txt, somewords]; // AbsoluteTiming
(* {0.168501, Null} *)

And the text is highlighted as expected

enter image description here

Since you were brave enough to read until the end, let me tell you that there is one significant drawback: Mathematica has a bug and does not export colored strings to rtf correctly. At least on my machine, the text is not colorized in the final rtf.

Update

In case you really need to replace not a fixed word, but an expression you need to use StringReplace because it is possible you match more than one word (maybe a group of words). Therefore, splitting the text into words won't always work.

Nevertheless, the basic idea of my answer stays the same: We don't use Row and Style, but we inject inline string styles and transform a string into string.

The function itself becomes very easy:

highlight2[txt_, patterns_] := 
 StringReplace[txt, str : (Alternatives @@ patterns) :> 
   "\!\(\*StyleBox[\"" <> str <> "\",FontColor->RGBColor[0, 0, 1]]\)"
]

Here a short test with different kinds of patterns:

highlight2["Hello bear, what are you doing here?", 
  { "b" ~~ LetterCharacter .., 
    _ ~~ "o" ~~ _, 
    RegularExpression["[A-Z][a-z]+"], 
    "re?"
   }]

Mathematica graphics

Update to provide custom style

Providing a custom style is possible too. You can just add this as parameter and the only thing you have to do inside the function is to transform this into a string and put it at the right place.

That being said:

highlight2[txt_, patterns_] := highlight2[txt, patterns, {Blue}];
highlight2[txt_, patterns_, {style__}] := 
 StringReplace[txt, 
  str : (Alternatives @@ patterns) :> 
   "\!\(\*StyleBox[\"" <> str <> "\"," <> 
    StringRiffle[ToString /@ {style}, ", "]
    <> "]\)"]

You can now give a list of style directives as last argument. When you leave them out, then the matching text becomes blue.

highlight2["Hello bear, what are you doing here?", {"b" ~~ 
 LetterCharacter .., _ ~~ "o" ~~ _},
 {30, Red, Italic}]

Mathematica graphics

$\endgroup$
5
  • $\begingroup$ Thanks for wrote this, of course I read it until the end. But, What if I had to send a particular Style? and not just a List of words, a List of RegularExpression as well? And What you mentioned about colorized on RTF, It know that. It seems works only on Windows, so lame, btw, I have *nix. $\endgroup$ Nov 4, 2015 at 5:32
  • $\begingroup$ @d555 I'm on Linux too. Please see my update. You can easily handle patterns too. Hope this helps. Btw, have you noticed that e.g. XML does export those colorized text correctly? It seems a feature of RTF that this doesn't work. $\endgroup$
    – halirutan
    Nov 4, 2015 at 17:04
  • $\begingroup$ @ddd Please see the end of my answer for providing custom style. $\endgroup$
    – halirutan
    Nov 7, 2015 at 7:33
  • $\begingroup$ following the first version, that it supposed to be fast dealing with a list a words... How can i avoid the stringsplit, cause the result text string miss the newline characters by example, and they are important for me. Thanks dude $\endgroup$ Nov 12, 2015 at 22:50
  • $\begingroup$ Note that while for usual words containing only alphabetical characters the construct "\!\(\*StyleBox[\"" <> str <> "\" works, in general we have to use "\!\(\*StyleBox[\"\\\"" <> str <> "\\\"\" as found here. $\endgroup$ Dec 30, 2017 at 5:59
4
$\begingroup$

I really enjoy Mathematica when I can outsource tough algorithmic decisions to their source code- I believe this is the case here.

It appears as if your code is doing something expensive (searching and replacing) many different times.

I propose to do it all at once.

Benchmark:

txt = ExampleData[{"Text", "AeneidEnglish"}];
somewords = DictionaryLookup[RegularExpression["[A-Z][a-z]+"]];
AbsoluteTiming[txt /. Highlight[somewords, Style[#, Blue] &]][[1]]

82.7385

Set up:

txt = ExampleData[{"Text", "AeneidEnglish"}];
somewords = DictionaryLookup[RegularExpression["[A-Z][a-z]+"]];

Generate your rules:

rl = Flatten[# -> Style[#, Blue, Bold]] & /@ somewords;

Put rules on Virgil's Epic:

a = Row[{##}] & @@ StringReplace[txt , rl];

Second benchmark:

AbsoluteTiming[
  rl = Flatten[# -> Style[#, Blue, Bold]] & /@ somewords;
  a = Row[{##}] & @@ StringReplace[txt , rl];][[1]]

2.4377

Export:

Export["a.rtf", a]
$\endgroup$
2
  • $\begingroup$ Thanks, I really like your idea. So using rules and StringReplace I can do it at once. And what do you say about RegularExpression? A list of them? or a mix of strings and regexs? and a custom style? $\endgroup$ Nov 4, 2015 at 5:51
  • 1
    $\begingroup$ Yep- your String / Regex, are under the "Rule" umbrella, so you can mix them (if you want). If you post some examples of the mixed rules we can try them out. $\endgroup$ Nov 4, 2015 at 17:27
2
$\begingroup$
SearchAll[sequence_, search_] := Module[{map},  map = Map[# -> 
  "\!\(\*StyleBox[\"" <> # <> "\",FontColor->" <> 
   ToString@RGBColor[RandomReal[], RandomReal[], RandomReal[]] <> 
   "]\)" & , search];
 StringReplace[sequence, map]]


SearchAll["CGACATCACCGATGGGGAAGATCGGGCTCGCCACTTCGGGCTCATGA", {"CGA", "CATG"}] // Style[#, FontSize -> 20] &

the output can be seen below

$\endgroup$

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service and acknowledge you have read our privacy policy.

Not the answer you're looking for? Browse other questions tagged or ask your own question.