cp's OEIS Frontend

A324075 Number of defective (binary) heaps on n elements having one half of their ancestor-successor pairs (rounded down) distorted.

%I A324075 #27 Feb 16 2025 08:33:57
%S A324075 1,1,1,2,6,24,120,720,5040,40320,359520,3590400,39362400,472919040,
%T A324075 6133670400,85948262400,1284106824000,20434058444800,345796766515200,
%U A324075 6188467544064000,117398964114432000,2341018467532800000,49035684501872640000,1074839883779211264000
%N A324075 Number of defective (binary) heaps on n elements having one half of their ancestor-successor pairs (rounded down) distorted.
%C A324075 Number of permutations p of [n] having exactly floor(A061168(n)/2) pairs (i,j) in {1,...,n} X {1,...,floor(log_2(i))} such that p(i) > p(floor(i/2^j)).
%C A324075 Central terms (also maxima) of rows of A306393.
%H A324075 Alois P. Heinz, <a href="/A324075/b324075.txt">Table of n, a(n) for n = 0..100</a>
%H A324075 Eric Weisstein's World of Mathematics, <a href="https://mathworld.wolfram.com/Heap.html">Heap</a>
%H A324075 Wikipedia, <a href="https://en.wikipedia.org/wiki/Binary_heap">Binary heap</a>
%H A324075 Wikipedia, <a href="https://en.wikipedia.org/wiki/Permutation">Permutation</a>
%F A324075 a(n) = A306393(floor(A061168(n)/2)).
%F A324075 a(n) <= (n-1)! for n >= 1 with equality only for n <= 9.
%p A324075 h:= proc(n) option remember; `if`(n<1, 0, ilog2(n)+h(n-1)) end:
%p A324075 b:= proc(u, o) option remember; local n, g, l; n:= u+o;
%p A324075       if n=0 then 1
%p A324075     else g:= 2^ilog2(n); l:= min(g-1, n-g/2); expand(
%p A324075          add(x^(n-j)*add(binomial(j-1, i)*binomial(n-j, l-i)*
%p A324075          b(i, l-i)*b(j-1-i, n-l-j+i), i=0..min(j-1, l)), j=1..u)+
%p A324075          add(x^(j-1)*add(binomial(j-1, i)*binomial(n-j, l-i)*
%p A324075          b(l-i, i)*b(n-l-j+i, j-1-i), i=0..min(j-1, l)), j=1..o))
%p A324075       fi
%p A324075     end:
%p A324075 a:= n-> coeff(b(n, 0), x, iquo(h(n), 2)):
%p A324075 seq(a(n), n=0..25);
%t A324075 h[n_] := h[n] = If[n < 1, 0, Length[IntegerDigits[n, 2]] - 1 + h[n - 1]];
%t A324075 b[u_, o_] := b[u, o] = Module[{n, g, l}, n = u + o; If[n == 0, 1,
%t A324075      g = 2^(Length[IntegerDigits[n, 2]] - 1); l = Min[g - 1, n - g/2];
%t A324075      Expand[Sum[x^(n - j)*Sum[Binomial[j - 1, i]*Binomial[n - j, l - i]*
%t A324075      b[i, l-i]*b[j-1-i, n-l-j+i], {i, 0, Min[j - 1, l]}], {j, 1, u}] +
%t A324075      Sum[x^(j - 1)*Sum[Binomial[j - 1, i]*Binomial[n - j, l - i]*
%t A324075      b[l-i, i]*b[n-l-j+i, j-1-i], {i, 0, Min[j - 1, l]}], {j, 1, o}]]]];
%t A324075 a[n_] := Coefficient[b[n, 0], x, Quotient[h[n], 2]];
%t A324075 a /@ Range[0, 25] (* _Jean-François Alcover_, Apr 23 2021, after _Alois P. Heinz_ *)
%Y A324075 Cf. A000142, A000523, A061168, A306393.
%K A324075 nonn
%O A324075 0,4
%A A324075 _Alois P. Heinz_, Feb 14 2019