A242027
Number T(n,k) of endofunctions on [n] with cycles of k distinct lengths; triangle T(n,k), n>=0, 0<=k<=A003056(n), read by rows.
Original entry on oeis.org
1, 0, 1, 0, 4, 0, 24, 3, 0, 206, 50, 0, 2300, 825, 0, 31742, 14794, 120, 0, 522466, 294987, 6090, 0, 9996478, 6547946, 232792, 0, 218088504, 160994565, 8337420, 0, 5344652492, 4355845868, 299350440, 151200, 0, 145386399554, 128831993037, 11074483860, 18794160
Offset: 0
T(3,2) = 3: (1,3,2), (3,2,1), (2,1,3).
Triangle T(n,k) begins:
00 : 1;
01 : 0, 1;
02 : 0, 4;
03 : 0, 24, 3;
04 : 0, 206, 50;
05 : 0, 2300, 825;
06 : 0, 31742, 14794, 120;
07 : 0, 522466, 294987, 6090;
08 : 0, 9996478, 6547946, 232792;
09 : 0, 218088504, 160994565, 8337420;
10 : 0, 5344652492, 4355845868, 299350440, 151200;
Columns k=0-10 give:
A000007,
A241980 for n>0,
A246283,
A246284,
A246285,
A246286,
A246287,
A246288,
A246289,
A246290,
A246291.
-
with(combinat):
b:= proc(n, i, k) option remember; `if`(n=0, `if`(k=0, 1, 0),
`if`(i<1 or k<1, 0, add((i-1)!^j*multinomial(n, n-i*j, i$j)/j!*
b(n-i*j, i-1, k-`if`(j=0, 0, 1)), j=0..n/i)))
end:
T:= (n, k)-> add(binomial(n-1, j-1)*n^(n-j)*b(j$2, k), j=0..n):
seq(seq(T(n, k), k=0..floor((sqrt(1+8*n)-1)/2)), n=0..14);
-
multinomial[n_, k_] := n!/Times @@ (k!); b[n_, i_, k_] := b[n, i, k] = If[n == 0, If[k==0, 1, 0], If[i<1 || k<1, 0, Sum[(i-1)!^j*multinomial[n, Join[ {n-i*j}, Array[i&, j]]]/j!*b[n-i*j, i-1, k-If[j==0, 0, 1]], {j, 0, n/i}]] ]; T[0, 0] = 1; T[n_, k_] := Sum[Binomial[n-1, j-1]*n^(n-j)*b[j, j, k], {j, 0, n}]; Table[T[n, k], {n, 0, 14}, {k, 0, Floor[(Sqrt[1+8n]-1)/2]}] // Flatten (* Jean-François Alcover, Feb 18 2017, translated from Maple *)
A218868
Triangular array read by rows: T(n,k) is the number of n-permutations that have exactly k distinct cycle lengths.
Original entry on oeis.org
1, 2, 3, 3, 10, 14, 25, 95, 176, 424, 120, 721, 3269, 1050, 6406, 21202, 12712, 42561, 178443, 141876, 436402, 1622798, 1418400, 151200, 3628801, 17064179, 17061660, 2162160, 48073796, 177093256, 212254548, 41580000, 479001601, 2293658861, 2735287698, 719072640
Offset: 1
: 1;
: 2;
: 3, 3;
: 10, 14;
: 25, 95;
: 176, 424, 120;
: 721, 3269, 1050;
: 6406, 21202, 12712;
: 42561, 178443, 141876;
: 436402, 1622798, 1418400, 151200;
-
with(combinat):
b:= proc(n, i) option remember; expand(`if`(n=0, 1,
`if`(i<1, 0, add((i-1)!^j*multinomial(n, n-i*j, i$j)/j!*
b(n-i*j, i-1)*`if`(j=0, 1, x), j=0..n/i))))
end:
T:= n-> (p-> seq(coeff(p, x, i), i=1..degree(p)))(b(n$2)):
seq(T(n), n=1..16); # Alois P. Heinz, Aug 21 2014
-
nn=10;a=Product[1-y+y Exp[x^i/i],{i,1,nn}];f[list_]:=Select[list,#>0&];Map[f,Drop[Range[0,nn]!CoefficientList[Series[a ,{x,0,nn}],{x,y}],1]]//Grid
A317165
Number of permutations of [n*(n+1)/2] with distinct lengths of increasing runs.
Original entry on oeis.org
1, 1, 5, 241, 188743, 2734858573, 892173483721887, 7469920269852025033699, 1841449549508718383891930251607, 14973026148724796464136435753195418043885, 4467880642339303169146446437381463615730321314015457, 53810913396105573079543194840166969124601447333276658546225661505
Offset: 0
-
g:= (n, s)-> `if`(n in s, 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*(n+1)/2, 0$2, {}):
seq(a(n), n=0..8);
-
g[n_, s_] := If[MemberQ[s, n], 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, u}], 0] + Sum[b[u + j - 1, o - j, t + 1, s], {j, o}]];
a[n_] := b[n(n+1)/2, 0, 0, {}];
Table[a[n], {n, 0, 8}] (* Jean-François Alcover, Sep 01 2021, after Alois P. Heinz *)
Showing 1-3 of 3 results.
Comments