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,4

Links

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

Formula

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

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

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 *)

Crossrefs

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

Sequence in context: A123163 A194794 A337967 * A292900 A177893 A058305

Adjacent sequences: A317445 A317446 A317447 * A317449 A317450 A317451

Keyword

nonn

Author

Alois P. Heinz, Jul 28 2018

Status

approved