12
$\begingroup$

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.

Improve this question
$\endgroup$
1
  • 1
    $\begingroup$ I am inclined to close this as a duplicate of your earlier question unless you can explain how these are fundamentally different: mathematica.stackexchange.com/q/5740/121 $\endgroup$
    – Mr.Wizard
    Commented Jul 7, 2012 at 21:06

10 Answers 10

Reset to default
12
$\begingroup$ 
{First@#, g /@ Last@#} & /@ test
Improve this answer
$\endgroup$
12
$\begingroup$

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}]
Improve this answer
$\endgroup$
1
  • $\begingroup$ You hit every method I would have used; well done! (And Cases which I would not have considered.) $\endgroup$
    – Mr.Wizard
    Commented Jul 7, 2012 at 21:09
8
$\begingroup$

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
Improve this answer
$\endgroup$
7
$\begingroup$

Something like :

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

Or a bit more generally ;

{Most[#], Thread[g[Last[#]]]} & /@ test
Improve this answer
$\endgroup$
2
  • $\begingroup$ 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? $\endgroup$
    – Andrew
    Commented Jul 7, 2012 at 20:20
  • 1
    $\begingroup$ @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. $\endgroup$
    – b.gates.you.know.what
    Commented Jul 7, 2012 at 20:31
7
$\begingroup$ 
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]}}}
Improve this answer
$\endgroup$
5
$\begingroup$

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}]
Improve this answer
$\endgroup$
1
  • 3
    $\begingroup$ 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 $\endgroup$
    – Mr.Wizard
    Commented Oct 3, 2012 at 6:32
3
$\begingroup$

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}}}
Improve this answer
$\endgroup$
3
$\begingroup$

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]}}} *)
Improve this answer
$\endgroup$
2
$\begingroup$

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
Improve this answer
$\endgroup$
2
  • $\begingroup$ Thanks. I don't think this method preserves the {} around a1, b1, and c1 in the original list test. $\endgroup$
    – Andrew
    Commented Jul 7, 2012 at 20:26
  • $\begingroup$ @Andrew -- Please see edit ;) $\endgroup$
    – Jagra
    Commented Jul 7, 2012 at 20:53
2
$\begingroup$

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

Improve this answer
$\endgroup$

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