|
%I #28 Jan 08 2015 06:32:31
%S 1,1,0,1,1,0,1,2,1,0,1,4,3,2,0,1,7,7,7,4,0,1,12,16,19,18,10,0,1,20,35,
%T 47,55,48,26,0,1,33,74,117,151,170,142,76,0,1,54,153,284,399,515,544,
%U 438,232,0,1,88,312,675,1061,1471,1826,1846,1452,764,0,1,143,629,1575,2792,4119,5651,6664,6494,5008,2620,0
%N Number T(n,k) of self-inverse permutations p on [n] where the maximal displacement of an element equals k: k = max_{i=1..n} |p(i)-i|; triangle T(n,k), n>=0, 0<=k<=n, read by rows.
%C Main diagonal and lower diagonal give: A000007, A000085(n-1).
%C Columns k=0-10 give: A000012, A000071(n+1), A238913, A238914, A238915, A238916, A238917, A238918, A238919, A238920, A238921.
%C Row sums give A000085.
%H Joerg Arndt and Alois P. Heinz, <a href="/A238889/b238889.txt">Rows n=0..28, flattened</a>
%F T(n,k) = A238888(n,k) - A238888(n,k-1) for k>0, T(n,0) = 1.
%e T(4,0) = 1: 1234.
%e T(4,1) = 4: 1243, 1324, 2134, 2143.
%e T(4,2) = 3: 1432, 3214, 3412.
%e T(4,3) = 2: 4231, 4321.
%e Triangle T(n,k) begins:
%e 00: 1;
%e 01: 1, 0;
%e 02: 1, 1, 0;
%e 03: 1, 2, 1, 0;
%e 04: 1, 4, 3, 2, 0;
%e 05: 1, 7, 7, 7, 4, 0;
%e 06: 1, 12, 16, 19, 18, 10, 0;
%e 07: 1, 20, 35, 47, 55, 48, 26, 0;
%e 08: 1, 33, 74, 117, 151, 170, 142, 76, 0;
%e 09: 1, 54, 153, 284, 399, 515, 544, 438, 232, 0;
%e 10: 1, 88, 312, 675, 1061, 1471, 1826, 1846, 1452, 764, 0;
%e ...
%e The 26 involutions of 5 elements together with their maximal displacements are:
%e 01: [ 1 2 3 4 5 ] 0
%e 02: [ 1 2 3 5 4 ] 1
%e 03: [ 1 2 4 3 5 ] 1
%e 04: [ 1 2 5 4 3 ] 2
%e 05: [ 1 3 2 4 5 ] 1
%e 06: [ 1 3 2 5 4 ] 1
%e 07: [ 1 4 3 2 5 ] 2
%e 08: [ 1 4 5 2 3 ] 2
%e 09: [ 1 5 3 4 2 ] 3
%e 10: [ 1 5 4 3 2 ] 3
%e 11: [ 2 1 3 4 5 ] 1
%e 12: [ 2 1 3 5 4 ] 1
%e 13: [ 2 1 4 3 5 ] 1
%e 14: [ 2 1 5 4 3 ] 2
%e 15: [ 3 2 1 4 5 ] 2
%e 16: [ 3 2 1 5 4 ] 2
%e 17: [ 3 4 1 2 5 ] 2
%e 18: [ 3 5 1 4 2 ] 3
%e 19: [ 4 2 3 1 5 ] 3
%e 20: [ 4 2 5 1 3 ] 3
%e 21: [ 4 3 2 1 5 ] 3
%e 22: [ 4 5 3 1 2 ] 3
%e 23: [ 5 2 3 4 1 ] 4
%e 24: [ 5 2 4 3 1 ] 4
%e 25: [ 5 3 2 4 1 ] 4
%e 26: [ 5 4 3 2 1 ] 4
%e There is one involution with no displacements, 7 with one displacement, etc. giving row 4: [1, 7, 7, 7, 4, 0].
%p b:= proc(n, k, s) option remember; `if`(n=0, 1, `if`(n in s,
%p b(n-1, k, s minus {n}), b(n-1, k, s) +add(`if`(i in s, 0,
%p b(n-1, k, s union {i})), i=max(1, n-k)..n-1)))
%p end:
%p A:= (n, k)-> `if`(k<0, 0, b(n, k, {})):
%p T:= (n, k)-> A(n, k) -A(n, k-1):
%p seq(seq(T(n, k), k=0..n), n=0..14);
%t b[n_, k_, s_List] := b[n, k, s] = If[n == 0, 1, If[MemberQ[s, n], b[n-1, k, DeleteCases[s, n]], b[n-1, k, s] + Sum[If[MemberQ[s, i], 0, b[n-1, k, s ~Union~ {i}]], {i, Max[1, n-k], n-1}]]]; A[n_, k_] := If[k<0, 0, b[n, k, {}]]; T[n_, k_] := A[n, k] - A[n, k-1]; Table[Table[T[n, k], {k, 0, n}], {n, 0, 14}] // Flatten (* _Jean-François Alcover_, Jan 08 2015, translated from Maple *)
%K nonn,tabl
%O 0,8
%A _Joerg Arndt_ and _Alois P. Heinz_, Mar 06 2014
|
