33
$\begingroup$

I've got a nested list

{a, b, {c, d}, e, {f, {g, h}}}

which I want to magically transmogrify to

{{1,a}, {2,b}, {{3,c}, {4,d}}, {5,e}, {{6,f}, {{7,g}, {8,h}}}}

This is just prepending a simple sequence to each element regardless of depth. I can't think of any simple way to do this in general. My stubbornly procedural brain keeps thinking of loops and recursion, but I'm sure you more functional types have a much better trick up your sleeve.

Improve this question
$\endgroup$
2
  • 1
    $\begingroup$ Will the elements be unique? This is a killer condition for some solutions using ReplaceAll. $\endgroup$
    – Yves Klett
    Mar 28, 2012 at 9:46
  • 2
    $\begingroup$ I think your question as stated is not entirely well specified: would you want {{a**x},b} to be replaced with {{{1,a**x}},{2, b}} or {{{1, a}**{2, x}},{3,b}}? You should note that the answers given will not all do the same thing for cases like that. I'd expect this could bite you once using it in practice... $\endgroup$
    – Albert Retey
    Apr 7, 2012 at 9:15

9 Answers 9

Reset to default
33
$\begingroup$

I am pretty sure that it is not the best solution but how about this?

numbering[x_] := Block[{n = 0}, Replace[x, y_ :> {++n, y}, {-1}]]

Some example outputs:

In[1]:= numbering[{a, b, {c, d}, e, {f, {g, h}}}]

Out[1]= {{1, a}, {2, b}, {{3, c}, {4, d}}, {5, e}, {{6, f}, {{7, g}, {8, h}}}}

