A273001
Number of permutations of [n] whose cycle lengths are Fibonacci numbers.
Original entry on oeis.org
1, 1, 2, 6, 18, 90, 420, 2220, 19020, 130860, 1096920, 9862920, 83843640, 1411202520, 16144792560, 203091829200, 2989264122000, 37012939750800, 597962683188000, 8681244913692000, 126467701221607200, 5006833609034743200, 95602098255580238400
Offset: 0
-
a:= proc(n) option remember; `if`(n=0, 1, add(
`if`(issqr(5*j^2+4) or issqr(5*j^2-4),
a(n-j)*(j-1)!*binomial(n-1, j-1), 0), j=1..n))
end:
seq(a(n), n=0..25);
-
a[n_] := a[n] = If[n == 0, 1, Sum[If[IntegerQ @ Sqrt[5*j^2+4] || IntegerQ @ Sqrt[5*j^2-4], a[n-j]*(j-1)!*Binomial[n-1, j-1], 0], {j, 1, n}]]; Table[ a[n], {n, 0, 25}] (* Jean-François Alcover, Jan 30 2017, translated from Maple *)
A273996
Number of endofunctions on [n] whose cycle lengths are factorials.
Original entry on oeis.org
1, 1, 4, 25, 218, 2451, 33952, 560407, 10750140, 235118665, 5775676496, 157448312649, 4716609543736, 154007821275595, 5443783515005760, 207093963680817511, 8436365861409555728, 366403740283162634193, 16900793597898691865920, 825115046704241167668025
Offset: 0
-
b:= proc(n) option remember; local r, f, g;
if n=0 then 1 else r, f, g:= $0..2;
while f<=n do r:= r+(f-1)!*b(n-f)*
binomial(n-1, f-1); f, g:= f*g, g+1
od; r fi
end:
a:= n-> add(b(j)*n^(n-j)*binomial(n-1, j-1), j=0..n):
seq(a(n), n=0..20);
-
b[n_] := b[n] = Module[{r, f, g}, If[n == 0, 1, {r, f, g} = {0, 1, 2}; While[f <= n, r = r + (f - 1)!*b[n - f]*Binomial[n - 1, f - 1]; {f, g} = {f*g, g + 1}]; r]];
a[0] = 1; a[n_] := Sum[b[j]*n^(n - j)*Binomial[n - 1, j - 1], {j, 0, n}];
Table[a[n], {n, 0, 20}] (* Jean-François Alcover, Jun 06 2018, from Maple *)
A273998
Number of endofunctions on [n] whose cycle lengths are primes.
Original entry on oeis.org
1, 0, 1, 8, 75, 904, 13255, 229536, 4587961, 103971680, 2634212961, 73787255200, 2264440519891, 75563445303072, 2724356214102055, 105546202276277504, 4373078169296869425, 192970687573630633216, 9035613818754820178689, 447469496697658409400960
Offset: 0
-
b:= proc(n) option remember; local r, p;
if n=0 then 1 else r, p:=0, 2;
while p<=n do r:= r+(p-1)!*b(n-p)*
binomial(n-1, p-1); p:= nextprime(p)
od; r fi
end:
a:= n-> add(b(j)*n^(n-j)*binomial(n-1, j-1), j=0..n):
seq(a(n), n=0..20);
-
b[n_] := b[n] = Module[{r, p}, If[n == 0, 1, {r, p} = {0, 2}; While[p <= n, r = r + (p - 1)!*b[n - p]*Binomial[n-1, p-1]; p = NextPrime[p]]; r]];
a[0] = 1; a[n_] := Sum[b[j]*n^(n - j)*Binomial[n - 1, j - 1], {j, 0, n}];
Table[a[n], {n, 0, 20}] (* Jean-François Alcover, Jun 06 2018, from Maple *)
A305824
Number of endofunctions on [n] whose cycle lengths are triangular numbers.
Original entry on oeis.org
1, 1, 3, 18, 157, 1776, 24807, 413344, 8004537, 176630400, 4374300331, 120136735104, 3623854678677, 119102912981248, 4236492477409935, 162152320065532416, 6645233337842716273, 290321208589666369536, 13469914225467040015827, 661442143465113960448000
Offset: 0
-
b:= proc(n) option remember; local r, f, g;
if n=0 then 1 else r, f, g:=$0..2;
while f<=n do r, f, g:= r+(f-1)!*
b(n-f)*binomial(n-1, f-1), f+g, g+1
od; r fi
end:
a:= n-> add(b(j)*n^(n-j)*binomial(n-1, j-1), j=0..n):
seq(a(n), n=0..20);
-
b[n_] := b[n] = Module[{r, f, g}, If[n == 0, 1, {r, f, g} = {0, 1, 2}; While[f <= n, {r, f, g} = {r + (f - 1)!*b[n - f]*Binomial[n - 1, f - 1], f + g, g + 1}]; r]];
a[0] = 1; a[n_] := Sum[b[j]*n^(n - j)*Binomial[n - 1, j - 1], {j, 0, n}];
Table[a[n], {n, 0, 20}] (* Jean-François Alcover, Jun 15 2018, after Alois P. Heinz *)
A273997
Number of endofunctions on [n] whose cycle lengths are squares.
Original entry on oeis.org
1, 1, 3, 16, 131, 1446, 19957, 329344, 6315129, 137942380, 3382214291, 92014156224, 2751300514987, 89701699067176, 3167429783609925, 120428877629249536, 4905431165356442993, 213120603686615692176, 9837426739843075654819, 480775495859934668704000
Offset: 0
-
b:= proc(n) option remember; local r, f, g;
if n=0 then 1 else r, f, g:=0, 1, 3;
while f<=n do r:= r+(f-1)!*b(n-f)*
binomial(n-1, f-1); f, g:= f+g, g+2
od; r fi
end:
a:= n-> add(b(j)*n^(n-j)*binomial(n-1, j-1), j=0..n):
seq(a(n), n=0..20);
-
b[n_] := b[n] = Module[{r, f, g}, If[n == 0, 1, {r, f, g} = {0, 1, 3}; While[f <= n, r = r + (f - 1)!*b[n - f]*Binomial[n - 1, f - 1]; {f, g} = {f + g, g + 2}]; r]];
a[0] = 1; a[n_] := Sum[b[j]*n^(n - j)*Binomial[n - 1, j - 1], {j, 0, n}];
Table[a[n], {n, 0, 20}] (* Jean-François Alcover, Jun 06 2018, from Maple *)
Showing 1-5 of 5 results.