Take the 2-minute tour ×
Mathematica Stack Exchange is a question and answer site for users of Mathematica. It's 100% free, no registration required.
list = Symbol /@ CharacterRange["a", "n"];
MapAt[Style[#, Red] &, list, List /@ {4, 9, 2}];
MapAt[Style[#, Green] &, %, List /@ {3, 5, 7}];
MapAt[Style[#, Blue] &, %, List /@ {8, 1, 6}]

enter image description here

I am sure there is a better way do this, could you give any better ideas?

share|improve this question
    
The "MapAtIndexed" question is tangentially related. –  Michael E2 Sep 2 '13 at 11:26

10 Answers 10

up vote 7 down vote accepted

If there's no formula or pattern to the colors, then you have to somehow manually indicate how to style each part. Here are a couple of ways to do that using Rule to encode key/value pairs (in the form part -> style):

styleRules1 = {{4, 9, 2} -> Red, {3, 5, 7} -> Green, {8, 1, 6} -> Blue};

styleRules2 = {4 | 9 | 2 -> RGBColor[1, 0, 0], 3 | 5 | 7 -> RGBColor[0, 1, 0], 
    8 | 1 | 6 -> RGBColor[0, 0, 1]};

Here's a function that can take a list of such styling rules and apply them to the parts:

stylePart[expr_, rules_] := 
 ReplacePart[expr, 
  styleRules /. HoldPattern@Rule[alt_, color_] :> (i : alt :> Style[expr[[i]], color])
  ]

Examples

stylePart[list, Flatten[Thread /@ styleRules1]]

stylePart[list, styleRules2]

Mathematica graphics


Here is another way to use such rules:

saStyles = SparseArray[styleRules2, Length@list];

styleIt[x_, 0] := x;
styleIt[x_, style_] := Style[x, style];
MapThread[styleIt, {list, saStyles}]
share|improve this answer
    
I see that you are using Alternatives as I did in my first code. Unless this has been universally optimized in v9 (I know it has been optimized in DeleteCases for example) this will slow in proportion to the number of alternatives. I see that you used SparseArray before I did so credit where it's due. –  Mr.Wizard Sep 1 '13 at 22:35
    
@Mr.Wizard I assumed, since the question is about styling, that speed on a very large set was not an important issue. Alternatives seemed a quite readable alternative way to write the styling rules. (I meant that Alternatives was an alternative form of input, and I've edited the answer to make clearer, I hope.) –  Michael E2 Sep 2 '13 at 0:05
    
Okay, I see it more clearly now. By the way, I do not assume that this question is about styling, but rather that Style was merely a nice illustration. This is why I did not write my answer to work with a list of colors but rather a list of functions. –  Mr.Wizard Sep 2 '13 at 0:09
    
@Mr.Wizard Yours is a more interesting interpretation. When I've done such things on a larger scale, the positions have been determined by properties of the data and I've used the properties instead. –  Michael E2 Sep 2 '13 at 11:40

With these definitions:

list=CharacterRange["a","n"];
colorRules={{4,9,2}-> Red,{3,5,7}-> Green,{8,1,6}-> Blue};

Here is one option using Fold

colorize[list_,colorRule_]:=MapAt[Style[#,colorRule[[1]]]&,list,List /@ colorRule[[2]]]
Fold[colorize,list,colorRules]

enter image description here

Here is another using Rules with MapIdexed

rule=Dispatch@Flatten@Join[Thread/@colorRules,{_-> ""}];
MapIndexed[Style[#,#2[[1]]/.rule]&,list]

enter image description here

share|improve this answer
    
I like _ -> Identity :) –  chyaong Sep 1 '13 at 7:11

I think the most straightforward way is to use Switch and MapIndexed:

colorF[l_, {i_}] := Switch[i,
   4 | 9 | 2, Style[l, Red],
   3 | 5 | 7, Style[l, Green],
   8 | 1 | 6, Style[l, Blue],
   _, l
   ];
MapIndexed[colorF, list]

Another possibility is ReplacePart:

ReplacePart[list,
 {i_ /; MatchQ[i, 4 | 9 | 2] :> Style[list[[i]], Red],
  i_ /; MatchQ[i, 3 | 5 | 7] :> Style[list[[i]], Green],
  i_ /; MatchQ[i, 8 | 1 | 6] :> Style[list[[i]], Blue]}]
share|improve this answer

This question looks like fun. Too bad I missed out on the early action. I don't have much time but two ideas came to mind. The first was assignments to Part which I believe ssch already did. The second is creating a list if functions and then using Inner and Compose as I did for Map a function across a list conditionally.

fns = Function /@ Thread@Style[#, {Red, Green, Blue}];

pos = {{4, 9, 2}, {3, 5, 7}, {8, 1, 6}};

fns2 = SparseArray[Join @@ Thread /@ Thread[pos -> fns], Length@list, Identity];

Inner[Compose, fns2, list, List]

I'll be back later to refine this and add comparative timings.


Update #1

I changed my code above to eliminate Alternatives which, at least in version 7, causes a considerable slow-down when applied to a large number of elements. I knew this, but I was in a hurry. I have replaced it with a double-Thread approach that scales better.

Nevertheless this SparseArray construct is slower than assignments to Part, which doesn't surprise me. I could use Part assignments to build the function list that is passed to Inner but then there is little reason I can see not to use the method directly. Part assignment is a favorite method of mine anyway, so here is my variation of the Part assignment method ssch already posted:

mapAtParts[expr_, fns_List, pos_List] /;
  Length[fns] == Length[pos] && Max[pos] <= Length[expr] :=
    Module[{w = expr},
      MapThread[w[[#]] = #2 /@ w[[#]]; &, {pos, fns}];
      w
    ]

Example:

mapAtParts[
  CharacterRange["a", "n"],
  Function /@ Thread @ Style[#, {Red, Green, Blue}],
  {{4, 9, 2}, {3, 5, 7}, {8, 1, 6}}
]

enter image description here

Note: as described here in the section "We're not done yet" if the functions are Listable it will be more efficient to use that, i.e. w[[#]] = #2 @ w[[#]]; &.

share|improve this answer
1  
another answer that has taught me a lot...SparseArray and Compose wonderful. –  ubpdqn Sep 1 '13 at 9:15
MapIndexed[{First@#2, #} &,  CharacterRange["a",  "n"]] /. 
 {{id : Alternatives @@ {4, 9, 2}, el_} :> Style[el, Red],
  {id : Alternatives @@ {3, 5, 7}, el_} :> Style[el, Green],
  {id : Alternatives @@ {8, 1, 6}, el_} :> Style[el, Blue],
  {_, el_} -> el
 }
share|improve this answer

By copying the list and then repeatedly replacing part of it:

list = Symbol /@ CharacterRange["a", "n"];
result = list;
result[[{4, 9, 2}]] = Style[#, Red] & /@ result[[{4, 9, 2}]];
result[[{3, 5, 7}]] = Style[#, Green] & /@ result[[{3, 5, 7}]];
result[[{8, 1, 6}]] = Style[#, Blue] & /@ result[[{8, 1, 6}]];
result
(* result is now same as question output *)

This could be put in a function to save some typing:

MapAtMany::usage = "MapAtMany[{{f1, {i1, j1, ...}}, {f2, {i2, j2, ...}}, ...}, expr]";

MapAtMany[fpart_, expr_] := Module[{res = expr},
   Scan[
    (res[[ #[[2]] ]] = #[[1]] /@ res[[ #[[2]] ]]) &
    , fpart];
   res];

list = Symbol /@ CharacterRange["a", "n"];
fpart = {
   {Style[#, Red] &, {4, 9, 2}},
   {Style[#, Green] &, {3, 5, 7}},
   {Style[#, Blue] &, {8, 1, 6}}};

MapAtMany[fpart, list]

Fold can also be used so you don't have to refer to % for each successive function:

Fold[
 MapAt[#2[[1]], #1, Transpose@{#2[[2]]}] &,
 list,
 fpart
 ]

Although tests suggest that the Fold method is much slower and worse at scaling.

share|improve this answer
1  
This is my favorite method and you have my vote, but IMHO you should not be using Block here. Instead use Module. I used to abuse Block a lot before people like Leonid showed me the error of my ways. Should your list contain the Symbol res you will create a recursion; a simple example: expr = {1, 2, x}; Block[{x = expr}, x] –  Mr.Wizard Sep 1 '13 at 22:27
    
@Mr.Wizard Thanks for the feedback, that hadn't crossed my mind. I'll think twice before autopiloting Block everywhere –  ssch Sep 1 '13 at 23:40

Here's a straightforward way using a Table where you make the list and the colors, and then match them.

list = Symbol /@ CharacterRange["a", "n"];
color = {Red, Green, Blue};
Table[Style[list[[ii]], color[[Mod[ii, Length[color]] + 1]]], {ii, 1, Length[list]}]

enter image description here

If you wish to specify the colors manually, that's easy too

list = Symbol /@ CharacterRange["a", "n"];
color = {Black, Red, Green, Blue};
locations = {2, 3, 4, 2, 3, 4, 2, 2, 1, 1, 1, 1, 1, 1};
Table[Style[list[[ii]], color[[locations[[ii]]]]], {ii, 1, Length[list]}]

enter image description here

Here's a way that bypasses the Table and uses MapThread instead. You can choose the colors in col manually, by algorithm, or choose them randomly:

list = Symbol /@ CharacterRange["a", "n"];
cols = RandomChoice[{Red, Blue, Green, Black}, Length[list]];    
MapThread[Style[#1, #2] &, {list, cols}]
share|improve this answer
    
@Murta -- thanks, the index is now fixed. –  bill s Aug 31 '13 at 16:03
    
You can avoid index if you want using Style[#, color[[Mod[#2[[1]], 3] + 1]]] &~MapIndexed~list –  Murta Aug 31 '13 at 16:27
    
The OP's example is not a repeating pattern. That would have been a duplicate of (3858). Can you adapt your answer to handle arbitrary positions? –  Mr.Wizard Sep 1 '13 at 22:31
    
Incidentally it will be simpler to use Inner, but you're then recreating my (first) answer: Inner[Style[#, color[[#2]]] &, list, locations, List] –  Mr.Wizard Sep 1 '13 at 23:24
    
+1 for repeated updates to address my concerns. :-) –  Mr.Wizard Sep 2 '13 at 7:34

A simple straightforward way for 1D lists (with non-continuous style associations):

list = Join[CharacterRange["a", "n"], {"Input", "MSG", Blue, Italic}]
color = {{4, 9, 2} -> Red, {12, 5, 7} -> Green, {8, 1, 6} -> Blue};

rules = ReplacePart[{} & /@ list, Flatten[color /. x_Rule :> Thread@x]];

Grid[{list}, ItemStyle -> {rules}]
MapThread[Style, {list, rules}]

enter image description here

share|improve this answer
    
Consider also Join @@ Thread /@ color in place of Flatten[color /. x_Rule :> Thread@x] –  Mr.Wizard Sep 2 '13 at 9:38
list = Symbol /@ CharacterRange["a", "n"];

Here is how I would do it. First I would define a function to make a set of substitution rules for any set of indices and any given color.

makeRules[vars : {_Symbol ..}, 
    indices : {_Integer?Positive ..}, 
    color : (_RGBColor | _GrayLevel | _Hue)] := 
  Map[Rule[vars[[#]], Style[vars[[#]], color]] &, indices]

Next I would generate the full set of rules needed for the whole list of symbols.

fullRules = Flatten[{
   makeRules[list, {4, 9, 2}, Red],
   makeRules[list, {3, 5, 7}, Green],
   makeRules[list, {8, 1, 6}, Blue]}]

Finally I would apply the rules to the given list.

list /. fullRules

coloredSymbols.png

share|improve this answer

Just to add to the variety:

fun[list_, pos_, colors_] :=
 Module[
  {styles},
  styles = Function[{x}, Style[x, #]] & /@ colors;
  list /. 
   Flatten[Thread /@ 
     MapThread[#1 -> #2 /@ #1 &, {list[[#]] & /@ pos, styles}]]
  ]

Then

fun[list, {{4, 9, 2}, {3, 5, 7}, {8, 1, 6}}, {Red, Green, Blue}]

yields the same result.

EDIT

Noting Mr. Wizard's correction and mainly as (my own) learning opportunity the following is essentially one of Mr. Wizard's approaches slightly different but mapping functions to positions not elements.

func[list_, pos_, col_] :=
 Module[
  {l, el, styles, rules},
  l = Length[list];
  styles = Function[{x}, Style[x, #]] & /@ col;
  rules = Flatten[Thread /@ MapThread[Rule[#1, #2] &, {pos, styles}]];
  el = ReplacePart[Table[Identity, {l}], rules];
  MapThread[Compose, {el, list}]
  ]

Then

func[list, {{4, 9, 2}, {3, 5, 7}, {8, 1, 6}}, {Red, Green, Blue}]

works

share|improve this answer
    
I'm afraid this doesn't work quite right. It will only work correctly if all the elements of list are unique, as your replacements are done by pattern rather than position. –  Mr.Wizard Sep 1 '13 at 10:12
    
thanks, point taken...another learning opportunity –  ubpdqn Sep 1 '13 at 10:51

Your Answer

 
discard

By posting your answer, you agree to the privacy policy and terms of service.

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