A324062 Number of defective (binary) heaps on n elements where one ancestor-successor pair does not have the correct order.

0, 0, 1, 2, 6, 16, 60, 240, 840, 3584, 16800, 96000, 475200, 3041280, 19219200, 153753600, 864864000, 6560153600, 47048601600, 439934976000, 3192583680000, 31434670080000, 280947363840000, 3296449069056000, 27139515346944000, 308787374614118400

Offset

0,4

Comments

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

Links

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

Eric Weisstein's World of Mathematics, Heap

Wikipedia, Binary heap

Wikipedia, Permutation

Example

a(4) = 6: 3241, 3412, 3421, 4123, 4132, 4213.
a(5) = 16: 43512, 43521, 45123, 45132, 45213, 45231, 45312, 45321, 52314, 52341, 52413, 52431, 53124, 53142, 53214, 53241.
(The examples use max-heaps.)

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(x^(n-j)*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(x^(j-1)*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))
      fi
    end:
a:= n-> coeff(b(n, 0), x, 1):
seq(a(n), n=0..25);

Mathematica

b[u_, o_] := b[u, o] = Module[{n, g, l}, n = u + o; If[n == 0, 1,
     g = 2^(Length[IntegerDigits[n, 2]]-1); l = Min[g-1, n-g/2]; Expand[
     Sum[ x^(n - j)*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[x^(j-1)*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}]]]];
a[n_] := Coefficient[b[n, 0], x, 1];
a /@ Range[0, 25] (* Jean-François Alcover, Apr 22 2021, after Alois P. Heinz *)

Crossrefs

Column k=1 of A306393.

Cf. A056971.

Sequence in context: A006820 A131385 A027742 * A033301 A197102 A093113

Adjacent sequences: A324059 A324060 A324061 * A324063 A324064 A324065

Keyword

nonn

Author

Alois P. Heinz, Feb 13 2019

Status

approved