Visualizing Base-10 Digits (0-9) As Corresponding Colors

Question

Is there a way I can visualize my output (which happens to be in base-10 by default) with a specific color text corresponding to the digit (0 through 9)?

Here is the key for the coloring scheme:

0: Black 1: Red 2: Green 3: Blue 4: Cyan 5: Magenta 6: Yellow 7: Orange 8: Pink 9: Purple

These named colors are already named colors in Mathematica (https://reference.wolfram.com/language/guide/Colors.html)

For instance, for the code:

x = Range[3]

AccountingForm[Column[Mod[2^-x, 1]]] // N

With expected output:

0.5 0.25 0.125

All zeros would be black, all 2's would be green, all 5's would be magenta, and if any of the other base-10 digits were printed they would be in their corresponding color of text. How do I do this?

Answer 1

This might do what you want. If not it should at least be a starting point.

Edit: I think I have improved the function.

clr := {Black, Red, Green, Blue, Cyan, Magenta, Yellow, Orange, Pink, Purple};

rules = MapThread[# -> Style[##] &, {CharacterRange["0", "9"], clr}];

colorize =
  # /. n_?NumberQ :> 
     RuleCondition @ Row[List @@ StringReplace[ToString[n, OutputForm], rules]] &;

Test:

N[Pi, 25] // colorize

Answer 2

This seems to format numbers in an expression, but it probably could work better.

First, color rules:

colorrules = {
  "0" -> "\*\n " <> ToString@ToBoxes@Style[0, Black],
  "1" -> "\*\n " <> ToString@ToBoxes@Style[1, Red],
  "2" -> "\*\n " <> ToString@ToBoxes@Style[2, Green],
  "3" -> "\*\n " <> ToString@ToBoxes@Style[3, Blue],
  "4" -> "\*\n " <> ToString@ToBoxes@Style[4, Cyan],
  "5" -> "\*\n " <> ToString@ToBoxes@Style[5, Magenta],
  "6" -> "\*\n " <> ToString@ToBoxes@Style[6, Yellow],
  "7" -> "\*\n " <> ToString@ToBoxes@Style[7, Orange],
  "8" -> "\*\n " <> ToString@ToBoxes@Style[8, Pink], 
  "9" -> "\*\n " <> ToString@ToBoxes@Style[9, Purple]}

Here is a cheap way, but it doesn't handle fractions gracefully. It should be sufficient for simple numbers or lists of real/complex numbers.

colorForm[expr_] := expr /. n_?NumberQ :> StringReplace[ToString@n, colorrules];


N[(-Pi)^(1/3)]
(N[(-Pi)^(1/3)] + 45 x)^2 // colorForm

2/3 // colorForm

Here is a somewhat more sophisticated approach that handles fractions, radicals, as well as the typeset E and complex I. The use of Interpretation is perhaps over-ambitious, since copying the output and pasting it usually results in a very large expression. Another difference is that it shows all digits of machine real numbers.

ClearAll[colorForm];
colorForm[expr_, form_: StandardForm] := With[{colored = DisplayForm[
     ToBoxes[expr, form] /. 
      s_String :> 
       With[{x = Quiet@ToExpression@s}, 
        RowBox@List@StringReplace[ToBoxes@s, colorrules] /; 
         MatchQ[x, _Real | _Integer]]]},
  Interpretation[colored, expr]
  ]


N[(-Pi)^(1/3)]
(N[(-Pi)^(1/3)] + 45 x)^Sqrt[2] // colorForm

2/3 // colorForm

Answer 3

It is not entirely clear what you want. You could make a styling function:

cs = <|0 -> Black, 1 -> Red, 2 -> Green, 3 -> Blue, 4 -> Cyan, 5 -> Magenta, 
  6 -> Yellow, 7 -> Orange, 8 -> Pink, 9 -> Purple|>
stylen = n \[Function] Style[n, cs[n]]

Then you could style any list of digits. E.g.,

stylen /@ {1, 2, 3}

To get the digits you you could use RealDigits.

x = Range[20];
data = N@Mod[2^-x, 1];
rd = (RealDigits[#] & /@ data)
Grid@Map[stylen, #[[1]] & /@ rd, {2}]

But you probably want some leading zeros. But how many? You made that confusing when you allowed for an integer component. Let's ignore that for a moment. Also, how many trailing zeros? Any? We'll ignore that for a moment too.

getDigits = n \[Function] Module[{ds, x},
    {ds, x} = RealDigits[n];
    Catenate[{ConstantArray[0, 1 - x], ds}]
    ];
Grid@Map[stylen, getDigits /@ data, {2}]

To make this nice, you just need to clean up getDigits so that it does what you actually want it to.