Elegant way to map a function to only the last element of each sublist

Question

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

Can you please help me? Thank you.

Answer 1

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

Answer 2

Something like :

{#[[1]], Thread[g[#[[2]]]]} & /@ test

Or a bit more generally ;

{Most[#], Thread[g[Last[#]]]} & /@ test

Answer 3

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

Answer 4

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

Answer 5

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

Answer 6

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

Answer 7

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

Answer 8

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

Answer 9

There is a simpler way!

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

Compact and elegant.

There is another more generic one that don't change the original value:

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

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

Answer 10

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