|
%I #9 Mar 13 2021 10:04:38
%S 1,1,5,20,109,668,4801,38894,353811,3561512,39374609,474132730,
%T 6179650125,86676293916,1301952953989,20852719565694,354771488612075,
%U 6389625786835184,121456993304945749,2429966790591643402,51042656559451380013,1123165278137918510772
%N Number of permutations of [n] such that the minimal cyclic distance between elements of the same cycle equals one, a(1)=1 by convention.
%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) = 5: (1,2,3), (1,3,2), (1)(2,3), (1,2)(3), (1,3)(2).
%p b:= proc(n, i, l) option remember; `if`(n=0, mul(j!, j=l),
%p (m-> add(`if`(i=j or n*j=1, 0, b(n-1, j, `if`(j>m,
%p [l[], 0], subsop(j=l[j]+1, l)))), j=1..m+1))(nops(l)))
%p end:
%p a:= n-> `if`(n=1, 1, n!-b(n-1, 1, [0])):
%p seq(a(n), n=1..15);
%t b[n_, i_, l_] := b[n, i, l] = If[n == 0, Product[j!, {j, l}], With[{m = Length[l]}, Sum[If[i == j || n*j == 1, 0, b[n-1, j, If[j>m, Append[l, 0], ReplacePart[l, j -> l[[j]]+1]]]], {j, 1, m+1}]]];
%t a[n_] := If[n == 1, 1, n! - b[n-1, 1, {0}]];
%t Array[a, 15] (* _Jean-François Alcover_, Mar 13 2021, after _Alois P. Heinz_ *)
%Y Column k=1 of A277031.
%Y Cf. A002467, A180191, A276975.
%K nonn
%O 1,3
%A _Alois P. Heinz_, Sep 25 2016
|
