A306343
Number T(n,k) of defective (binary) heaps on n elements with k defects; triangle T(n,k), n>=0, 0<=k<=max(0,n-1), read by rows.
Original entry on oeis.org
1, 1, 1, 1, 2, 2, 2, 3, 9, 9, 3, 8, 28, 48, 28, 8, 20, 90, 250, 250, 90, 20, 80, 360, 1200, 1760, 1200, 360, 80, 210, 1526, 5922, 12502, 12502, 5922, 1526, 210, 896, 7616, 34160, 82880, 111776, 82880, 34160, 7616, 896, 3360, 32460, 185460, 576060, 1017060, 1017060, 576060, 185460, 32460, 3360
Offset: 0
T(4,0) = 3: 4231, 4312, 4321.
T(4,1) = 9: 2413, 3124, 3214, 3241, 3412, 3421, 4123, 4132, 4213.
T(4,2) = 9: 1342, 1423, 1432, 2134, 2143, 2314, 2341, 2431, 3142.
T(4,3) = 3: 1234, 1243, 1324.
(The examples use max-heaps.)
Triangle T(n,k) begins:
1;
1;
1, 1;
2, 2, 2;
3, 9, 9, 3;
8, 28, 48, 28, 8;
20, 90, 250, 250, 90, 20;
80, 360, 1200, 1760, 1200, 360, 80;
210, 1526, 5922, 12502, 12502, 5922, 1526, 210;
896, 7616, 34160, 82880, 111776, 82880, 34160, 7616, 896;
...
Columns k=0-10 give:
A056971,
A323957,
A323958,
A323959,
A323960,
A323961,
A323962,
A323963,
A323964,
A323965,
A323966.
-
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:
T:= n-> (p-> seq(coeff(p, x, i), i=0..degree(p)))(b(n, 0)):
seq(T(n), n=0..10);
-
b[u_, o_] := b[u, o] = Module[{n = u + o, g, l},
If[n == 0, 1, g := 2^Floor@Log[2, n]; 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]]];
T[n_] := CoefficientList[b[n, 0], x];
T /@ Range[0, 10] // Flatten (* Jean-François Alcover, Feb 17 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 *)
A372643
Number of defective (binary) heaps on n elements from the set {0,1} where exactly one ancestor-successor pair does not have the correct order.
Original entry on oeis.org
0, 0, 1, 2, 4, 6, 13, 22, 36, 54, 99, 164, 260, 400, 692, 1146, 1730, 2638, 4358, 7148, 10788, 16716, 27168, 44692, 65630, 100736, 159851, 261156, 385740, 599704, 946368, 1551686, 2245014, 3455650, 5364990, 8743620, 12757292, 19869332, 30818816, 50429524
Offset: 0
a(2) = 1: 01.
a(3) = 2: 001, 010.
a(4) = 4: 0010, 0100, 1001, 1011.
a(5) = 6: 00100, 01000, 10001, 10010, 10101, 10110.
a(6) = 13: 001000, 010000, 100001, 100010, 100100, 101010, 101011, 101100, 101101, 110001, 110011, 110101, 110111.
(The examples use max-heaps.)
-
b:= proc(n, t) option remember; convert(series(`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))),x,2), polynom)
end:
a:= n-> coeff(b(n, 0),x,1):
seq(a(n), n=0..39);
-
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)]];
a[n_] := Coefficient[b[n, 0], x, 1];
Table[a[n], {n, 0, 39}] (* Jean-François Alcover, May 09 2024, after Alois P. Heinz *)
Showing 1-3 of 3 results.
Comments