5
$\begingroup$

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

not quite Pi

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?

Improve this question
$\endgroup$

3 Answers 3

Reset to default
11
$\begingroup$

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:

enter image description here

enter image description here

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

enter image description here

Improve this answer
$\endgroup$
4
  • $\begingroup$ @rasher Thanks, I like it too :) I'm going to pose an extension :p $\endgroup$
    – Kuba
    Commented Jan 20, 2014 at 12:06
  • $\begingroup$ 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? $\endgroup$
    – Michael Stern
    Commented Jan 20, 2014 at 14:23
  • $\begingroup$ @Kuba for long numbers, Mathematica forces an undesired line break between the black and red parts. $\endgroup$
    – Michael Stern
    Commented Jan 20, 2014 at 14:32
  • $\begingroup$ @MichaelStern Does something like that help? Pane[mark[N[Pi, 145], -3 ;;], {1000}] $\endgroup$
    – Kuba
    Commented Jan 20, 2014 at 14:38
3
$\begingroup$

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... *)
Improve this answer
$\endgroup$
1
$\begingroup$

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 = 
    MapThread[
    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:

enter image description here

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.

Improve this answer
$\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.