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

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?

• Related: (10990), (40754) Sep 24 '16 at 11:33
• @Mr.Wizard We had a similar question recently: (121118). This question was only answered in comments, should we close it as a duplicate of the present post?
– user31159
Sep 24 '16 at 12:01
• @Xavier That question appear to be a bit different; by my reading it is about list elements rather than digits within a number. It is probably a duplicate of another question however. I shall look. These are close: (31449), (31535) Sep 24 '16 at 12:06
• @Mr.Wizard Re difference. Yes, good point. I agree they are different. Re duplicate. They are close indeed. I'll try to find if there is another duplicate as well. Meanwhile, I'll make a CW answer to remove (121118) from the list of unanswered questions.
– user31159
Sep 24 '16 at 12:29

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


• Note: this is still pretty dirty and not robust. I am sorry but I do not have time and interest at the moment write this properly. Sep 24 '16 at 12:24

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


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.

• My code so far is as I said: x = Range[3] AccountingForm[Column[Mod[2^-x,1]]]//N With expected output 0.5 0.25 0.125 As amount of expected digits goes, it turns out (2^-x) is always x digits long in base-10 so long as x is an integer (which it is for Range), so we can anticipate that's how many digits there are if it's needed to define the range in which to apply the color key. I want the output to be as left aligned numbers, but since (given we're using Mod 1) the integer preceding the decimal will always be zero that is irrelevant to the output for me. Sep 24 '16 at 3:21
• We could then get 5 25 125 without it being a problem. I don't simply want a function that requires I manually input a list. The point of using range for the variable x is we will autogenerate multiple answers, which are too big for me to copy and past manually for large numbers since the decimal gets correspondingly longer. I just want whatever comes out to be with the base-10 digits colored according to that key. I don't want them separated by commas or formatted differently since I care about their vertical and horizontal alignment, unless you used a grid or table I suppose. Sep 24 '16 at 3:22
• @TravisArlenMcCracken The code I provide uses Grid for exactly that reason.
– Alan
Sep 24 '16 at 17:56