Display Binary Tree as Centred Array

Question

I would like to display a binary tree using something analogous to TableForm. For example, a small such tree is given by this array (which except for the root still needs to be populated):

x = {{3}, {0, 0}, {0, 0, 0, 0}, {0, 0, 0, 0, 0, 0, 0, 0}}.

Szabolds's answer to a similar question uses Grid and comes very close to what I need:

With[
 {r = Riffle[#, ""] & /@ arr},
 {l = Max[Length /@ r]},
 Grid[CenterArray[#, l, ""] & /@ r]
]

The output of the above code applied to my array looks like this:

The reason it does not work is that, unlike the example this code was written for, except for the root all the rows have an even number of columns. Therefore, to get a nice binary tree look what's needed is to add more space in the higher rows than in the lower rows. The spacing for the lowest row could be made smaller than shown here, and it needs to be doubled for each row above that, up to the second row. The motivation for smaller spacing at the bottom is that I would be able to fit more rows in a standard figure in a report.

I don't know if it's possible to do this with Riffle, e.g. with something like Riffle[x, 2^(n-i)" "], where n is the length of the array and i is the row number. Here I am multiplying the space " " by a numerical factor, which I realise is probably nonsense -- just trying to communicate the idea.

I would rather not use TreePlot because I like the economy of the TableForm or Grid format.

Answer 1

I believe the following satisfies @pdini's request, though it rapidly spreads horizontally with tree depth. To my eyes, it could be prettied up some to make the tree structure more apparent, possibly with some framing in Grid, but I did not attempt that.

n = 5;
tree = Table[Table[RandomInteger[100], 2^(i - 1)], {i, n}];

pad = " ";
depth = Length[tree];
width = 2^depth - 1;
CenterArray[
  Join[{tree[[1]]},
   Table[
    Insert[tree[[i]],
     Splice[Table[pad, 2^(depth - i + 1) - 1]],
     List /@ (Range[2^(i - 1) - 1] + 1)]
    , {i, 2, depth}]],
  {depth, width},
  pad
  ] // Grid

Here's a sample of the output for a tree depth of 5:

Answer 2

Let's try a recursive approach. I'll assume that you want Grid as the underlying structural element, but you can do the same thing with Tree.

For convenience and a bit of robustness, let's define a function to normalize the data. It will pad or truncate as necessary for each level.

BalancedData[data : {__List}, filler_] := 
  MapIndexed[PadRight[#1, 2^(#2 - 1), filler] &, data]

Our base grid structure will hold a parent and its children. Let's create a method to make it easier to control the styling of this base structure. We want the parent centered above the children. You could add spacing, dividers, and other styling to your hearts content.

StyledTreeGrid[parent_, children_List] := 
  Grid[{{parent, SpanFromLeft}, children}, Alignment -> Center, Dividers -> None]

Now let's create the recursive function. It'll work "backward" and "upward". It doesn't assume that the data is a balanced tree, so it'll accept a filler argument to fill in gaps.

ToBinaryTreesGrid[{parents_List, children_List}, filler_] := 
  StyledTreeGrid @@@ 
    Thread[{parents, Partition[PadRight[children, 2*Length@parents, filler], 2]}];
ToBinaryTreesGrid[{root_List, trunk___List, branches_List, leaves_List}, filler_] :=
  ToBinaryTreesGrid[{root, trunk, ToBinaryTreesGrid[{branches, leaves}, filler]}, filler];

Since it doesn't assume a balanced tree, it'll return a list of trees (depending on how many roots were provided). But you can use the BalancedData method above to guarantee a single tree.

Here's some unbalanced data:

treeDataByLevel = {{1}, {2, 2}, {3, 3, 3}, {4, 4, 4, 4, 4, 4, 4}}

We can try it out:

ToBinaryTreesGrid[treeDataByLevel, "~"]

ToBinaryTreesGrid[BalancedData[treeDataByLevel, "*"], "~"]

ToBinaryTreesGrid[Table[Table[RandomInteger[100], 2^(i - 1)], {i, 5}], "~"]