55
$\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?

Improve this question
$\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$ Commented 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$ Commented Oct 19, 2012 at 12:12
  • $\begingroup$ Ok, +1 then. Nice question $\endgroup$ Commented 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$ Commented Oct 19, 2012 at 12:19
  • $\begingroup$ @VLC yes, it's not good so far :) $\endgroup$ Commented Oct 19, 2012 at 12:23

4 Answers 4

Reset to default
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

Improve this answer
$\endgroup$
1
  • $\begingroup$ Yeth, that's exthellent! $\endgroup$ Commented 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

Improve this answer
$\endgroup$
4
  • 13
    $\begingroup$ How did you find this?! +1 $\endgroup$ Commented 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$ Commented Oct 19, 2012 at 15:10
  • 4
    $\begingroup$ What are you doing on your free time? ... no, wait, don't answer. $\endgroup$ Commented 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$ Commented 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

Improve this answer
$\endgroup$
1
  • $\begingroup$ Like it. Good attempt on background colouring too. $\endgroup$ Commented Oct 20, 2012 at 7:34
1
$\begingroup$

In version 14.1, there is a new function called Diff, which you can use to compare two strings:

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

enter image description here

There are different diff views, you can change the DiffGranularity and DiffStyle, compare whole notebooks and more.

Improve this answer
$\endgroup$

Start asking to get answers

Find the answer to your question by asking.

Ask question

Explore related questions

See similar questions with these tags.