# How to change the color of specified digits in a number?

I've been playing with numerical approximations for irrational numbers, and would find it convenient to be able to highlight where these approximations deviate from the known correct answers. For example, it would be nice to be able to output a number that looks like

where most of the digits have the default Output format, but after a specified number of digits, a different format (bold and red in this example) applies.

What would be the most elegant way to accomplish this?

Another approach:

mark[s_, where_] := With[{n = ToString@s},
Row@{StringDrop[n, -where], Style[StringTake[n, -where], Red]}]


Let's say you want to mark last 3 digits:

mark[N[Pi, 45], 3]


And a little bit more general approach:

mark[s_, w_] := With[{n = ToString@s},
Row@MapAt[Style[#, Bold, Red] &, Characters[n], {w}]]


it can work with Span:

Just for fun, an extension:

mark[number_, spec : {{_, _} ..}] := With[{n = Characters@ToString@number},
Fold[
Function[{x, y}, MapAt[Style[#, y[[ 1]]] &, x, y[[ 2]]]],
n,
spec]] // Row


• @rasher Thanks, I like it too :) I'm going to pose an extension :p – Kuba Jan 20 '14 at 12:06
• Very clean, though the output gets broken between the black and red parts if I use this within Manipulate[]. Is there any solution to that? – Michael Stern Jan 20 '14 at 14:23
• @Kuba for long numbers, Mathematica forces an undesired line break between the black and red parts. – Michael Stern Jan 20 '14 at 14:32
• @MichaelStern Does something like that help? Pane[mark[N[Pi, 145], -3 ;;], {1000}] – Kuba Jan 20 '14 at 14:38

Something like this, if displaying is your primary need:

highlight[num_, where_] :=
StringReplace[ToString[num],
most : (___ ~~ "." ~~ Repeated[_, where]) ~~ rest___ :>
most <> "\!$$\*StyleBox[\"" <> rest <> "\",FontColor->RGBColor[1,0,0],FontSize->18,FontWeight->\"Bold\"]\$$"];

highlight[N[Pi, 20], 10]

(* 3.14... with decimals after 10th red and larger... *)


If you don't know which digits will be incorrect but wish to compare numbers, perhaps this will do.

Enter the correct number, enter the number you wish to test, and find their difference:

correctNumber = N[\[Pi], 20]
testNumber = 3.14159265359999999999
diff = correctNumber - testNumber


You then extract the digits to a List with RealDigits and apply a Style to the digits that are incorrect:

myDigitList =
If[#2 > 1 + Abs@(RealDigits@diff)[[2]], (* Determines the digit where the difference lies *)
Style[#1, Red], #1] &, (* Apples the Style to each digit *)
List[(RealDigits@testNumber)[[1]], (* This is the list of digits *)
Range@Length@(RealDigits@testNumber)[[1]] (* Just gives positions of digits in the List *) ]
]


Now put the decimal point back in the correct location with Insert and display it with Row as if it were a number:

Row@Insert[myDigitList, ".", 1 + Part[RealDigits@correctNumber, 2]]


Which produces this:

A drawback with this approach is that the final output is no longer a number (check the FullForm). If you wish to produce a number, perhaps NumberForm in combination with the option NumberFormat will provide solace.