Search code examples
graphwolfram-mathematica

TreeForm without overlap


I sometimes run into the problem of labels in TreeForm being unreadable because of overlap. An example is below, can anyone see a way to get rid of overlap?

{{4, 5, 6}, {{{2, 4, 5, 6}, {{{1, 2, 4}, {}}, {{2, 3, 6}, {}}}}, {{4, 
     5, 6, 8}, {{{4, 7, 8}, {}}, {{6, 8, 9}, {}}}}}} // TreeForm


(source: yaroslavvb.com)

Belisarius' solution helps with overlap, but loses Tooltips, ie compare with

TreeForm[Hold[
  GraphPlotHighlight[edges : {((_ -> _) | {_ -> _, _}) ...}, 
    hl : {___} : {}, opts : OptionsPattern[]] := 
   Module[{verts, coords, g, sub}, 5]]]


(source: yaroslavvb.com)

Answer update 11/12 I ended up using code below (belisarius' code with a minor fix)

myTreeForm[exp_] := 
  Module[{tooltipText, i}, 
   tooltipText = 
    Cases[Cases[MakeBoxes[TreeForm@exp, StandardForm], 
      TooltipBox[x__] -> x, 7, Heads -> True], 
     TagBox[x__, y__] -> DisplayForm[First@{x}], Heads -> True];
   i = 0;
   TreeForm[exp, 
    VertexRenderingFunction -> ({Tooltip[
         Inset[Rasterize[Text[" " <> ToString@#2 <> " "], 
           Background -> LightBlue], #1], tooltipText[[i++]]]} &)]];

Solution

  • I did this before, but never generalized the result.

        rectOffset = {.25,.1};
        fontSize = 10
        TreeForm[list, 
              VertexRenderingFunction -> ({White, EdgeForm[Black], 
              Rectangle[#1 - rectOffset, #1 + rectOffset], Black, 
              Text[ Style[#2, fontSize], #1]} &)]
    

    alt text

    Edit With Tooltips

    Using a "different approach"

    Code is dirty, sorry no time to clean it up right now

    rectOffset = {.33, .1};
    fontSize = 9;
    p = Cases[
       Cases[MakeBoxes[TreeForm@list, StandardForm], TooltipBox[x__] -> x,
         7, Heads -> True], TagBox[x__, y__] -> DisplayForm[First@{x}], 
       Heads -> True];
    i = 0;
    TreeForm[list, 
     VertexRenderingFunction -> ({White, EdgeForm[Black], 
         Rectangle[#1 - rectOffset, #1 + rectOffset], Black, 
         Tooltip[Text[Style[#2, fontSize], #1], p[[i++]]]} &)]  
    

    Output

    alt text

    Edit 2

    I think this version is better:

    Clear["Global`*"];
    list = Hold[
       GraphPlotHighlight[edges : {((_ -> _) | {_ -> _, _}) ...}, 
         hl : {___} : {}, opts : OptionsPattern[]] := 
        Module[{verts, coords, g, sub}, 5]];
    
    myTreeForm[exp_] :=
    
      Module[{ps, tooltipText, i},
    
       ps[text_] := Rasterize[Text[Style[text]], "RasterSize"];
    
       tooltipText = 
        Cases[Cases[MakeBoxes[TreeForm@list, StandardForm], 
          TooltipBox[x__] -> x, 7, Heads -> True], 
         TagBox[x__, y__] -> DisplayForm[First@{x}], Heads -> True];
    
       i = 0;
    
       TreeForm[list,
        EdgeRenderingFunction -> ({Red, Line[#1]} &), 
        VertexRenderingFunction -> ({White, EdgeForm[Black], {}, Black,
            Tooltip[
             Inset[Rasterize[Text[" " <> ToString@#2 <> " "], 
               Background -> LightBlue], #1], tooltipText[[i++]]]} &)]
       ];
    
    list // myTreeForm  
    

    Output:

    alt text

    Edit 4 ... and last one

    Cleaned up code, remove spurious functions and variables that were there just to complicate things:

    myTreeForm[list_] := Module[{tooltipText, i},  
    
       tooltipText =   
             Cases[Cases[MakeBoxes[TreeForm@list, StandardForm],   
                        TooltipBox[x__] -> x, 7, Heads -> True],   
                  TagBox[x__, y__] -> DisplayForm[First@{x}], Heads -> True];  
       i = 0;  
       TreeForm[list,  
               VertexRenderingFunction ->  
                 ({Tooltip[Inset[Rasterize[Text[" " <> ToString@#2 <> " "], 
                           Background -> LightBlue], #1], tooltipText[[i++]]]} &) 
       ]  
     ];   
    

    HTH!