A323957 Number of defective (binary) heaps on n elements with exactly one defect.

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

Author

Alois P. Heinz, Feb 09 2019

Keywords

• nonn

Comments

Or number of permutations p of [n] having exactly one index i in {1,...,n} such that p(i) > p(floor(i/2)).

Examples

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

Links

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

Crossrefs

Column k=1 of A306343.

Cf. A056971, A372628, A372643.

Programs

Maple

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

Mathematica

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