Map function on the specified location

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}]


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

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]


Here is another way to use such rules:

saStyles = SparseArray[styleRules2, Length@list];

styleIt[x_, 0] := x;
styleIt[x_, style_] := Style[x, style];

• 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]


Here is another using Rules with MapIdexed

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


• I like _ -> Identity :) – chyanog 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]}]


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}};

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}}
]


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[[#]]; &.

• 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
}


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.

• 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]}]


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]}]


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]];

• @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}]


• 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


Just to add to the variety:

fun[list_, pos_, colors_] :=
Module[
{styles},
styles = Function[{x}, Style[x, #]] & /@ colors;
list /.
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;
el = ReplacePart[Table[Identity, {l}], rules];

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

• 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