login

Year-end appeal: Please make a donation to the OEIS Foundation to support ongoing development and maintenance of the OEIS. We are now in our 61st year, we have over 378,000 sequences, and we’ve reached 11,000 citations (which often say “discovered thanks to the OEIS”).

Number of permutations p on [2n] satisfying p^n(i) = i for all i in [n].
2

%I #18 Nov 13 2020 01:23:04

%S 1,1,10,108,6672,109200,45007920,983324160,665546434560,

%T 60174422501760,32648180513760000,4656975300322329600,

%U 13859947861644771532800,1193599114668580293273600,1257285172911535450293811200,766119340152013216053484800000

%N Number of permutations p on [2n] satisfying p^n(i) = i for all i in [n].

%C Conjecture: Lim inf n->infinity a(n) / (((n-1)!)^2 * 4^(n-1) / sqrt(n)) = 1.128... . - _Vaclav Kotesovec_, Aug 14 2014

%H Alois P. Heinz and Vaclav Kotesovec, <a href="/A246073/b246073.txt">Table of n, a(n) for n = 0..233</a> (first 100 terms from Alois P. Heinz)

%H Vaclav Kotesovec, <a href="/A246073/a246073.jpg">Graph - asymptotic</a>

%F a(n) = A246072(2n,n).

%e a(2) = 10: (1,2,3,4), (1,2,4,3), (1,3,2,4), (1,4,3,2), (2,1,3,4), (2,1,4,3), (3,2,1,4), (3,4,1,2), (4,2,3,1), (4,3,2,1).

%e a(3) = 108: (1,2,3,4,5,6), (1,2,3,4,6,5), (1,2,3,5,4,6), ... (6,4,2,3,1,5), (6,5,1,2,4,3), (6,5,2,1,3,4).

%p with(numtheory): with(combinat): M:=multinomial:

%p b:= proc(n, k, p) local l, g; l, g:= sort([divisors(p)[]]),

%p proc(k, m, i, t) option remember; local d, j; d:= l[i];

%p `if`(i=1, m!, add(M(k, k-(d-t)*j, (d-t)$j)/j!*

%p (d-1)!^j *M(m, m-t*j, t$j) *g(k-(d-t)*j, m-t*j,

%p `if`(d-t=1, [i-1, 0], [i, t+1])[]), j=0..min(k/(d-t),

%p `if`(t=0, [][], m/t))))

%p end; g(k, n-k, nops(l), 0)

%p end:

%p a:= n-> `if`(n=0, 1, b(2*n, n, n)):

%p seq(a(n), n=0..20);

%t multinomial[n_, k_List] := n!/Times @@ (k!); M = multinomial;

%t b[n_, k_, p_] := b[n, k, p] = Module[{l, g}, l = Sort[Divisors[p]]; g[k0_, m_, i_, t_] := g[k0, m, i, t] = Module[{d}, d = l[[i]]; If[i == 1, m!, Sum[M[k0, Join[{k0 - (d - t) j}, Table[d - t, {j}]]]/j! (d - 1)!^j M[m, Join[{m - t j}, Table[t, {j}]]] If[d - t == 1, g[k0 - (d - t) j, m - t j, i - 1, 0], g[k0 - (d - t) j, m - t j, i, t + 1]], {j, 0, Min[k0/(d - t), If[t == 0, Infinity, m/t]]}]]]; g[k, n - k, Length[l], 0]];

%t a[n_] := If[n == 0, 1, b[2n, n, n]];

%t a /@ Range[0, 20] (* _Jean-François Alcover_, Nov 13 2020, after _Alois P. Heinz_ *)

%Y Main diagonal of A246072.

%K nonn

%O 0,3

%A _Alois P. Heinz_, Aug 12 2014