A317448 Number of permutations of [n] whose lengths of increasing runs are distinct factorial numbers.

1, 1, 1, 4, 0, 0, 1, 12, 54, 1002, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 48, 648, 39444, 0, 0, 1187548, 96978608, 1721374454, 169149221140, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0

Offset: 0

Author

Alois P. Heinz, Jul 28 2018

Keywords

• nonn

Links

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

Crossrefs

Cf. A000142, A059590, A115945, A317132, A317444, A317445, A317446, A317447.

Programs

Maple

h:= proc(n) local i; 1; for i from 2 do
      if n=% then 1; break elif n<% then 0; break fi;
      %*i od; h(n):=%
    end:
g:= (n, s)-> `if`(n in s or not (n=0 or h(n)=1), 0, 1):
b:= proc(u, o, t, s) option remember; `if`(u+o=0, g(t, s),
      `if`(g(t, s)=1, add(b(u-j, o+j-1, 1, s union {t})
       , j=1..u), 0)+ add(b(u+j-1, o-j, t+1, s), j=1..o))
    end:
a:= n-> b(n, 0$2, {}):
seq(a(n), n=0..34);

Mathematica

h[n_] := Module[{i, pc = 1}, For[i = 2, True, i++, Which[n == pc, pc = 1; Break[], n < pc, pc = 0; Break[]]; pc = pc*i]; h[n] = pc];
g[n_, s_] := If[MemberQ[s, n] || !(n == 0 || h[n] == 1), 0, 1];
b[u_, o_, t_, s_] := b[u, o, t, s] = If[u + o == 0, g[t, s],
     If[g[t, s] == 1, Sum[b[u - j, o + j - 1, 1, s ~Union~ {t}],
     {j, 1, u}], 0] + Sum[b[u + j - 1, o - j, t + 1, s], {j, 1, o}]];
a[n_] := b[n, 0, 0, {}];
Table[a[n], {n, 0, 34}] (* Jean-François Alcover, Jul 14 2021, after Alois P. Heinz *)

Formula

a(n) = 0 <=> n in { A115945 }.

a(n) > 0 <=> n in { A059590 }.