cp's OEIS Frontend

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

%I A323957 #21 Feb 16 2025 08:33:57
%S A323957 0,1,2,9,28,90,360,1526,7616,32460,190800,947760,6382464,37065600,
%T A323957 296524800,1812861600,15283107840,105015593280,1017540576000,
%U A323957 7304720544000,74472335308800,629300251008000,7429184791142400,62417372203929600,746041213793075200
%N A323957 Number of defective (binary) heaps on n elements with exactly one defect.
%C A323957 Or number of permutations p of [n] having exactly one index i in {1,...,n} such that p(i) > p(floor(i/2)).
%H A323957 Alois P. Heinz, <a href="/A323957/b323957.txt">Table of n, a(n) for n = 1..215</a>
%H A323957 Eric Weisstein's World of Mathematics, <a href="https://mathworld.wolfram.com/Heap.html">Heap</a>
%H A323957 Wikipedia, <a href="https://en.wikipedia.org/wiki/Binary_heap">Binary heap</a>
%e A323957 a(2) = 1: 12.
%e A323957 a(3) = 2: 213, 231.
%e A323957 a(4) = 9: 2413, 3124, 3214, 3241, 3412, 3421, 4123, 4132, 4213.
%e A323957 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.
%e A323957 a(6) = 90: 362451, 362541, 436125, 436215, ..., 652314, 652413, 653124, 653214.
%e A323957 (The examples use max-heaps.)
%p A323957 b:= proc(u, o) option remember; local n, g, l; n:= u+o;
%p A323957       if n=0 then 1
%p A323957     else g:= 2^ilog2(n); l:= min(g-1, n-g/2); expand(
%p A323957          add(add(binomial(j-1, i)*binomial(n-j, l-i)*
%p A323957          b(i, l-i)*b(j-1-i, n-l-j+i), i=0..min(j-1, l)), j=1..u)+
%p A323957          add(add(binomial(j-1, i)*binomial(n-j, l-i)*
%p A323957          b(l-i, i)*b(n-l-j+i, j-1-i), i=0..min(j-1, l)), j=1..o)*x)
%p A323957       fi
%p A323957     end:
%p A323957 a:= n-> coeff(b(n, 0), x, 1):
%p A323957 seq(a(n), n=1..25);
%t A323957 b[u_, o_] := b[u, o] = Module[{n = u+o, g, l}, If[n == 0, 1,
%t A323957      g = 2^(Length[IntegerDigits[n, 2]] - 1);
%t A323957      l = Min[g - 1, n - g/2]; Expand[
%t A323957      Sum[ Sum[Binomial[j - 1, i]*Binomial[n - j, l - i]*
%t A323957      b[i, l-i]*b[j-1-i, n-l-j+i], {i, 0, Min[j-1, l]}], {j, 1, u}] +
%t A323957      Sum[Sum[Binomial[j - 1, i]*Binomial[n - j, l - i]*
%t A323957      b[l-i, i]*b[n-l-j+i, j-1-i], {i, 0, Min[j-1, l]}], {j, 1, o}]*x]]];
%t A323957 a[n_] := Coefficient[b[n, 0], x, 1];
%t A323957 Array[a, 25] (* _Jean-François Alcover_, Apr 22 2021, after _Alois P. Heinz_ *)
%Y A323957 Column k=1 of A306343.
%Y A323957 Cf. A056971, A372628, A372643.
%K A323957 nonn
%O A323957 1,3
%A A323957 _Alois P. Heinz_, Feb 09 2019