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

Author

Alois P. Heinz, May 08 2024

Keywords

• nonn

Examples

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

Links

• Alois P. Heinz, Table of n, a(n) for n = 0..5636
• Eric Weisstein's World of Mathematics, Heap
• Wikipedia, Binary heap

Crossrefs

Column k=1 of A372640.

Cf. A323957, A372628.

Programs

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

Formula

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