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












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.










share|improve this question











$endgroup$

















    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.










    share|improve this question











    $endgroup$















      13












      13








      13


      3



      $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.










      share|improve this question











      $endgroup$




      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.







      list-manipulation data-structures trees






      share|improve this question















      share|improve this question













      share|improve this question




      share|improve this question








      edited Mar 31 at 8:51







      Roman

















      asked Mar 29 at 21:15









      RomanRoman

      4,3151127




      4,3151127






















          6 Answers
          6






          active

          oldest

          votes


















          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}





          share|improve this answer









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





          share|improve this answer









          $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?






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





            share|improve this answer









            $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 *)





            share|improve this answer











            $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.






            share|improve this answer









            $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





            StackExchange.ifUsing("editor", function () {
            return StackExchange.using("mathjaxEditing", function () {
            StackExchange.MarkdownEditor.creationCallbacks.add(function (editor, postfix) {
            StackExchange.mathjaxEditing.prepareWmdForMathJax(editor, postfix, [["$", "$"], ["\\(","\\)"]]);
            });
            });
            }, "mathjax-editing");

            StackExchange.ready(function() {
            var channelOptions = {
            tags: "".split(" "),
            id: "387"
            };
            initTagRenderer("".split(" "), "".split(" "), channelOptions);

            StackExchange.using("externalEditor", function() {
            // Have to fire editor after snippets, if snippets enabled
            if (StackExchange.settings.snippets.snippetsEnabled) {
            StackExchange.using("snippets", function() {
            createEditor();
            });
            }
            else {
            createEditor();
            }
            });

            function createEditor() {
            StackExchange.prepareEditor({
            heartbeatType: 'answer',
            autoActivateHeartbeat: false,
            convertImagesToLinks: false,
            noModals: true,
            showLowRepImageUploadWarning: true,
            reputationToPostImages: null,
            bindNavPrevention: true,
            postfix: "",
            imageUploader: {
            brandingHtml: "Powered by u003ca class="icon-imgur-white" href="https://imgur.com/"u003eu003c/au003e",
            contentPolicyHtml: "User contributions licensed under u003ca href="https://creativecommons.org/licenses/by-sa/3.0/"u003ecc by-sa 3.0 with attribution requiredu003c/au003e u003ca href="https://stackoverflow.com/legal/content-policy"u003e(content policy)u003c/au003e",
            allowUrls: true
            },
            onDemand: true,
            discardSelector: ".discard-answer"
            ,immediatelyShowMarkdownHelp:true
            });


            }
            });














            draft saved

            draft discarded


















            StackExchange.ready(
            function () {
            StackExchange.openid.initPostLogin('.new-post-login', 'https%3a%2f%2fmathematica.stackexchange.com%2fquestions%2f194217%2fhow-to-invert-mapindexed-on-a-ragged-structure-how-to-construct-a-tree-from-rul%23new-answer', 'question_page');
            }
            );

            Post as a guest















            Required, but never shown

























            6 Answers
            6






            active

            oldest

            votes








            6 Answers
            6






            active

            oldest

            votes









            active

            oldest

            votes






            active

            oldest

            votes









            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}





            share|improve this answer









            $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
















            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}





            share|improve this answer









            $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














            5












            5








            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}





            share|improve this answer









            $endgroup$



            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}






            share|improve this answer












            share|improve this answer



            share|improve this answer










            answered Mar 29 at 21:28









            b3m2a1b3m2a1

            28.5k359164




            28.5k359164












            • $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


















            • $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
















            $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$
            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$
            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




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





            share|improve this answer









            $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
















            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}





            share|improve this answer









            $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














            7












            7








            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}





            share|improve this answer









            $endgroup$



            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}






            share|improve this answer












            share|improve this answer



            share|improve this answer










            answered Mar 29 at 21:39









            b3m2a1b3m2a1

            28.5k359164




            28.5k359164












            • $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


















            • $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
















            $begingroup$
            What does the Block[{Nothing}, ...] wrapper do?
            $endgroup$
            – Roman
            Mar 30 at 14:30




            $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$
            @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




            $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?






            share|improve this answer











            $endgroup$


















              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?






              share|improve this answer











              $endgroup$
















                4












                4








                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?






                share|improve this answer











                $endgroup$



                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?







                share|improve this answer














                share|improve this answer



                share|improve this answer








                edited Mar 31 at 17:51

























                answered Mar 30 at 20:21









                RomanRoman

                4,3151127




                4,3151127























                    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}





                    share|improve this answer









                    $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
















                    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}





                    share|improve this answer









                    $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














                    3












                    3








                    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}





                    share|improve this answer









                    $endgroup$



                    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}






                    share|improve this answer












                    share|improve this answer



                    share|improve this answer










                    answered Mar 29 at 21:38









                    b3m2a1b3m2a1

                    28.5k359164




                    28.5k359164












                    • $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


















                    • $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
















                    $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




                    $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 *)





                    share|improve this answer











                    $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


















                    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 *)





                    share|improve this answer











                    $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
















                    2












                    2








                    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 *)





                    share|improve this answer











                    $endgroup$



                    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 *)






                    share|improve this answer














                    share|improve this answer



                    share|improve this answer








                    edited Mar 30 at 19:41

























                    answered Mar 30 at 19:35









                    SilviaSilvia

                    23k269133




                    23k269133












                    • $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




















                    • $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


















                    $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$
                    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$
                    @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$
                    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






                    $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.






                    share|improve this answer









                    $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
















                    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.






                    share|improve this answer









                    $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














                    0












                    0








                    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.






                    share|improve this answer









                    $endgroup$



                    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.







                    share|improve this answer












                    share|improve this answer



                    share|improve this answer










                    answered Mar 30 at 8:15









                    High Performance MarkHigh Performance Mark

                    636512




                    636512












                    • $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


















                    • $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
















                    $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$
                    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




                    $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


















                    draft saved

                    draft discarded




















































                    Thanks for contributing an answer to Mathematica Stack Exchange!


                    • Please be sure to answer the question. Provide details and share your research!

                    But avoid



                    • Asking for help, clarification, or responding to other answers.

                    • Making statements based on opinion; back them up with references or personal experience.


                    Use MathJax to format equations. MathJax reference.


                    To learn more, see our tips on writing great answers.




                    draft saved


                    draft discarded














                    StackExchange.ready(
                    function () {
                    StackExchange.openid.initPostLogin('.new-post-login', 'https%3a%2f%2fmathematica.stackexchange.com%2fquestions%2f194217%2fhow-to-invert-mapindexed-on-a-ragged-structure-how-to-construct-a-tree-from-rul%23new-answer', 'question_page');
                    }
                    );

                    Post as a guest















                    Required, but never shown





















































                    Required, but never shown














                    Required, but never shown












                    Required, but never shown







                    Required, but never shown

































                    Required, but never shown














                    Required, but never shown












                    Required, but never shown







                    Required, but never shown







                    Popular posts from this blog

                    Plaza Victoria

                    In PowerPoint, is there a keyboard shortcut for bulleted / numbered list?

                    How to put 3 figures in Latex with 2 figures side by side and 1 below these side by side images but in...