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.

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,4

Links

Alois P. Heinz, Table of n, a(n) for n = 0..5636

Eric Weisstein's World of Mathematics, Heap

Wikipedia, Binary heap

Formula

a(n) = A372640(n,1).

Example

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.)

Maple

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);

Mathematica

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 *)

Crossrefs

Column k=1 of A372640.

Cf. A323957, A372628.

Sequence in context: A278031 A087549 A339291 * A109078 A291738 A321228

Adjacent sequences: A372640 A372641 A372642 * A372644 A372645 A372646

Keyword

nonn

Author

Alois P. Heinz, May 08 2024

Status

approved