OFFSET
1,6
COMMENTS
a(n) is the number of maximally balanced binary rooted trees with n leaves according to the Colless imbalance index. It is bounded above by sequence A299037.
LINKS
Mareike Fischer, Table of n, a(n) for n = 1..512
Tomás M. Coronado and Francesc Rosselló, The minimum value of the Colless index arXiv:1903.11670 [q-bio.PE], 2019.
Mareike Fischer, Lina Herbst, and Kristina Wicke, Extremal properties of the Colless tree balance index for rooted binary trees, arXiv:1904.09771 [math.CO], 2019.
Tree Balance, Colless index
FORMULA
a(1)=1; a(n) = Sum_{(n_a,n_b): n_a+n_b=n, n_a > n_b, (n_a,n_b) in QB(n)}} ( a(n_a)* a(n_b)) +f(n), where f(n)=0 if n is odd} and f(n)= binomial(a(n/2)+1,2) if n is even; and where QB(n)={(n_a,n_b): n_a+n_b=n and such that there exists a tree T on n leaves with minimal Colless index and with leaf partitioning (n_a,n_b)} }.
EXAMPLE
There are 13 trees with minimal Colless index and 23 leaves, i.e. a(23)=13.
MATHEMATICA
(*QB[n] is just a support function -- the function that actually generates the sequence of the numbers of trees with minimal Colless index and n leaves is given by minCbasedonQB; see below*)
QB[n_] := Module[{k, n0, bin, l, m = {}, i, length, qb = {}, j},
If[OddQ[n], k = 0,
k = FactorInteger[n][[1]][[2]];
];
n0 = n/(2^k);
bin = IntegerDigits[n0, 2];
length = Length[bin];
For[i = Length[bin], i >= 1, i--,
If[bin[[i]] != 0, PrependTo[m, length - i]];
];
l = Length[m];
If[l == 1, Return[{{n/2, n/2}}],
AppendTo[
qb, {2^k*(Sum[2^(m[[i]] - 1), {i, 1, l - 1}] + 1),
2^k*(Sum[2^(m[[i]] - 1), {i, 1, l - 1}])}];
For[j = 2, j <= l - 1, j++,
If[m[[j]] > m[[j + 1]] + 1,
AppendTo[
qb, {2^k*(Sum[2^(m[[i]] - 1), {i, 1, j - 1}] + 2^m[[j]]),
n - 2^k*(Sum[2^(m[[i]] - 1), {i, 1, j - 1}] + 2^m[[j]])}]];
If[m[[j]] < m[[j - 1]] - 1,
AppendTo[
qb, {n - 2^k*Sum[2^(m[[i]] - 1), {i, 1, j - 1}],
2^k*Sum[2^(m[[i]] - 1), {i, 1, j - 1}]}]];
];
If[k >= 1, AppendTo[qb, {n/2, n/2}]];
Return[qb];
];
]
minCbasedonQB[n_] := Module[{qb = QB[n], min = 0, i, na, nb},
If[n == 1, Return[1],
For[i = 1, i <= Length[qb], i++,
na = qb[[i]][[1]]; nb = qb[[i]][[2]];
If[na != nb, min = min + minCbasedonQB[na]*minCbasedonQB[nb],
min = min + Binomial[minCbasedonQB[n/2] + 1, 2]];
];
Return[min];
]
]
CROSSREFS
KEYWORD
nonn,look
AUTHOR
Mareike Fischer, Apr 22 2019
STATUS
approved