# Elegant way to map a function to only the last element of each sublist [duplicate]

Suppose that I have the following list, called test:

test = {{{a1}, {a2, a3}}, {{b1}, {b2, b3}}, {{c1}, {c2, c3}}};

Now suppose I have an arbitrary function g. I would like to map g onto test such that I obtain the following list:

{{{a1}, {g[a2], g[a3]}}, {{b1}, {g[b2], g[b3]}}, {{c1}, {g[c2], g[c3]}}}

This code is incorrect:

Map[g, test, {3}]

from which I obtain:

{{{g[a1]}, {g[a2], g[a3]}}, {{g[b1]}, {g[b2], g[b3]}}, {{g[c1]}, {g[c2], g[c3]}}}

{First@#, g /@ Last@#} & /@ test

A few others

MapAt[g /@ # &, #, -1] & /@ test

MapAt[Map[g, #, {2}] &, test\[Transpose], 2]\[Transpose]

Module[{test2 = test},
test2[[All, 2]] = Map[g, test2[[All, 2]], {2}];
test2
]

Replace[test, {b___, a_} :> {b, g /@ a}, {1}]

This last one can be rewritten to

Cases[test, {b___, a_} :> {b, g /@ a}]
• You hit every method I would have used; well done! (And Cases which I would not have considered.) – Mr.Wizard Jul 7 '12 at 21:09

One might find some use in utilizing a helper function:

f[{x_}] := {x}
f[{x__}] := g /@ {x}
Map[f, test, {2}]

(* {{{a1}, {g[a2], g[a3]}}, {{b1}, {g[b2], g[b3]}}, {{c1}, {g[c2], g[c3]}}} *)

If you want to get fancier, you can also use MapAt with Tuples:

MapAt[g, #, Tuples[{Range@Length@#, {-1}, Range@Length@#[[1, -1]]}]] &@test

Something like :

Or a bit more generally ;

• Thanks. I think this needs Flatten[#, 1]& around it to be correct. That is, Flatten[{Most[#], Thread[g[Last[#]]]} & /@ test, 1]. I think. Am I correct? – Andrew Jul 7 '12 at 20:20
• @Andrew For the second version you want to apply Flatten only to the first argument as in {Flatten[Most[#]], Thread[g[Last[#]]]} & /@ test; This will give the same result you mention. – b.gates.you.know.what Jul 7 '12 at 20:31
Transpose[{test[[All, 1]], Map[g, test[[All, 2]], {2}]}]
{{{a1}, {g[a2], g[a3]}}, {{b1}, {g[b2], g[b3]}}, {{c1}, {g[c2], g[c3]}}}

Another option is:

test[[All,-1]] = g/@ test[[All,-1]]

If you don't want to change the original value then:

mapAtParts[fnc_,list_,{parts__},level_:{1}]:=Module[{$list=list},$list[[parts]]=Map[fnc,$list[[parts]],level];$list
]

mapAtParts[g,test,{All,-1},2]

## Update

As @Kuba shows here, now in version 9 we can just do:

MapAt[g, test, {All, -1, All}]
• I am certainly a fan of using Part and Set but it must be noted that this changes the data stored in test itself, rather than making a copy as do all the other answers. This can be either good or bad. You can use Module[{x = test}, x[[All, -1]] = g /@ x[[All, -1]]; x] to operate on a copy. Note that I also used the index -1 as this more closely matches the problem specification. +1 – Mr.Wizard Oct 3 '12 at 6:32

What I'd do:

MapAt[Map[g, #] &, #, Transpose[ArrayPad[{Range[Length[#]]}, {{0, 1}, {0, 0}}, 2]]] & @
{{{a1}, {a2, a3}}, {{b1}, {b2, b3}}, {{c1}, {c2, c3}}}

After 8 previous answers, we are left with few alternatives. The following are variations that allow different methods to specify positions at which f is applied:

ClearAll[mapAt,mapAtPosPatterns,mapAtPosParts];
mapAt[k : {__Integer} ..] :=  Function[{fnc, dt}, (fnc~Map~Sequence[#, {-1}] &~MapAt~Sequence[#, {k}] &~Map~dt)]

Examples:

f1~mapAt[{-1}]~test
mapAt[{-1}][f1, test]

both give

{{{a1}, {f1[a2], f1[a3]}}, {{b1}, {f1[b2], f1[b3]}}, {{c1}, {f1[c2],f1[c3]}}}

and

mapAt[{-1, 2}, {1}][f1, test]

gives

{{{f1[a1]}, {a2, f1[a3]}}, {{f1[b1]}, {b2, f1[b3]}}, {{f1[c1]}, {c2, f1[c3]}}}

Using Cases to specify position patterns

mapAtPosPatterns[fnc_, lst_, pos_] :=
MapAt[fnc, lst, Cases[Flatten[MapIndexed[#2 &, lst, {-1}], 2], pos]]

Examples:

test2= {{{a1}, {a2, a3}}, {{b1}, {b2, b3}}, {{c1}, {c2, c3, c4}}}
mapAtPosPatterns[f1, test2, {_, 2, _}]
(*{{{a1},{f1[a2], f1[a3]}}, {{b1},{f1[b2], f1[b3]}},{{c1}, {f1[c2], f1[c3], f1[c4]}}}*)
mapAtPosPatterns[f1, test2, {_, 2, 1 | 3}]
(* {{{a1}, {f1[a2], a3}}, {{b1}, {f1[b2], b3}}, {{c1}, {f1[c2], c3, f1[c4]}}} *)
mapAtPosPatterns[f1, test2, {3, 2, 2 | 3}]
(*{{{a1}, {a2, a3}}, {{b1}, {b2, b3}}, {{c1}, {c2, f1[c3], f1[c4]}}}  *)
mapAtPosPatterns[f1, test2, {Except[1], 2, Except[1]}]
(* {{{a1}, {a2, a3}}, {{b1}, {b2, f1[b3]}}, {{c1}, {c2, f1[c3], f1[c4]}}} *)
mapAtPosPatterns[f1, test2, {_, 2, i : (_Integer) /; i >= 2}]
(* {{{a1}, {a2, f1[a3]}}, {{b1}, {b2, f1[b3]}}, {{c1}, {c2, f1[c3], f1[c4]}}} *)

Using Part specifications

mapAtPosParts[fnc_, lst_, {pos__}] :=
MapAt[fnc,lst,Flatten[Map[Position[lst, #] &,lst[[pos]], {-1}], Depth[lst[[pos]]]- 1]]

Examples:

mapAtPosParts[f1, test2, {All, 2, -1}]
(* {{{a1}, {a2, f1[a3]}}, {{b1}, {b2, f1[b3]}}, {{c1}, {c2, c3, f1[c4]}}} * )
mapAtPosParts[f1, test2, {All, 1}]
(* {{{f1[a1]}, {a2, a3}}, {{f1[b1]}, {b2, b3}}, {{f1[c1]}, {c2, c3, c4}}} *)
mapAtPosParts[f1, test2, {2 ;;, 2 ;;, -1}]
(* {{{a1}, {a2, a3}}, {{b1}, {b2, f1[b3]}}, {{c1}, {c2, c3, f1[c4]}}} *)

In the spirit of another (if not particularly elegant) way to do it:

MapThread[Append, {test[[All, 1]],Partition[g[#] & /@ Flatten[test[[All, 2]]], 2]}]

oops! copied over the wrong version. Try this:

MapThread[Append, {{#} & /@ test[[All, 1]],Partition[g[#] & /@ Flatten[test[[All, 2]]], 2]}] == {{{a1}, {g[a2], g[a3]}}, {{b1}, {g[b2], g[b3]}}, {{c1}, {g[c2], g[c3]}}}

True
• Thanks. I don't think this method preserves the {} around a1, b1, and c1 in the original list test. – Andrew Jul 7 '12 at 20:26
• @Andrew -- Please see edit ;) – Jagra Jul 7 '12 at 20:53

If one can assume that lists of symbols only appear at the last position in every sublist (I guess, most of the time one can not):

test = {{{a1}, {a2, a3}}, {{b1}, {b2, b3}}, {{c1}, {c2, c3}}};

test /. x : {_Symbol, __Symbol} :> g /@ x

{{{a1}, {g[a2], g[a3]}}, {{b1}, {g[b2], g[b3]}}, {{c1}, {g[c2], g[c3]}}}