Make MapIndexed listable

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

-
For the first two levels you get h[a, {1}] and h[b, {2, 1}], but then on deeper levels you have e.g. h[c^d], {2, 2, 1} instead of h[c^d, {2, 2, 1}] as I would expect from how your pattern begins. Explanation? –  Pickett Aug 22 '14 at 4:45
Thanks for noticing. You are correct; I typed it out by hand so I made some mistakes. –  seismatica Aug 22 '14 at 5:57

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.

-
Could you help me understand your approach a little bit more? I'm not very familiar with recursion but your answer is very interesting and I would like to use that to learn a bit more about recursion in MMA. –  seismatica Aug 24 '14 at 6:01
@seismatica This is plain recursion, that is not MMA specific. The key to understand it is to understand what mapIndexed does to one level. Imagine you take list of values and you put it into mapIndexed, what happens? And then when you understand that you'll see that if there are any lists in that list, mapIndexed will be applied to it, and the same thing will happen to that list, and any lists in that list. And that's why you should focus on understanding what happens to just one list. The second row is the stop condition; when this applies it doesn't apply itself and recursion stops. –  Pickett Aug 24 '14 at 8:49
Nice solution. +1 :-) –  Mr.Wizard Aug 24 '14 at 9:19

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.

-

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]

-
I like this idea. (+1) However I think it would be best if this worked on all elements of a List rather than only the first, though perhaps this is all the OP wants. –  Mr.Wizard Aug 22 '14 at 6:36
@Mr.Wizard Thanks for the up voting. If I can find a way to get the index of all lists elements, then this method will work perfect. –  Algohi Aug 22 '14 at 19:32

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.

-