This is a front-end for the Online Encyclopedia of Integer Sequences, made by Christian Perfect. The idea is to provide OEIS entries in non-ancient HTML, and then to think about how they're presented visually. The source code is on GitHub.
a(1) = a(2) = 1 because there are only the trees (o) and (o,o) which get counted. a(3) = 2 because the trees ((o,o),o) and (o,(o,o)) get counted. a(4) = 1 because only the tree ((o,o),(o,o)) is counted. Note that the other possible rooted binary ordered trees with four leaves, namely the different orderings of (((o,o),o),o), are not Sackin minimal. a(5) = 4 because the following trees get counted: (((o,o),o),(o,o)), ((o,(o,o)),(o,o)), ((o,o),((o,o),o)), ((o,o),(o,(o,o))).
a:= n-> (b-> binomial(b, n-b))(2^ilog2(n)): seq(a(n), n=0..46); # Alois P. Heinz, Jun 09 2021
a[0] := 1; a[n_] := Module[{k = 2^(BitLength[n] - 1)}, Binomial[k, n - k]];
Table[a[n], {n, 0, 46}]
There are 13 trees with minimal Colless index and 23 leaves, i.e. a(23)=13.
(*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];
]
]
a[n_] := Module[{k = Ceiling[Log2[n]], int, na, nb, sum, i},
If[n == 1, Return[1],
int = IntegerPartitions[n, {2}];
If[OddQ[n], sum = 0, sum = 1/2*Binomial[n, n/2]*((a[n/2])^2)];
For[i = 1, i <= Length[int], i++,
na = int[[i]][[1]]; nb = int[[i]][[2]];
If[na > n/2 && na <= 2^(k - 1) && nb >= 2^(k - 2),
sum = sum + Binomial[n, na]*a[na]*a[nb];
];
];
Return[sum];
]]
seq(n)={my(a=vector(n)); a[1]=1; for(n=2, #a, my(k=1+logint(n-1,2)); a[n]=if(n%2==0, a[n/2]*binomial(n,n/2)/2) + sum(i=n\2+1, min(2^(k-1), n-2^(k-2)), binomial(n,i)*a[i]*a[n-i])); a} \\ Andrew Howroyd, Jun 09 2021
Comments