A372640
Number T(n,k) of defective (binary) heaps on n elements from the set {0,1} where k ancestor-successor pairs do not have the correct order; triangle T(n,k), n>=0, read by rows.
Original entry on oeis.org
1, 2, 3, 1, 5, 2, 1, 7, 4, 3, 2, 11, 6, 7, 5, 2, 1, 16, 13, 12, 8, 10, 3, 2, 26, 22, 23, 14, 21, 10, 9, 2, 1, 36, 36, 39, 33, 33, 28, 26, 13, 9, 2, 1, 56, 54, 67, 61, 60, 59, 56, 37, 34, 11, 13, 2, 2, 81, 99, 111, 96, 117, 112, 107, 96, 76, 53, 36, 20, 14, 4, 2
Offset: 0
T(4,0) = 7: 0000, 1000, 1010, 1100, 1101, 1110, 1111.
T(4,1) = 4: 0010, 0100, 1001, 1011.
T(4,2) = 3: 0001, 0101, 0110.
T(4,3) = 2: 0011, 0111.
(The examples use max-heaps.)
Triangle T(n,k) begins:
1;
2;
3, 1;
5, 2, 1;
7, 4, 3, 2;
11, 6, 7, 5, 2, 1;
16, 13, 12, 8, 10, 3, 2;
26, 22, 23, 14, 21, 10, 9, 2, 1;
36, 36, 39, 33, 33, 28, 26, 13, 9, 2, 1;
56, 54, 67, 61, 60, 59, 56, 37, 34, 11, 13, 2, 2;
81, 99, 111, 96, 117, 112, 107, 96, 76, 53, 36, 20, 14, 4, 2;
...
-
b:= proc(n, t) option remember; `if`(n=0, 1, (g-> (f->
expand(b(f, t)*b(n-1-f, t)*x^t+b(f, t+1)*b(n-1-f, t+1)
))(min(g-1, n-g/2)))(2^ilog2(n)))
end:
T:= n-> (p-> seq(coeff(p, x, i), i=0..degree(p)))(b(n, 0)):
seq(T(n), n=0..14);
-
b[n_, t_] := b[n, t] = If[n == 0, 1, Function[g, Function [f,
Expand[b[f, t]*b[n-1-f, t]*x^t + b[f, t+1]*b[n-1 - f, t+1]]][
Min[g-1, n-g/2]]][2^(Length@IntegerDigits[n, 2]-1)]];
T[n_] := CoefficientList[b[n, 0], x];
Table[T[n], {n, 0, 14}] // Flatten (* Jean-François Alcover, May 09 2024, after Alois P. Heinz *)
A323957
Number of defective (binary) heaps on n elements with exactly one defect.
Original entry on oeis.org
0, 1, 2, 9, 28, 90, 360, 1526, 7616, 32460, 190800, 947760, 6382464, 37065600, 296524800, 1812861600, 15283107840, 105015593280, 1017540576000, 7304720544000, 74472335308800, 629300251008000, 7429184791142400, 62417372203929600, 746041213793075200
Offset: 1
a(2) = 1: 12.
a(3) = 2: 213, 231.
a(4) = 9: 2413, 3124, 3214, 3241, 3412, 3421, 4123, 4132, 4213.
a(5) = 28: 25134, 25143, 35124, 35142, 35214, 35241, 42315, 42351, 43125, 43152, 43215, 43251, 43512, 43521, 45123, 45132, 45213, 45231, 45312, 45321, 52314, 52341, 52413, 52431, 53124, 53142, 53214, 53241.
a(6) = 90: 362451, 362541, 436125, 436215, ..., 652314, 652413, 653124, 653214.
(The examples use max-heaps.)
-
b:= proc(u, o) option remember; local n, g, l; n:= u+o;
if n=0 then 1
else g:= 2^ilog2(n); l:= min(g-1, n-g/2); expand(
add(add(binomial(j-1, i)*binomial(n-j, l-i)*
b(i, l-i)*b(j-1-i, n-l-j+i), i=0..min(j-1, l)), j=1..u)+
add(add(binomial(j-1, i)*binomial(n-j, l-i)*
b(l-i, i)*b(n-l-j+i, j-1-i), i=0..min(j-1, l)), j=1..o)*x)
fi
end:
a:= n-> coeff(b(n, 0), x, 1):
seq(a(n), n=1..25);
-
b[u_, o_] := b[u, o] = Module[{n = u+o, g, l}, If[n == 0, 1,
g = 2^(Length[IntegerDigits[n, 2]] - 1);
l = Min[g - 1, n - g/2]; Expand[
Sum[ Sum[Binomial[j - 1, i]*Binomial[n - j, l - i]*
b[i, l-i]*b[j-1-i, n-l-j+i], {i, 0, Min[j-1, l]}], {j, 1, u}] +
Sum[Sum[Binomial[j - 1, i]*Binomial[n - j, l - i]*
b[l-i, i]*b[n-l-j+i, j-1-i], {i, 0, Min[j-1, l]}], {j, 1, o}]*x]]];
a[n_] := Coefficient[b[n, 0], x, 1];
Array[a, 25] (* Jean-François Alcover, Apr 22 2021, after Alois P. Heinz *)
A372628
Number of defective (binary) heaps on n elements from the set {0,1} with exactly one defect.
Original entry on oeis.org
0, 0, 1, 2, 6, 11, 20, 32, 60, 100, 162, 255, 427, 692, 1093, 1738, 2800, 4507, 6951, 11032, 17224, 27553, 42276, 67639, 103989, 165856, 251312, 401236, 608112, 968380, 1465934, 2354752, 3525880, 5585826, 8370796, 13394396, 19937564, 31632664, 47478092
Offset: 0
a(2) = 1: 01.
a(3) = 2: 001, 010.
a(4) = 6: 0001, 0010, 0100, 0101, 1001, 1011.
a(5) = 11: 00001, 00010, 00100, 01000, 01001, 01010, 01011, 10001, 10010, 10101, 10110.
(The examples use max-heaps.)
-
b:= proc(n, t) option remember; convert(series(`if`(n=0, 1, (g->
(f-> expand(b(f, 1)*b(n-1-f, 1)*t+b(f, x)*b(n-1-f, x)))(
min(g-1, n-g/2)))(2^ilog2(n))), x, 2), polynom)
end:
a:= n-> coeff(b(n, 1), x, 1):
seq(a(n), n=0..38);
-
b[n_, t_] := b[n, t] = If[n == 0, 1, Function[g, Function[f,
Expand[b[f, 1]*b[n - 1 - f, 1]*t + b[f, x]*b[n - 1 - f, x]]][
Min[g - 1, n - g/2]]][2^(Length[IntegerDigits[n, 2]] - 1)]];
a[n_] := Coefficient[b[n, 1], x, 1];
Table[a[n], {n, 0, 38}] (* Jean-François Alcover, May 11 2024, after Alois P. Heinz *)
Showing 1-3 of 3 results.
Comments