# How to invert MapIndexed on a ragged structure? How to construct a tree from rules?

I have an arbitrary ragged nested list-of-lists (a tree) like

A = {{a, b}, {c, d}, {{{e, f, g, h, i}, {j, k, l}}, m}, n};


Its structure is given by the rules

B = Flatten[MapIndexed[#2 -> #1 &, A, {-1}]]


{{1, 1} -> a, {1, 2} -> b, {2, 1} -> c, {2, 2} -> d, {3, 1, 1, 1} -> e, {3, 1, 1, 2} -> f, {3, 1, 1, 3} -> g, {3, 1, 1, 4} -> h, {3, 1, 1, 5} -> i, {3, 1, 2, 1} -> j, {3, 1, 2, 2} -> k, {3, 1, 2, 3} -> l, {3, 2} -> m, {4} -> n}

How can I invert this operation? How can I construct A solely from the information given in B?

Thanks to all for contributing so far!

For robustness and versatility it would be nice for a solution to accept incomplete input like B = {{2} -> 1} and still generate {0,1}, not just {1}.

Also, there are some very deep trees to be constructed, like B = {ConstantArray[2, 100] -> 1}. A certain parsimony is required to be able to construct such trees within reasonable time.

Here's an inefficient but reasonably simple way:

groupMe[rules_] :=
Values@GroupBy[
rules,
(#[[1, 1]] &) ->
(If[Length[#[]] === 1, #[], #[[1, 2 ;;]] -> #[]] &),
groupMe
],
rules[]
]

groupMe[B]

{{a, b}, {c, d}, {{{e, f, g, h, i}, {j, k, l}}, m}, n}

• Thanks for your efforts, b3m2a1! Your solutions of course all work, and this one I find the most appealing because of its parsimonious recursive nature. Cheers! Mar 30, 2019 at 7:37
• Your use of Values makes a lot of assumptions about the list B. Better to define something like sortedvalues[a_Association] := Lookup[a, Range[Max[Keys[a]]], Null]. Like this you get the same with groupMe[B] and groupMe[Reverse[B]] etc. Mar 30, 2019 at 9:08
• Recursive GroupBy must be the most powerful structural operator I've come across so far. Thanks for enlightening us on its use! Mar 30, 2019 at 21:05

Here's a procedural way:

Block[
{Nothing},
Module[
{m = Max[Length /@ Keys[B]], arr},
arr = ConstantArray[Nothing, Max /@ Transpose[PadRight[#, m] & /@ Keys[B]]];
Map[Function[arr[[Sequence @@ #[]]] = #[]], B];
arr
]
]

{{a, b}, {c, d}, {{{e, f, g, h, i}, {j, k, l}}, m}, n}

• What does the Block[{Nothing}, ...] wrapper do? Mar 30, 2019 at 14:30
• @Roman haven’t tested I’d it’d work without it but usually making an array of Nothing should become a bunch of empty lists so I figured I’d block that behavior while assigning parts. Mar 30, 2019 at 18:14
• This solution does not fill in blanks, that is, for B={{2}->1} it returns {1} instead of {0,1}. Is there a way to fix this? Mar 30, 2019 at 19:53

Here is a completed and cleaned-up version of b3m2a1's recursive solution based on the powerful GroupBy operator:

PositiveIntegerQ[x_] := IntegerQ[x] && Positive[x]
ruleFirst[L_ /; VectorQ[L, PositiveIntegerQ] -> _] := First[L]
ruleFirst[i_?PositiveIntegerQ -> _] := i
ruleRest[(_?PositiveIntegerQ | {_?PositiveIntegerQ}) -> c_] := c
ruleRest[L_ /; VectorQ[L, PositiveIntegerQ] -> c_] := Rest[L] -> c
sortedValues[a_Association] := Lookup[a, Range[Max[Keys[a]]], 0]
toTree[rules : {___, _Rule, ___}] :=
sortedValues@GroupBy[Cases[rules, _Rule], ruleFirst -> ruleRest, toTree]
toTree[rule_Rule] := toTree[{rule}]
toTree[c_List] := Last[c]
toTree[c_] := c
toTree[] = toTree[{}] = {};


This solution mirrors many of SparseArray's capabilities, like setting unmentioned (but necessary) elements to zero:

toTree[5 -> 1]


{0, 0, 0, 0, 1}

It also cleans up conflicting entries, only keeping the deepest one, or the last one if there are equivalent entries:

toTree[{1 -> 1, 1 -> 2}]


{2}

toTree[{{1, 2} -> 3, 1 -> 1}]


{{0, 3}}

Unlike the solutions that work by selective pruning a huge high-rank tensor, this solution only constructs what is needed. For this reason it can work out situations like

toTree[ConstantArray[2, 100] -> 1]


{0,{0,{0,{0,{0,{0,{0,{0,{0,{0,{0,{0,{0,{0,{0,{0,{0,{0,{0,{0,{0,{0,{0,{0,{0,{0,{0,{0,{0,{0,{0,{0,{0,{0,{0,{0,{0,{0,{0,{0,{0,{0,{0,{0,{0,{0,{0,{0,{0,{0,{0,{0,{0,{0,{0,{0,{0,{0,{0,{0,{0,{0,{0,{0,{0,{0,{0,{0,{0,{0,{0,{0,{0,{0,{0,{0,{0,{0,{0,{0,{0,{0,{0,{0,{0,{0,{0,{0,{0,{0,{0,{0,{0,{0,{0,{0,{0,{0,{0,{0,1}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}

Can you think of any other edge cases that need to be considered?

Here's a convoluted way using pattern replacements:

DeleteCases[
With[{m = Max[Length /@ Keys[B]]},
Array[
List,
Max /@ Transpose[PadRight[#, m] & /@ Keys[B]]
] /.
Map[
Fold[
Insert[
{#, ___},
_,
Append[ConstantArray[1, #2], -1]] &,
#[],
Range[m - Length[#[]]]
] -> #[] &,
B
]
],
{__Integer},
Infinity
]

{{a, b}, {c, d}, {{{e, f, g, h, i}, {j, k, l}}, m}, n}

• This solution does not fill in blanks, that is, for B={{2}->1} it returns {1} instead of {0,1}. Is there a way to fix this? Mar 30, 2019 at 19:54

Here is a more functional (but memory-inefficient) version where no temporary variables are used. In the meantime the readability is "manageable". It works mostly like b3m2a1's this answer.

First a helper function branch:

branch = Through@*{##}&


The main function ruleRevert is defined as the following:

ruleRevert = RightComposition[
branch[
ReplacePart
, (* make a rectangular array compatible with B: *)
RightComposition[
Keys
, (* find max size of each level: *)
MapIndexed[#2[] -> #1 &, #, {-1}] &, Merge[Max], KeySort, Values
, (* make rectangular array : *)
ConstantArray[Inactive[Sequence][], #] &
]
]
, (* replace elements in rect-array with corresponding elements in B: *)
Apply @ Construct
, (* remove extra Inactive[Sequence][] : *)
Activate
]


It's easy to verify

ruleRevert[B] == A
(* True *)

• Thanks Silvia! Your solution does not fill in blanks, that is, for ruleRevert[{{2}->1}] it returns {1} instead of {0,1}. Is there a way to fix this? Mar 30, 2019 at 19:51
• @Roman Good point. But shouldn't {0,1} be corresponding to {{1}->0,{2}->1} (through Flatten[MapIndexed[#2->#1&,{0,1},{-1}]])? In that case we do have ruleRevert[{{1}->0,{2}->1}] == {0,1}.. Mar 30, 2019 at 19:57
• I agree with you. The idea is to add a bit of flexibility and fault tolerance. Mar 30, 2019 at 20:22
• @Roman I tried removing {1, 1} -> a in B from your question. I think the main issue here is that it's hard to tell the shape/depth of the unspecified part. But if we restrict it to the most shallow level, something like ReplaceRepeated with proper pattern should do the trick. (It's very late here, maybe I shall review it tomorrow.) Mar 30, 2019 at 20:30

This

toTree[l_]:=Quiet[GatherBy[Keys[l],Table[With[{i=i},Function[Part[Slot,i]]],
{i,Max[Length/@Keys[l]]}]]/.l//.List[x_]->x]


seems to meet OP's requirements, and has passed a tiny battery of tests. Wrapping the rhs in Quiet suppresses some complaints that Part makes when digging too deeply into the leaves of the tree.

• Hi Mark, your solution doesn't work on A={0} and B={{1}->0}: on toTree[B] it returns 0. Mar 30, 2019 at 8:32
• Well, I'm not terribly surprised, I only gave it a few tests. If I have any more time to waste ( :-) ) on this I'll have another look. Mar 30, 2019 at 8:39