|
%I #27 Oct 28 2020 10:21:27
%S 1,1,4,19,103,651,4702,38413,350559,3539511,39196758,472612883,
%T 6165080443,86526834271,1300282224846,20832761552453,354515666646827,
%U 6386139146435035,121406489336263622,2429193186525638435,51030147426536745655,1122952442325988152627
%N Number of permutations of [n] such that the minimal distance between elements of the same cycle equals one, a(1)=1 by convention.
%H Alois P. Heinz, <a href="/A276975/b276975.txt">Table of n, a(n) for n = 1..50</a>
%H Per Alexandersson et al., <a href="https://mathoverflow.net/questions/168885">d-regular partitions and permutations</a>, MathOverflow, 2014
%e a(2) = 1: (1,2).
%e a(3) = 4: (1,2,3), (1,3,2), (1)(2,3), (1,2)(3).
%p b:= proc(n, i, l) option remember; `if`(n=0, mul(j!, j=l),
%p (m-> add(`if`(i=j, 0, b(n-1, j, `if`(j>m, [l[], 0],
%p subsop(j=l[j]+1, l)))), j=1..m+1))(nops(l)))
%p end:
%p a:= n-> `if`(n=1, 1, n!-b(n, 0, [])):
%p seq(a(n), n=1..15);
%t b[n_, i_, l_] := b[n, i, l] = If[n == 0, Product[j!, {j, l}], Function[m, Sum[If[i == j, 0, b[n - 1, j, If[j > m, Append[l, 0], ReplacePart[l, j -> l[[j]] + 1]]]], {j, 1, m + 1}]][Length[l]]];
%t a[n_] := If[n == 1, 1, n! - b[n, 0, {}]];
%t Array[a, 15] (* _Jean-François Alcover_, Oct 28 2020, after Maple code *)
%Y Column k=1 of A276974.
%Y Cf. A002467, A180191, A277032.
%K nonn
%O 1,3
%A _Alois P. Heinz_, Sep 23 2016
|
