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.

$\endgroup$
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}
$\endgroup$
  • $\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 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 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 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}
$\endgroup$
  • $\begingroup$ What does the Block[{Nothing}, ...] wrapper do? $\endgroup$ – Roman Mar 30 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 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 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?

$\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}
$\endgroup$
  • $\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 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 *)
$\endgroup$
  • $\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 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 at 19:57
  • $\begingroup$ I agree with you. The idea is to add a bit of flexibility and fault tolerance. $\endgroup$ – Roman Mar 30 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 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.

$\endgroup$
  • $\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 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 at 8:39

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.