A147682 Late-growing permutations: number of permutations of 2 indistinguishable copies of 1..n with every partial sum <= the same partial sum averaged over all permutations.

1, 1, 2, 30, 403, 18720, 746192, 71892912, 5873837638, 951265850580, 133244998049858, 32484245570649180, 6956417433946216990, 2375465385671586163800, 723157816455776560763294, 329255781245519867317200240, 135189844328107458501296074066, 79079768375837127458516103725820

Offset: 0

Author

R. H. Hardin, May 01 2009

Keywords

• nonn
• hard

Crossrefs

Cf. A147681.

Column k=2 of A215561.

Programs

Maple

b:= proc(l) option remember; local m, n, g;
      m, n:= nops(l), add(i, i=l);
      g:= add(i*l[i], i=1..m)-(m+1)/2*(n-1);
     `if`(n<2, 1, add(`if`(l[i]>0 and i<=g,
        b(subsop(i=l[i]-1, l)), 0), i=1..m))
    end:
a:= n-> b([2$n]):
seq(a(n), n=1..10);  # Alois P. Heinz, Aug 16 2012

Mathematica

b[l_List] := b[l] = Module[{m, n, g}, {m, n} = {Length[l], Total[l]}; g = Sum[i* l[[i]], {i, 1, m}] - (m+1)/2*(n-1); If[n<2, 1, Sum[If[l[[i]]>0 && i <= g, b[ ReplacePart[l, i -> l[[i]]-1]], 0], {i, 1, m}]]]; a[n_] := b[Table[2, {n}]]; Table[a[n], {n, 0, 10}] (* Jean-François Alcover, Mar 13 2015, after Alois P. Heinz *)

Extensions

a(14) from Alois P. Heinz, Aug 16 2012

a(15) from Alois P. Heinz, Nov 02 2014

a(16) from Vaclav Kotesovec, Sep 07 2016

a(17) from Vaclav Kotesovec, Sep 08 2016