Make MapIndexed listable

Question

My goal is to apply MapIndexed to every element of a nested list without destroying the arithmetic operations within the elements. For example, let's start with this list:

{a, {b, {c^d, {e + f g}}}}

This is what I want achieved using MapIndexed and applying a function h (this was explicitly typed out, so the bracket placement might be wrong, but you get the idea):

{h[a, {1}], {h[b, {2, 1}], {h[c^d, {2, 2, 1}], {h[e + f g, {2, 2, 2, 1}]}}}}

---

My (failed) attempts

1) Of course the {-1} levelspec of MapIndexed was way too aggressive:

MapIndexed[h, {a, {b, {c^d, {e + f g}}}}, {-1}]

2) This also did not work:

Function[l, MapIndexed[h, l], Listable]@{a, {b, {c^d, {e + f g}}}}

To see why, MapIndexed is nested in a Defer:

Function[l, Defer@MapIndexed[h, l], Listable]@{a, {b, {c^d, {e + f g}}}}

It's clear that MapIndexed is threaded over the list first before it evaluated, while what I want is for MapIndexed to be applied to the whole list, and only the evaluation thereafter will be listable (I hope the distinction is clear).

---

My question is: How can I make my MapIndexed listable as seen in the desired output? Solutions without using MapIndexed are also appreciated.

{a, {b, {c^d, {e + f g}}}} -> {h[a, {1}], {h[b, {2, 1}], {h[c^d, {2, 2, 1}], {h[e + f g, {2, 2, 2, 1}]}}}}

Answer 1

What you have is a so called linked list, and such lists are usually traversed through recursion like this:

applyFunc[f_, {el_, rest_}, level_: {1}] := {f[el, level], applyFunc[f, rest, Prepend[level, 2]]}
applyFunc[f_, {el_}, level_] := {f[el, level]}

applyFunc[h, expr]

{h[a, {1}], {h[b, {2, 1}], {h[c^d, {2, 2, 1}], {h[e + f g, {2, 2, 2,1}]}}}}

But Mr.Wizards interpretation of the question is much more interesting and probably what you wanted. Here's a solution to that problem:

mapIndexed[f_, list : {__}, level_: {}] := MapIndexed[mapIndexed[f, #, Join[level, #2]] &, list]
mapIndexed[f_, el_, level_] := f[el, level]

Examples:

mapIndexed[h, {a, b, c, {d, {e, f}}}]

{h[a, {1}], h[b, {2}], h[c, {3}], {h[d, {4, 1}], {h[e, {4, 2, 1}], h[f, {4, 2, 2}]}}}

mapIndexed[h, {a, q Sqrt[r], {{{e + f g h}, c^d}, b}}]

{h[a, {1}], h[q Sqrt[r], {2}], {{{h[e + f g h, {3, 1, 1, 1}]}, h[c^d, {3, 1, 2}]}, h[b, {3, 2}]}}

It could be that Mr.Wizard's solution is more general still (it assumes that the outer head of expr is List, I assume the head is List, period) but this works for nested lists and could be adapted for other heads as well. For the list ConstantArray[{a, q Sqrt[r], {{{e + f g h}, c^d}, b}}, 10000]; this solution is about twice as fast as Mr.Wizard's solution, 0.44 seconds versus 0.95 seconds.

Answer 2

Interesting question. Here is my proposal:

fn[f_, expr_] :=
 Module[{h},
   h[x_List, _] := x;
   h[o_[x__h], i_] := h[o @@ {x}[[All, 1]], i];
   MapIndexed[h, expr, {1, -1}] /. h -> f
 ]

Test:

fn[h, {a, q Sqrt[r], {{{e + f g h}, c^d}, b}}]

{h[a, {1}], h[q Sqrt[r], {2}], {{{h[e + f g h, {3, 1, 1, 1}]}, h[c^d, {3, 1, 2}]}, h[b, {3, 2}]}}

I assumed that the outer head of expr is List.

Answer 3

May be this is not the smarter way to do it but here is what I got:

l = {a, {b, {c^d, {e + f g}}}};
pos = ReplaceAll[(Position[l, List]), 0 -> 1];
h[l[[Sequence @@ #]], #] & /@ pos

(*{h[a, {1}], h[b, {2, 1}], h[c^d, {2, 2, 1}], h[e + f g, {2, 2, 2, 1}]}*)

If you want to keep the levels as they are then:

rule = Rule[#, h[l[[Sequence @@ #]], #]] & /@ pos;
ReplacePart[l, rule]
    (*{h[a, {1}], {h[b, {2, 1}], {h[c^d, {2, 2, 1}], {h[e + f g, {2, 2, 2, 1}]}}}}*)

Or in general:

pos = Position[l, #][[1]] & /@ Flatten[l]

Answer 4

ReplacePart

If one is willing to bend on the requirement to use MapIndexed, ReplacePart can generate the desired output directly:

$list = {a, {b, {c^d, {e + f g}}}};

ReplacePart[$list, {i:PatternSequence[2..., 1]} :> h[$list[[i]], {i}]]
(* {h[a, {1}], {h[b, {2, 1}], {h[c^d, {2, 2, 1}], {h[e + f g, {2, 2, 2, 1}]}}}} *)

MapIndexed

Alternatively, we can define an auxiliary lifting operator that adjusts a function h so that it operates only upon the desired elements of a "nested list":

nesting[h_][v_, i:{2..., 1}] := h[v, i]
nesting[h_][v_, _] := v

Then we can use it with MapIndexed:

$list = {a, {b, {c^d, {e + f g}}}};

MapIndexed[nesting[h], $list, Infinity]
(* {h[a, {1}], {h[b, {2, 1}], {h[c^d, {2, 2, 1}], {h[e + f g, {2, 2, 2, 1}]}}}} *)

But...

Watch Out For Held Expressions

Note that while the ReplacePart method operates correctly upon held subexpressions, the MapIndexed method does not:

$list2 = {a, {Hold[b, c]}};

ReplacePart[$list2, {i:PatternSequence[2..., 1]} :> h[$list2[[i]], {i}]]
(* {h[a, {1}], {h[Hold[b, c], {2, 1}]}} *)

MapIndexed[nesting[h], $list2, Infinity]
(* {h[a,{1}],{h[Hold[nesting[h][b,{2,1,1}],nesting[h][c,{2,1,2}]],{2,1}]}} *)

The problem with MapIndexed and other mapping-based approaches is that they visit all elements indiscriminately. In simple examples this is harmless, but in general it can pose a problem. ReplacePart and similar replacement-based solutions can be more discriminating and only touch the selected elements.