Is there a way to draw a level tree












2












$begingroup$


Consider the following expression.



expr={a,{b1,b2},{c,{d1,d2}}};


One can get the levels in an expression as follows:



ClearAll[levels];
SetAttributes[levels,{HoldAllComplete}];
levels[expr_]:=Column@Table[Level[expr,{level},Heads->True],{level,0,Depth[expr]-1}];

levels[expr]


But if I look at the TreeForm it is something else.



TreeForm[expr]


Leaf count for this expression should be 10.



LeafCount[expr]


One can try to get the true level tree as follows:



Graph[{
Sequence@@(expr[UndirectedEdge]#&/@{List,a,{b1,b2},{c,{d1,d2}}}),
Sequence@@(expr[[2]][UndirectedEdge]#&/@{List2,b1,b2}),
Sequence@@(expr[[3]][UndirectedEdge]#&/@{List3,c,{d1,d2}}),
Sequence@@(expr[[3,2]][UndirectedEdge]#&/@{List4,d1,d2})
},VertexLabels->"Name"]


Is there a way to produce this graph for arbitrary expression. Also multiple vertices with the same name List get joined so I have to rename them to List1, List2, ... etc. Is there a way to fix this while keeping the layout of the graph.



Basically display Heads at the same level as their Parts which is their true position in the tree.










share|improve this question











$endgroup$

















    2












    $begingroup$


    Consider the following expression.



    expr={a,{b1,b2},{c,{d1,d2}}};


    One can get the levels in an expression as follows:



    ClearAll[levels];
    SetAttributes[levels,{HoldAllComplete}];
    levels[expr_]:=Column@Table[Level[expr,{level},Heads->True],{level,0,Depth[expr]-1}];

    levels[expr]


    But if I look at the TreeForm it is something else.



    TreeForm[expr]


    Leaf count for this expression should be 10.



    LeafCount[expr]


    One can try to get the true level tree as follows:



    Graph[{
    Sequence@@(expr[UndirectedEdge]#&/@{List,a,{b1,b2},{c,{d1,d2}}}),
    Sequence@@(expr[[2]][UndirectedEdge]#&/@{List2,b1,b2}),
    Sequence@@(expr[[3]][UndirectedEdge]#&/@{List3,c,{d1,d2}}),
    Sequence@@(expr[[3,2]][UndirectedEdge]#&/@{List4,d1,d2})
    },VertexLabels->"Name"]


    Is there a way to produce this graph for arbitrary expression. Also multiple vertices with the same name List get joined so I have to rename them to List1, List2, ... etc. Is there a way to fix this while keeping the layout of the graph.



    Basically display Heads at the same level as their Parts which is their true position in the tree.










    share|improve this question











    $endgroup$















      2












      2








      2





      $begingroup$


      Consider the following expression.



      expr={a,{b1,b2},{c,{d1,d2}}};


      One can get the levels in an expression as follows:



      ClearAll[levels];
      SetAttributes[levels,{HoldAllComplete}];
      levels[expr_]:=Column@Table[Level[expr,{level},Heads->True],{level,0,Depth[expr]-1}];

      levels[expr]


      But if I look at the TreeForm it is something else.



      TreeForm[expr]


      Leaf count for this expression should be 10.



      LeafCount[expr]


      One can try to get the true level tree as follows:



      Graph[{
      Sequence@@(expr[UndirectedEdge]#&/@{List,a,{b1,b2},{c,{d1,d2}}}),
      Sequence@@(expr[[2]][UndirectedEdge]#&/@{List2,b1,b2}),
      Sequence@@(expr[[3]][UndirectedEdge]#&/@{List3,c,{d1,d2}}),
      Sequence@@(expr[[3,2]][UndirectedEdge]#&/@{List4,d1,d2})
      },VertexLabels->"Name"]


      Is there a way to produce this graph for arbitrary expression. Also multiple vertices with the same name List get joined so I have to rename them to List1, List2, ... etc. Is there a way to fix this while keeping the layout of the graph.



      Basically display Heads at the same level as their Parts which is their true position in the tree.










      share|improve this question











      $endgroup$




      Consider the following expression.



      expr={a,{b1,b2},{c,{d1,d2}}};


      One can get the levels in an expression as follows:



      ClearAll[levels];
      SetAttributes[levels,{HoldAllComplete}];
      levels[expr_]:=Column@Table[Level[expr,{level},Heads->True],{level,0,Depth[expr]-1}];

      levels[expr]


      But if I look at the TreeForm it is something else.



      TreeForm[expr]


      Leaf count for this expression should be 10.



      LeafCount[expr]


      One can try to get the true level tree as follows:



      Graph[{
      Sequence@@(expr[UndirectedEdge]#&/@{List,a,{b1,b2},{c,{d1,d2}}}),
      Sequence@@(expr[[2]][UndirectedEdge]#&/@{List2,b1,b2}),
      Sequence@@(expr[[3]][UndirectedEdge]#&/@{List3,c,{d1,d2}}),
      Sequence@@(expr[[3,2]][UndirectedEdge]#&/@{List4,d1,d2})
      },VertexLabels->"Name"]


      Is there a way to produce this graph for arbitrary expression. Also multiple vertices with the same name List get joined so I have to rename them to List1, List2, ... etc. Is there a way to fix this while keeping the layout of the graph.



      Basically display Heads at the same level as their Parts which is their true position in the tree.







      trees






      share|improve this question















      share|improve this question













      share|improve this question




      share|improve this question








      edited 5 hours ago







      user13892

















      asked 5 hours ago









      user13892user13892

      1,089514




      1,089514






















          2 Answers
          2






          active

          oldest

          votes


















          4












          $begingroup$

          GraphComputation`ExpressionGraph[expr /. List -> (List[List, ##] &)]


          enter image description here



          TreeForm[expr /. List -> (List[List, ##] &)]


          enter image description here



          rules = List @@@ SparseArray`ExpressionToTree[expr /. List -> (List[List, ##] &)];
          edges = DirectedEdge @@@ (rules[[All, All, 2]] + 1);
          vertices = Property[#2 + 1, {VertexLabels -> #3}] & @@@ DeleteDuplicates[Flatten[rules, 1]];

          TreeGraph[vertices, edges, ImagePadding -> 40, ImageSize -> 600, VertexSize -> Medium]


          enter image description here



          Update: An alternative approach is to use the original expression with ExpressionToTree and add new edges:



          g1 = Graph[SparseArray`ExpressionToTree[{a, {b1, b2}, {c, foo[d1, d2]}}], 
          VertexLabels -> "Name", VertexLabelStyle -> 14, ImageSize -> 600]


          enter image description here



          newedges = # [DirectedEdge] 
          {Symbol[ToString[Head[First@Last[#]]] <> ToString[#[[2]]]]} & /@
          Select[VertexList[g1], Head[#[[1]]] === Symbol &];
          VertexReplace[EdgeAdd[g1, newedges], v_ :> Last[v]]


          enter image description here






          share|improve this answer











          $endgroup$





















            0












            $begingroup$

            Try the code



            levelTree[expr_] := Replace[expr, {h_[x___] -> {h, x}}, {0, Infinity}];    
            levelTree @ {a, {b1, b2}, {c, {d1, d2}}}


            which returns



            {List, a, {List, b1, b2}, {List, c, {List, d1, d2}}}


            A simple exmaple



            levelTree[a b + c d]


            which returns



            {Plus, {Times, a, b}, {Times, c, d}}


            I like the lispy variation



            levelTree[expr_] := Replace[expr, (h : Except[List])[x___] -> {h, x}, {0, Infinity}];
            levelTree @ plus[car[{1, 2}], cdr[{3, 4}]]


            which returns



            {plus, {car, {1, 2}}, {cdr, {3, 4}}}


            Given any of these results, you can now use TreeForm or ExpressionGraph or some other custom Graph display.






            share|improve this answer











            $endgroup$













              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%2f191909%2fis-there-a-way-to-draw-a-level-tree%23new-answer', 'question_page');
              }
              );

              Post as a guest















              Required, but never shown

























              2 Answers
              2






              active

              oldest

              votes








              2 Answers
              2






              active

              oldest

              votes









              active

              oldest

              votes






              active

              oldest

              votes









              4












              $begingroup$

              GraphComputation`ExpressionGraph[expr /. List -> (List[List, ##] &)]


              enter image description here



              TreeForm[expr /. List -> (List[List, ##] &)]


              enter image description here



              rules = List @@@ SparseArray`ExpressionToTree[expr /. List -> (List[List, ##] &)];
              edges = DirectedEdge @@@ (rules[[All, All, 2]] + 1);
              vertices = Property[#2 + 1, {VertexLabels -> #3}] & @@@ DeleteDuplicates[Flatten[rules, 1]];

              TreeGraph[vertices, edges, ImagePadding -> 40, ImageSize -> 600, VertexSize -> Medium]


              enter image description here



              Update: An alternative approach is to use the original expression with ExpressionToTree and add new edges:



              g1 = Graph[SparseArray`ExpressionToTree[{a, {b1, b2}, {c, foo[d1, d2]}}], 
              VertexLabels -> "Name", VertexLabelStyle -> 14, ImageSize -> 600]


              enter image description here



              newedges = # [DirectedEdge] 
              {Symbol[ToString[Head[First@Last[#]]] <> ToString[#[[2]]]]} & /@
              Select[VertexList[g1], Head[#[[1]]] === Symbol &];
              VertexReplace[EdgeAdd[g1, newedges], v_ :> Last[v]]


              enter image description here






              share|improve this answer











              $endgroup$


















                4












                $begingroup$

                GraphComputation`ExpressionGraph[expr /. List -> (List[List, ##] &)]


                enter image description here



                TreeForm[expr /. List -> (List[List, ##] &)]


                enter image description here



                rules = List @@@ SparseArray`ExpressionToTree[expr /. List -> (List[List, ##] &)];
                edges = DirectedEdge @@@ (rules[[All, All, 2]] + 1);
                vertices = Property[#2 + 1, {VertexLabels -> #3}] & @@@ DeleteDuplicates[Flatten[rules, 1]];

                TreeGraph[vertices, edges, ImagePadding -> 40, ImageSize -> 600, VertexSize -> Medium]


                enter image description here



                Update: An alternative approach is to use the original expression with ExpressionToTree and add new edges:



                g1 = Graph[SparseArray`ExpressionToTree[{a, {b1, b2}, {c, foo[d1, d2]}}], 
                VertexLabels -> "Name", VertexLabelStyle -> 14, ImageSize -> 600]


                enter image description here



                newedges = # [DirectedEdge] 
                {Symbol[ToString[Head[First@Last[#]]] <> ToString[#[[2]]]]} & /@
                Select[VertexList[g1], Head[#[[1]]] === Symbol &];
                VertexReplace[EdgeAdd[g1, newedges], v_ :> Last[v]]


                enter image description here






                share|improve this answer











                $endgroup$
















                  4












                  4








                  4





                  $begingroup$

                  GraphComputation`ExpressionGraph[expr /. List -> (List[List, ##] &)]


                  enter image description here



                  TreeForm[expr /. List -> (List[List, ##] &)]


                  enter image description here



                  rules = List @@@ SparseArray`ExpressionToTree[expr /. List -> (List[List, ##] &)];
                  edges = DirectedEdge @@@ (rules[[All, All, 2]] + 1);
                  vertices = Property[#2 + 1, {VertexLabels -> #3}] & @@@ DeleteDuplicates[Flatten[rules, 1]];

                  TreeGraph[vertices, edges, ImagePadding -> 40, ImageSize -> 600, VertexSize -> Medium]


                  enter image description here



                  Update: An alternative approach is to use the original expression with ExpressionToTree and add new edges:



                  g1 = Graph[SparseArray`ExpressionToTree[{a, {b1, b2}, {c, foo[d1, d2]}}], 
                  VertexLabels -> "Name", VertexLabelStyle -> 14, ImageSize -> 600]


                  enter image description here



                  newedges = # [DirectedEdge] 
                  {Symbol[ToString[Head[First@Last[#]]] <> ToString[#[[2]]]]} & /@
                  Select[VertexList[g1], Head[#[[1]]] === Symbol &];
                  VertexReplace[EdgeAdd[g1, newedges], v_ :> Last[v]]


                  enter image description here






                  share|improve this answer











                  $endgroup$



                  GraphComputation`ExpressionGraph[expr /. List -> (List[List, ##] &)]


                  enter image description here



                  TreeForm[expr /. List -> (List[List, ##] &)]


                  enter image description here



                  rules = List @@@ SparseArray`ExpressionToTree[expr /. List -> (List[List, ##] &)];
                  edges = DirectedEdge @@@ (rules[[All, All, 2]] + 1);
                  vertices = Property[#2 + 1, {VertexLabels -> #3}] & @@@ DeleteDuplicates[Flatten[rules, 1]];

                  TreeGraph[vertices, edges, ImagePadding -> 40, ImageSize -> 600, VertexSize -> Medium]


                  enter image description here



                  Update: An alternative approach is to use the original expression with ExpressionToTree and add new edges:



                  g1 = Graph[SparseArray`ExpressionToTree[{a, {b1, b2}, {c, foo[d1, d2]}}], 
                  VertexLabels -> "Name", VertexLabelStyle -> 14, ImageSize -> 600]


                  enter image description here



                  newedges = # [DirectedEdge] 
                  {Symbol[ToString[Head[First@Last[#]]] <> ToString[#[[2]]]]} & /@
                  Select[VertexList[g1], Head[#[[1]]] === Symbol &];
                  VertexReplace[EdgeAdd[g1, newedges], v_ :> Last[v]]


                  enter image description here







                  share|improve this answer














                  share|improve this answer



                  share|improve this answer








                  edited 4 mins ago

























                  answered 4 hours ago









                  kglrkglr

                  185k10202420




                  185k10202420























                      0












                      $begingroup$

                      Try the code



                      levelTree[expr_] := Replace[expr, {h_[x___] -> {h, x}}, {0, Infinity}];    
                      levelTree @ {a, {b1, b2}, {c, {d1, d2}}}


                      which returns



                      {List, a, {List, b1, b2}, {List, c, {List, d1, d2}}}


                      A simple exmaple



                      levelTree[a b + c d]


                      which returns



                      {Plus, {Times, a, b}, {Times, c, d}}


                      I like the lispy variation



                      levelTree[expr_] := Replace[expr, (h : Except[List])[x___] -> {h, x}, {0, Infinity}];
                      levelTree @ plus[car[{1, 2}], cdr[{3, 4}]]


                      which returns



                      {plus, {car, {1, 2}}, {cdr, {3, 4}}}


                      Given any of these results, you can now use TreeForm or ExpressionGraph or some other custom Graph display.






                      share|improve this answer











                      $endgroup$


















                        0












                        $begingroup$

                        Try the code



                        levelTree[expr_] := Replace[expr, {h_[x___] -> {h, x}}, {0, Infinity}];    
                        levelTree @ {a, {b1, b2}, {c, {d1, d2}}}


                        which returns



                        {List, a, {List, b1, b2}, {List, c, {List, d1, d2}}}


                        A simple exmaple



                        levelTree[a b + c d]


                        which returns



                        {Plus, {Times, a, b}, {Times, c, d}}


                        I like the lispy variation



                        levelTree[expr_] := Replace[expr, (h : Except[List])[x___] -> {h, x}, {0, Infinity}];
                        levelTree @ plus[car[{1, 2}], cdr[{3, 4}]]


                        which returns



                        {plus, {car, {1, 2}}, {cdr, {3, 4}}}


                        Given any of these results, you can now use TreeForm or ExpressionGraph or some other custom Graph display.






                        share|improve this answer











                        $endgroup$
















                          0












                          0








                          0





                          $begingroup$

                          Try the code



                          levelTree[expr_] := Replace[expr, {h_[x___] -> {h, x}}, {0, Infinity}];    
                          levelTree @ {a, {b1, b2}, {c, {d1, d2}}}


                          which returns



                          {List, a, {List, b1, b2}, {List, c, {List, d1, d2}}}


                          A simple exmaple



                          levelTree[a b + c d]


                          which returns



                          {Plus, {Times, a, b}, {Times, c, d}}


                          I like the lispy variation



                          levelTree[expr_] := Replace[expr, (h : Except[List])[x___] -> {h, x}, {0, Infinity}];
                          levelTree @ plus[car[{1, 2}], cdr[{3, 4}]]


                          which returns



                          {plus, {car, {1, 2}}, {cdr, {3, 4}}}


                          Given any of these results, you can now use TreeForm or ExpressionGraph or some other custom Graph display.






                          share|improve this answer











                          $endgroup$



                          Try the code



                          levelTree[expr_] := Replace[expr, {h_[x___] -> {h, x}}, {0, Infinity}];    
                          levelTree @ {a, {b1, b2}, {c, {d1, d2}}}


                          which returns



                          {List, a, {List, b1, b2}, {List, c, {List, d1, d2}}}


                          A simple exmaple



                          levelTree[a b + c d]


                          which returns



                          {Plus, {Times, a, b}, {Times, c, d}}


                          I like the lispy variation



                          levelTree[expr_] := Replace[expr, (h : Except[List])[x___] -> {h, x}, {0, Infinity}];
                          levelTree @ plus[car[{1, 2}], cdr[{3, 4}]]


                          which returns



                          {plus, {car, {1, 2}}, {cdr, {3, 4}}}


                          Given any of these results, you can now use TreeForm or ExpressionGraph or some other custom Graph display.







                          share|improve this answer














                          share|improve this answer



                          share|improve this answer








                          edited 55 mins ago

























                          answered 4 hours ago









                          SomosSomos

                          1,12819




                          1,12819






























                              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%2f191909%2fis-there-a-way-to-draw-a-level-tree%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

                              A CLEAN and SIMPLE way to add appendices to Table of Contents and bookmarks

                              Calculate evaluation metrics using cross_val_predict sklearn

                              Insert data from modal to MySQL (multiple modal on website)