In[2]:= numbering[Nest[{#, #} &, x, 3]]

Out[2]= {{{{1, x}, {2, x}}, {{3, x}, {4, x}}}, {{{5, x},
    {6, x}}, {{7, x}, {8, x}}}}

About the level spec {-1} (per reference):

Level -1 consists of numbers, symbols, and other objects that do not have subparts.

Sounds exactly like what you want.

Improve this answer
$\endgroup$
4
  • $\begingroup$ Your replace is safer than mine :P. +1! $\endgroup$
    – FJRA
    Mar 28, 2012 at 2:19
  • $\begingroup$ +1 for the {-1} level spec, which I had no idea existed until now. The consequences may never be the same! $\endgroup$
    – Pillsy
    Apr 6, 2012 at 20:30
  • $\begingroup$ @Pillsy Very nice use of negative levspec, indeed. There was a question on SO asked way back about it as well: stackoverflow.com/questions/6998797/… . In addition to the docs, it is also briefly discussed here. Another interesting IMO (shameless plug :)) use of it is here $\endgroup$
    – Leonid Shifrin
    Apr 6, 2012 at 20:49
  • $\begingroup$ Use of Block here is incorrect; it should be Module. Look what happens when numbering[{{a, b}, {m, n}}] is used. $\endgroup$
    – Mr.Wizard
    Jan 24, 2016 at 19:13
22
$\begingroup$

This is the same basic method as already presented by Yu-Sung Chang, but Map is more concise.
More significantly using Block is incorrect: if n appears in the input it will be incorrectly substituted.

Instead I would write:

expr = {a, b, {c, d}, e, {f, {g, h}}};

Module[{i = 1},
  Map[{i++, #} &, expr, {-1}]
]

{{1, a}, {2, b}, {{3, c}, {4, d}}, {5, e}, {{6, f}, {{7, g}, {8, h}}}}
Improve this answer
$\endgroup$
3
  • $\begingroup$ MapIndexed is even cleaner: MapIndexed[{First@#2, #1} &, expr, {-1}] $\endgroup$
    – Gustavo Delfino
    Mar 28, 2012 at 12:48
  • 6
    $\begingroup$ @GustavoDelfino: That does not work with nested lists, which get all numbered with the top-level index -> {{1, a}, {2, b}, {{3, c}, {3, d}}, {4, e}, {{5, f}, {{5, g}, {5, h}}}} $\endgroup$
    – Yves Klett
    Mar 28, 2012 at 12:58
  • $\begingroup$ @yves-klett: you are right. I works in the example shown but not for deeper lists. $\endgroup$
    – Gustavo Delfino
    Apr 4, 2012 at 19:29
18
$\begingroup$

we can also use the Listable attribute of Function:

i = 1;
Function[, {i++, #}, Listable]@{a, b, {c, d}, e, {f, {g, h}}}

or(just to explore the Listable nature):

i = 1;
Function[, {##}, Listable][i++//Unevaluated, {a, b, {c, d}, e, {f, {g, h}}}]

output: 

{{1, a}, {2, b}, {{3, c}, {4, d}}, {5, e}, {{6, f}, {{7, g}, {8, h}}}}
Improve this answer
$\endgroup$
5
  • 1
    $\begingroup$ Whoa! Function[, {i++, #},...] screams syntax error at me without the parameter or a matching & and even the front-end highlights it in red, yet it works! Could you add a short explanation of how your construct works? $\endgroup$
    – rm -rf ♦
    Apr 7, 2012 at 7:48
  • 5
    $\begingroup$ Empty arguments are equivalent to argument Null, so Function[,#,Listable] is actually Function[Null,#,Listable], which explains why it's not a syntax error (also Get sometimes complains, so Id' recommend to insert the Null). That form for Function will let you define attribtes with the last argument without forcing named arguments, which sometimes is very helpful. AFAIK this is not documented but has appeared in several posts to mathgroup and maybe also stack exchange. As for the syntax-checker of the front-end: it obviously just doesn't know about that undocumented feature... $\endgroup$
    – Albert Retey
    Apr 7, 2012 at 9:03
  • $\begingroup$ @AlbertRetey Thanks, that makes sense :) $\endgroup$
    – rm -rf ♦
    Apr 7, 2012 at 13:55
  • 2
    $\begingroup$ Very good answer. From Trace'ing Listable functions operating on homogeneous arrays I'd become used to Thread being invoked, so I expected this to work differently than it actually does. A definite +1 for revealing that Listable still holds a few surprises. $\endgroup$
    – Oleksandr R.
    Apr 11, 2012 at 17:21
  • $\begingroup$ I had thought Listable is parallelized internally. +1 $\endgroup$
    – Silvia
    Dec 28, 2013 at 6:49
14
$\begingroup$

With ReplaceAll and Increment you can do it:

i = 1;
{a, b, {c, d}, e, {f, {g, h}}} /. p : Except[List]?AtomQ :> {i++, p}

{{1, a}, {2, b}, {{3, c}, {4, d}}, {5, e}, {{6, f}, {{7, g}, {8, h}}}}

This works if a, b, etc are simple symbols... maybe is not what you need.

Improve this answer
$\endgroup$
13
$\begingroup$

I've never had a need for the MapAll (or //@) function, but this seems to be a case where it can be used:

i=0;
f[x_Symbol] := {++i, x};
f[x_List] := x

f //@ {a, b, {c, d}, e, {f, {g, h}}}
(* {{1, a}, {2, b}, {{3, c}, {4, d}}, {5, e}, {{6, f}, {{7, g}, {8, h}}}} *)
Improve this answer
$\endgroup$
2
  • $\begingroup$ I'm searching for a case where MapAll is the answer function. Have you found it yet? With this case it's excessive as you can Map with levelspec {-1}. (I like the example though, it teaches.) $\endgroup$
    – BoLe
    May 14, 2013 at 8:40
  • $\begingroup$ @BoLe Yes, certainly Map is the better solution, but I posted this 2 weeks after the others... all the obvious ones were taken :) As for MapAll, see this question and its answers. Some good examples in there. $\endgroup$
    – rm -rf ♦
    May 14, 2013 at 12:53
11
$\begingroup$

It's a little on the hairy side, but you can do it functionally (i.e., without mutating a counter) by first finding all the leaves using Position, and then replacing what you find at those positions one by one using Fold:

tree = {a, b, {c, d}, e, {f, {g, h}}};

Module[{indexLeaf},
 With[{indexedPositions = Transpose[
       {Range@Length@#, #}] &@Position[tree, _, {-1}, Heads -> False]},
  indexLeaf[tree_, {index_, position_}] :=
   MapAt[{index, #} &, tree, position]; 
  Fold[indexLeaf, tree, indexedPositions]]]

{{1, a}, {2, b}, {{3, c}, {4, d}}, {5, e}, {{6, f}, {{7, g}, {8, h}}}}

EDIT to add:

There's an alternative solution that may be a litle cleaner. It uses ReplacePart to make all the changes in one swell foop instead of relying on the ugly Fold/MapAt combo. Factoring things a bit:

ClearAll[indexedLeafPositions, indexedLeafRules, indexLeaves];

indexedLeafPositions[tree_] :=
  Transpose[{#, Range@Length@#}] &@
   Position[tree, _, {-1}, Heads -> False];

indexedLeafRules[tree_] :=
  Cases[indexedLeafPositions@tree,
   {pos_, n_} :> (pos -> {n, Extract[tree, pos]})];

indexLeaves[tree_] :=
 ReplacePart[tree, indexedLeafRules@tree];

Trying it out:

indexLeaves[tree]

{{1, a}, {2, b}, {{3, c}, {4, d}}, {5, e}, {{6, f}, {{7, g}, {8, h}}}}
Improve this answer
$\endgroup$
9
$\begingroup$

Perhaps

Module[{k = 0},
 Replace[{a, b, {c, d}, e, {f, {g, h}}}
  , i_ :> With[{index = ++k}, {i, index}/;True], {-1}]]


{{a, 1}, {b, 2}, {{c, 3}, {d, 4}}, {e, 5}, {{f, 6}, {{g, 7}, {h, 8}}}}
Improve this answer
$\endgroup$
2
  • $\begingroup$ Looks exactly like mine except With. Why do you need it? $\endgroup$
    – Yu-Sung Chang
    Mar 28, 2012 at 2:16
  • 1
    $\begingroup$ @Yu-SungChang You don't really need it. In fact, this wasn't my intention, I'll edit now (added the /;True). For nested lists, it's the same, but this would work even if instead of List you have nested Holds or heads that don't evaluate. Because the replacement is done with the counter already incremented and evaluated. $\endgroup$
    – Rojo
    Mar 28, 2012 at 2:43
1
$\begingroup$

Another side-effect free functional solution without a counter variable:

expr = {a, b, {c, d}, e, {f, {g, h}}};
MapIndexed[{#2,#1}&,expr,{-1}] /. MapThread[Rule, {Position[expr,_,{-1},Heads->False], Range[Count[expr,_,{-1}]]}]

MapIndexed first associates each atomic expression with its multi-index position in expr. Then ReplaceAll applies transformation rules to transform each multi-index position to a single-index position.

If the expression is large, using DownValues instead of transformation rules is much faster:

Module[{multiToSingleIndex},
  MapIndexed[(multiToSingleIndex[#1]=First@#2)&,Position[expr,_,{-1},Heads->False]];
  MapIndexed[{multiToSingleIndex[#2],#1}&,expr,{-1}]
]
Improve this answer
$\endgroup$
3
  • $\begingroup$ I can't see any reason that one would not want to use a counter variable as it is the natural way to do this in one pass. Nevertheless if one chooses not to I would do this a bit differently. Your first code will fail if one of the depth specifications appears literally in the original expr. Your second code looks solid. You could write the first instead like this: ReplacePart[expr, MapIndexed[# -> {#2[[1]], Extract[expr, #]} &, Position[expr, _, {-1}, Heads -> False]]] $\endgroup$
    – Mr.Wizard
    Feb 15, 2014 at 20:58
  • 1
    $\begingroup$ Most code using counters makes assumptions about the evaluation order (e.g., Map), which Mathematica does not explicitly guarantee. $\endgroup$
    – sakra
    Feb 15, 2014 at 21:47
  • 1
    $\begingroup$ Sakra, that is not a problem. The standard expression evaluation rules of Mathematica apply. As the documentation says: "Map always effectively constructs a complete new expression, and then evaluates it." Therefore the code in my answer effectively produces: {({i++, #1} &)[a], ({i++, #1} &)[b], {({i++, #1} &)[c], ({i++, #1} &)[d]}, ({i++, #1} &)[e], {({i++, #1} &)[f], {({i++, #1} &)[g], ({i++, #1} &)[h]}}} -- the evaluation order of which is not ambiguous. $\endgroup$
    – Mr.Wizard
    Feb 15, 2014 at 22:40
0
$\begingroup$ 
Partition[Riffle[Range[Length[Flatten[{a, b, {c, d}, e, {f, {g, h}}}]]], 
    Flatten[{a, b, {c, d}, e, {f, {g, h}}}]], 2]
(* {{1, a}, {2, b}, {3, c}, {4, d}, {5, e}, {6, f}, {7, g}, {8, h}} *)
Improve this answer
$\endgroup$
1
  • $\begingroup$ Your solution does not preserve original structure of the list, so it does not fit OP's requirements (see the question). $\endgroup$
    – Alexey Popkov
    Feb 15, 2014 at 10:30

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

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