cp's OEIS Frontend

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

%I A324062 #19 Feb 16 2025 08:33:57
%S A324062 0,0,1,2,6,16,60,240,840,3584,16800,96000,475200,3041280,19219200,
%T A324062 153753600,864864000,6560153600,47048601600,439934976000,
%U A324062 3192583680000,31434670080000,280947363840000,3296449069056000,27139515346944000,308787374614118400
%N A324062 Number of defective (binary) heaps on n elements where one ancestor-successor pair does not have the correct order.
%C A324062 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)).
%H A324062 Alois P. Heinz, <a href="/A324062/b324062.txt">Table of n, a(n) for n = 0..200</a>
%H A324062 Eric Weisstein's World of Mathematics, <a href="https://mathworld.wolfram.com/Heap.html">Heap</a>
%H A324062 Wikipedia, <a href="https://en.wikipedia.org/wiki/Binary_heap">Binary heap</a>
%H A324062 Wikipedia, <a href="https://en.wikipedia.org/wiki/Permutation">Permutation</a>
%e A324062 a(4) = 6: 3241, 3412, 3421, 4123, 4132, 4213.
%e A324062 a(5) = 16: 43512, 43521, 45123, 45132, 45213, 45231, 45312, 45321, 52314, 52341, 52413, 52431, 53124, 53142, 53214, 53241.
%e A324062 (The examples use max-heaps.)
%p A324062 b:= proc(u, o) option remember; local n, g, l; n:= u+o;
%p A324062       if n=0 then 1
%p A324062     else g:= 2^ilog2(n); l:= min(g-1, n-g/2); expand(
%p A324062          add(x^(n-j)*add(binomial(j-1, i)*binomial(n-j, l-i)*
%p A324062          b(i, l-i)*b(j-1-i, n-l-j+i), i=0..min(j-1, l)), j=1..u)+
%p A324062          add(x^(j-1)*add(binomial(j-1, i)*binomial(n-j, l-i)*
%p A324062          b(l-i, i)*b(n-l-j+i, j-1-i), i=0..min(j-1, l)), j=1..o))
%p A324062       fi
%p A324062     end:
%p A324062 a:= n-> coeff(b(n, 0), x, 1):
%p A324062 seq(a(n), n=0..25);
%t A324062 b[u_, o_] := b[u, o] = Module[{n, g, l}, n = u + o; If[n == 0, 1,
%t A324062      g = 2^(Length[IntegerDigits[n, 2]]-1); l = Min[g-1, n-g/2]; Expand[
%t A324062      Sum[ x^(n - j)*Sum[Binomial[j - 1, i]*Binomial[n - j, l - i]*
%t A324062      b[i, l-i]*b[j-1-i, n-l-j+i], {i, 0, Min[j - 1, l]}], {j, 1, u}] +
%t A324062      Sum[x^(j-1)*Sum[Binomial[j-1, i]*Binomial[n - j, l - i]*
%t A324062      b[l-i, i]*b[n-l-j+i, j-1-i], {i, 0, Min[j-1, l]}], {j, 1, o}]]]];
%t A324062 a[n_] := Coefficient[b[n, 0], x, 1];
%t A324062 a /@ Range[0, 25] (* _Jean-François Alcover_, Apr 22 2021, after _Alois P. Heinz_ *)
%Y A324062 Column k=1 of A306393.
%Y A324062 Cf. A056971.
%K A324062 nonn
%O A324062 0,4
%A A324062 _Alois P. Heinz_, Feb 13 2019