2
$\begingroup$

I would like to have colored array of an output. Assume for example we have an array of numbers or texts as output and we want different colors for different classes of them. For example

A={1,2,3,4,5,6,7,8}

and we want Odd numbers be Blue and Even numbers be Red.

or

PrimeQ[A] which gives True or False, with Blue color for True and Red color for False.

Thanks.

$\endgroup$
6
  • $\begingroup$ ArrayPlot[{A}, ColorFunction -> (If[EvenQ[#], Red, Blue] &), ColorFunctionScaling -> False] or ArrayPlot[{A}, ColorFunction -> (If[PrimeQ[#], Red, Blue] &), ColorFunctionScaling -> False] $\endgroup$ – Jason B. Jul 20 '16 at 17:23
  • 2
    $\begingroup$ Or even shorter, ArrayPlot[{A}, ColorRules -> {_?EvenQ -> Red, _ -> Blue}] $\endgroup$ – Jason B. Jul 20 '16 at 17:25
  • 1
    $\begingroup$ Replace[A, {n_?EvenQ :> Style[n, Red], n_ :> Style[n, Blue]}, {1}] or more generally MakeBoxes[n_?EvenQ, StandardForm] := StyleBox[n, Red]; MakeBoxes[n_?OddQ, StandardForm] := StyleBox[n, Blue] $\endgroup$ – user31159 Jul 20 '16 at 17:33
  • $\begingroup$ @Xavier, thanks, I need some output as your first command, but it does not work for other functions such "PrimeQ". $\endgroup$ – asad Jul 21 '16 at 6:31
  • 2
    $\begingroup$ @asad It seems that Replace[A, {n_?PrimeQ :> Style[n, Blue], n_ :> Style[n, Red]}, {1}] does what you want, isn't it the case? $\endgroup$ – user31159 Jul 21 '16 at 13:11
2
$\begingroup$

First approach

Function to change the style of elements of a specific class in an expression.

Code.

SetAttributes[coloredreplace, HoldAllComplete];

coloredreplace[expr_, testQ_, colors: {True -> c1_?ColorQ, False -> c2_?ColorQ}] := 
    coloredreplace[expr, {Sequence[], testQ}, colors];

coloredreplace[expr_, {head_, testQ_}, {True -> c1_?ColorQ, False -> c2_?ColorQ}] := 
    Replace[expr, {n_head?testQ :> Style[n, c1], n_head :> Style[n, c2]}, {1}];

Usage.

1) For EvenQ elements:

expr1 = Range[8];

coloredreplace[expr1, EvenQ, {True -> Red, False -> Blue}]

enter image description here

% === coloredreplace[expr1, {Integer, EvenQ}, {True -> Red, False -> Blue}]
(* True *)

2) For PrimeQ elements:

coloredreplace[expr1, {Integer, PrimeQ}, {True -> Blue, False -> Red}]

enter image description here

3) For elements satisfying a StringMatchQ test:

expr2 = {"a", "1", 1, "b", "2", 2, "c", "3", 3};

coloredreplace[expr2, StringMatchQ[#, LetterCharacter] &, {True -> Red, False -> Blue}]

enter image description here

We can specify the head to get a cleaner pattern:

coloredreplace[expr2, {String, StringMatchQ[#, LetterCharacter] &}, 
                      {True -> Red, False -> Blue}
]

enter image description here

This removed the messages and changed the display for non-String elements.

Second approach

Function to define global rules of display for elements of a specific class.

Code.

coloreddisplay[{head_, testQ_}, {True -> c1_?ColorQ, False -> c2_?ColorQ}] :=
    Module[{},

        FormatValues[MakeBoxes] = DeleteCases[FormatValues[MakeBoxes],
            HoldPattern[
                Verbatim[HoldPattern][MakeBoxes[
                   Verbatim[PatternTest][Verbatim[Pattern][_, Verbatim[Blank][head]], _], 
                   StandardForm
                ]] :> 
                RowBox[{StyleBox[_, color_]}]
            ] /; ColorQ[color]
        ];

        MakeBoxes[n_head?testQ, StandardForm] := RowBox[{StyleBox[n, c1]}];
        MakeBoxes[n_head, StandardForm] := RowBox[{StyleBox[n, c2]}];

    ];

Usage.

coloreddisplay[{Integer, EvenQ}, {True -> Red, False -> Blue}];

expr1

enter image description here

coloreddisplay[{Integer, PrimeQ}, {True -> Blue, False -> Red}];

expr1

enter image description here

coloreddisplay[{String, StringMatchQ[#, LetterCharacter] &}, {True -> Red, False -> Blue}]

expr2

enter image description here

The digits 1, 2 and 3 are colored because the rule for PrimeQ elements define previously still applies. Removing all rules generated by coloreddisplay can be simply done with FormatValues[MakeBoxes] = {}, which could be written in its code instead of the DeleteCases part if needed. Note that this will also delete MakeBoxes rules defined elsewhere.

$\endgroup$

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

Not the answer you're looking for? Browse other questions tagged or ask your own question.