Create a Figure with a sequence of Balanced Binary Trees

I would like make the attached image by Mathematica. someone who could help me? Thank!

• – Öskå
Jun 12, 2014 at 14:20
• And at least but not last.., have you even tried anything? Like getting the coordinates of the points?
– Öskå
Jun 12, 2014 at 15:05
• Now I just saw the comments ... thanks everyone for the help Jun 13, 2014 at 6:46

Not a perfect match but a start

Partition[Table[Column[{"i = " <> ToString[2^(n - 1)],
CompleteKaryTree[n,
10, (AbsoluteOptions[
CompleteKaryTree[n, VertexLabels -> "Name", ImagePadding -> 10],
VertexCoordinates] /. {x_?NumericQ, y_?NumericQ} :> {x, -y})],
"\[Omega] = " <> ToString[n]}, Center], {n, 2, 5}], 2] // Grid


If you have Version 9, you can use the GraphLayout suboptions as follows:

bbt[n_] :=
Labeled[GraphUnion[CompleteKaryTree[n], Graph[{UndirectedEdge[0, 1]}],
BaseStyle ->Directive[Opacity[1], Black, PointSize[.015]],
EdgeStyle -> Directive[{Black, Thick}], AspectRatio -> 1,
VertexShapeFunction -> "Point",  ImageSize -> 300,
GraphLayout -> {"LayeredEmbedding", "RootVertex" -> 0,
"Orientation" -> Bottom,
LayerSizeFunction -> (If[# == 1, 1, 2^(n - #)] &)}],
{"i = " <> ToString[2^(n - 1)],"\[Omega] = " <> ToString[n]},
{Top, Bottom}];

Row[bbt /@ Range[2,7], Spacer[5]]


• I'm afraid that it doesn't look the same on v8. None of the GraphLayout options seem to work for me.
– Öskå
Jun 13, 2014 at 9:26
• @Öskå, right - these GraphLayout options are new-in-version-9.
– kglr
Jun 13, 2014 at 9:31
• Well, they seem to be very useful! You already have my +1
– Öskå
Jun 13, 2014 at 9:38
• @Oska, thank you for the +.
– kglr
Jun 13, 2014 at 9:50
• Well, your output looks like what the OP desired, the raw one from CompleteKaryTree is getting flatter and flatter.
– Öskå
Jun 13, 2014 at 9:52