54
$\begingroup$

I'm trying to develop a way of comparing two sequences (probably originally text, such as text writing or source code, possibly converted to lists). As a familiar example, consider the revisions display for any typical SE question or the diff output from a command-line diff.

I found a cool Mathematica function called SequenceAlignment which looks promising:

text1 = ExampleData[{"Text", "ToBeOrNotToBe"}];
text2 = StringReplace[text1, {"s" -> "th"}]

(* 
To be, or not to be,--that ith the quethtion:-- Whether 'tith nobler
in the mind to thuffer The thlingth and arrowth of outrageouth 
fortune Or to take armth againtht a thea of troubleth, And by 
oppothing end them? ...
*)

(lisp programming... :)

Now:

sa = SequenceAlignment[text1, text2]

gives:

{"To be, or not to be,--that i", {"s", "th"}, " the que", {"s", "th"}, 
"tion:-- Whether 'ti", {"s", "th"}, " nobler in the mind to ", {"s", "th"},
"uffer " ...

which I want to convert to some kind of colored display. The best I've managed so far is this:

 Reap[
  If[Length[#] == 2,  
     Sow[Column[{Style[#[[1]], Red], Style[#[[2]], Green]}]],  
     Sow[Style[#, Black]]]
     & /@
  sa]

but it's not a pretty display:

my attempt

How can I make this display look like a single piece of text with colored markup, like the SE revisions display? And would it be possible to process Mathematica code as well - without evaluating said code first, obviously?

$\endgroup$
5
  • 1
    $\begingroup$ A nice question for a graphical designer. A best fit for this site could be: "I want the output like this. How to do it in Mma?" $\endgroup$ Oct 19, 2012 at 12:07
  • $\begingroup$ @belisarius I've focussed the question a bit more. I don't know how to get from the information in sa to a text display. And I don't know whether SequenceAlignment is the right tool for the job... $\endgroup$
    – cormullion
    Oct 19, 2012 at 12:12
  • $\begingroup$ Ok, +1 then. Nice question $\endgroup$ Oct 19, 2012 at 12:15
  • $\begingroup$ Your approach might encounter a problem in some cases, try to use text2 = StringReplace[text1, {"s" -> "ss"}] and see how your output looks like. $\endgroup$
    – VLC
    Oct 19, 2012 at 12:19
  • $\begingroup$ @VLC yes, it's not good so far :) $\endgroup$
    – cormullion
    Oct 19, 2012 at 12:23

3 Answers 3

25
$\begingroup$

Here's a start (perhaps it's better to say continuation since you've already gotten started):

Row@Flatten[sa /. {a_, b_} :> { Style[a, Red], "(", Style[b, Green], ")"}]

syntax

By capturing the word fragmentth to the left and right of a, you thhould be able to end up with thomething more like:

enter image description here

$\endgroup$
1
  • $\begingroup$ Yeth, that's exthellent! $\endgroup$
    – cormullion
    Oct 20, 2012 at 7:31
46
$\begingroup$

The undocumented System`Dump`showStringDiff function neatly does the diff and highlights it for you. The simplest usage is:

System`Dump`showStringDiff[text1, text2]

diff

You can choose custom colours for the highlights with the Styles option. You can also change the background, font weight, add a strikethrough, etc.:

System`Dump`showStringDiff[text1, text2, Styles -> {
    {Bold, Background -> LightGreen, Darker@Green}, 
    {FontVariations -> {"StrikeThrough" -> True}, Background -> LightRed, Darker@Red}
}]

styled diff

A related undocumented function System`Dump`showStringDiffs takes the same arguments and options, but returns a list of two strings with the deletions marked in one and the additions in the other.

Mathematica graphics

$\endgroup$
4
  • 13
    $\begingroup$ How did you find this?! +1 $\endgroup$
    – Mr.Wizard
    Oct 19, 2012 at 15:10
  • $\begingroup$ More great hidden functionality! The problem is this has the same problem with wrapping across lines that most of the methods have $\endgroup$ Oct 19, 2012 at 15:10
  • 4
    $\begingroup$ What are you doing on your free time? ... no, wait, don't answer. $\endgroup$ Oct 19, 2012 at 15:37
  • 1
    $\begingroup$ Good find - a pretty cool option hidden away. I wonder why it's been included at all if no-one knows about it... $\endgroup$
    – cormullion
    Oct 20, 2012 at 7:29
16
$\begingroup$

Using How to join two Style[]d strings, we can get a decent looking display on the the test case

Flatten[Map[If[Length[#] == 2, {Style[#[[1]], Red, FontVariations -> {"StrikeThrough" -> True}], Style[#[[2]], Green]}, #] &, sa]];
Apply[StringJoin, ToString[#, StandardForm] & /@ %]

enter image description here

Note that with this method text correctly wraps across lines

Update

Using background to do the highlighting doesn't work well since you can't control the background size the default way. How to pad Background size in Style calls is an attempt to do text highlighting, but doesn't work well in this case because of text wrapping issues:

Flatten[Map[
     If[Length[#] == 2, 
          {Framed[Style[#[[1]], FontVariations -> {"StrikeThrough" -> True}],FrameStyle -> None, FrameMargins -> 2, Background -> Lighter@Red], 
          Framed[#[[2]], FrameStyle -> None, FrameMargins -> 2, Background -> Lighter@Green]}, 
          Framed[#, FrameStyle -> None, FrameMargins -> 2]] &, sa]];
Apply[StringJoin, ToString[#, StandardForm] & /@ %]

enter image description here

$\endgroup$
1
  • $\begingroup$ Like it. Good attempt on background colouring too. $\endgroup$
    – cormullion
    Oct 20, 2012 at 7:34

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.