login
A177261
Number of derangements of {1,2,...,n} having no adjacent 2-cycles and no adjacent 3-cycles (an adjacent q-cycle is a cycle of the form (i,i+1,i+2,...,i+q-1)).
3
1, 0, 0, 1, 7, 35, 218, 1574, 12883, 117956, 1195590, 13295211, 160974037, 2108348871, 29704448652, 447997026724, 7201873573981, 122939256681704, 2221004487898100, 42336428273893565, 849195448479132811, 17879882855311478795, 394291291121879453430
OFFSET
0,5
LINKS
R. A. Brualdi and E. Deutsch, Adjacent q-cycles in permutations, arXiv:1005.0781v1.
FORMULA
a(n) = Sum_{s=0..n} Sum_{t=0..floor((n-j)/2)} Sum_{u=0..floor((n-j-2*t)/3)} (-1)^(s+t+u)*(n-t-2*u)!/(s!*t!*u!).
a(n) ~ exp(-1) * n!. - Vaclav Kotesovec, Dec 10 2021
G.f.: Sum_{k>=0} k! * x^k * ( (1-x)/(1-x^4) )^(k+1). - Seiichi Manyama, Feb 20 2024
EXAMPLE
a(5)=35 because among the 44 (= A000166(5)) derangements of {1,2,3,4,5} only (12)(345), (12)(354), (145)(23), (154)(23), (125)(34), (152)(34), (123)(45), (132)(45) , and (15)(234) have adjacent 2-cycles or adjacent 3-cycles (or both).
MAPLE
a := proc (n) local ct, t, s, u: ct := 0: for s from 0 to n do for t from 0 to n do for u from 0 to n do if s+2*t+3*u <= n then ct := ct+(-1)^(s+t+u)*factorial(n-t-2*u)/(factorial(s)*factorial(t)*factorial(u)) else end if end do end do end do: ct end proc; seq(a(n), n = 0 .. 22);
MATHEMATICA
a[n_] := Sum[If[s + 2*t + 3*u <= n, (-1)^(s + t + u)*(n - t - 2 u)!/(s! t! u!), 0], {s, 0, n}, {t, 0, n}, {u, 0, n}];
Table[a[n], {n, 0, 22}] (* Jean-François Alcover, Dec 04 2017 *)
With[{m=40}, CoefficientList[Series[Sum[k!*(x*(1-x)/(1-x^4))^(k+1)/x, {k, 0, m+2}], {x, 0, m}], x]] (* G. C. Greubel, May 13 2024 *)
PROG
(Magma)
m:=30;
R<x>:=PowerSeriesRing(Integers(), m);
Coefficients(R!( (&+[Factorial(k)*(x*(1-x)/(1-x^4))^(k+1)/x: k in [0..m+2]]) )); // G. C. Greubel, May 13 2024
(SageMath)
m=30
def A177261_list(prec):
P.<x> = PowerSeriesRing(ZZ, prec)
return P( sum(factorial(k)*(x*(1-x)/(1-x^4))^(k+1)/x for k in range(m+3)) ).list()
A177261_list(m) # G. C. Greubel, May 13 2024
CROSSREFS
KEYWORD
nonn
AUTHOR
Emeric Deutsch, May 08 2010
STATUS
approved