13
$\begingroup$

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?

Edit: additional requirements

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.

Improve this question
$\endgroup$

6 Answers 6

Reset to default
5
$\begingroup$

Here's an inefficient but reasonably simple way:

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

groupMe[B]

{{a, b}, {c, d}, {{{e, f, g, h, i}, {j, k, l}}, m}, n}
Improve this answer
$\endgroup$
3
  • $\begingroup$ 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! $\endgroup$
    – Roman
    Mar 30, 2019 at 7:37
  • $\begingroup$ 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. $\endgroup$
    – Roman
    Mar 30, 2019 at 9:08
  • $\begingroup$ Recursive GroupBy must be the most powerful structural operator I've come across so far. Thanks for enlightening us on its use! $\endgroup$
    – Roman
    Mar 30, 2019 at 21:05
7
$\begingroup$

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 @@ #[[1]]]] = #[[2]]], B];
  arr
  ]
 ]

{{a, b}, {c, d}, {{{e, f, g, h, i}, {j, k, l}}, m}, n}
Improve this answer
$\endgroup$
3
  • $\begingroup$ What does the Block[{Nothing}, ...] wrapper do? $\endgroup$
    – Roman
    Mar 30, 2019 at 14:30
  • $\begingroup$ @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. $\endgroup$
    – b3m2a1
    Mar 30, 2019 at 18:14
  • $\begingroup$ 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? $\endgroup$
    – Roman
    Mar 30, 2019 at 19:53
4
$\begingroup$

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?

Improve this answer
$\endgroup$
3
$\begingroup$

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]] &,
        #[[1]], 
       Range[m - Length[#[[1]]]]
       ] -> #[[2]] &, 
    B
    ]
  ],
 {__Integer},
 Infinity
 ]

{{a, b}, {c, d}, {{{e, f, g, h, i}, {j, k, l}}, m}, n}
Improve this answer
$\endgroup$
1
  • $\begingroup$ 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? $\endgroup$
    – Roman
    Mar 30, 2019 at 19:54
2
$\begingroup$

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[[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 *)
Improve this answer
$\endgroup$
4
  • $\begingroup$ 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? $\endgroup$
    – Roman
    Mar 30, 2019 at 19:51
  • $\begingroup$ @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}.. $\endgroup$
    – Silvia
    Mar 30, 2019 at 19:57
  • $\begingroup$ I agree with you. The idea is to add a bit of flexibility and fault tolerance. $\endgroup$
    – Roman
    Mar 30, 2019 at 20:22
  • $\begingroup$ @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.) $\endgroup$
    – Silvia
    Mar 30, 2019 at 20:30
0
$\begingroup$

This

toTree[l_]:=Quiet[GatherBy[Keys[l],Table[With[{i=i},Function[Part[Slot[1],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.

Improve this answer
$\endgroup$
2
  • $\begingroup$ Hi Mark, your solution doesn't work on A={0} and B={{1}->0}: on toTree[B] it returns 0. $\endgroup$
    – Roman
    Mar 30, 2019 at 8:32
  • $\begingroup$ 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. $\endgroup$
    – High Performance Mark
    Mar 30, 2019 at 8:39

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service and acknowledge that you have read and understand our privacy policy and code of conduct.

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