cp's OEIS Frontend

A125183 Triangle read by rows: T(n,k) is the number of permutations p of {1,2,...,n} such that the set {|p(i)-i|, i=1,2,...,n} has exactly k elements (1<=k<=n).

%I A125183 #18 Sep 16 2022 13:41:25
%S A125183 1,2,0,1,5,0,3,11,6,4,1,28,55,32,4,3,69,210,330,108,0,1,102,846,2177,
%T A125183 1590,324,0,4,279,2694,11221,17578,7624,888,32,1,328,7791,54777,
%U A125183 135993,123474,37524,2896,96,3,961,24032,227906,914364,1427342,839904,182824,11464,0
%N A125183 Triangle read by rows: T(n,k) is the number of permutations p of {1,2,...,n} such that the set {|p(i)-i|, i=1,2,...,n} has exactly k elements (1<=k<=n).
%C A125183 Row sums are the factorial numbers (A000142). T(n,n) = A075866(n). In the Maple program define n (<=10) to obtain row n.
%H A125183 Alois P. Heinz, <a href="/A125183/b125183.txt">Rows n = 1..14, flattened</a>
%e A125183 T(4,3) = 6 because we have 1423, 1342, 3124, 4312, 2314 and 3421.
%e A125183 Triangle starts:
%e A125183   1;
%e A125183   2,  0;
%e A125183   1,  5,   0;
%e A125183   3, 11,   6,   4;
%e A125183   1, 28,  55,  32,   4;
%e A125183   3, 69, 210, 330, 108,  0;
%e A125183   ...
%p A125183 n:=7: with(combinat): P:=permute(n): for j from 1 to n! do c[j]:=0 od: for j from 1 to n! do if nops({seq(abs(P[j][i]-i),i=1..n)}) = 1 then c[1]:=c[1]+1 elif nops({seq(abs(P[j][i]-i),i=1..n)}) = 2 then c[2]:=c[2]+1 elif nops({seq(abs(P[j][i]-i),i=1..n)}) = 3 then c[3]:=c[3]+1 elif nops({seq(abs(P[j][i]-i),i=1..n)}) = 4 then c[4]:=c[4]+1 elif nops({seq(abs(P[j][i]-i),i=1..n)}) = 5 then c[5]:=c[5]+1 elif nops({seq(abs(P[j][i]-i),i=1..n)}) = 6 then c[6]:=c[6]+1 elif nops({seq(abs(P[j][i]-i),i=1..n)}) = 7 then c[7]:=c[7]+1 elif nops({seq(abs(P[j][i]-i),i=1..n)}) = 8 then c[8]:=c[8]+1 elif nops({seq(abs(P[j][i]-i),i=1..n)}) = 9 then c[9]:=c[9]+1 elif nops({seq(abs(P[j][i]-i),i=1..n)}) = 10 then c[10]:=c[10]+1 else fi od: seq(c[i],i=1..n); # yields row n for the specified n (n<=10)
%p A125183 # second Maple program:
%p A125183 b:= proc(p, s) option remember; `if`(p={}, x^nops(s),
%p A125183       add(b(p minus {t}, s union {abs(t-nops(p))}), t=p))
%p A125183     end:
%p A125183 T:= n-> (p-> seq(coeff(p, x, i), i=1..n))(b({$1..n}, {})):
%p A125183 seq(T(n), n=1..9);  # _Alois P. Heinz_, Feb 21 2019
%t A125183 b[p_, s_] := b[p, s] = If[p == {}, x^Length[s], Sum[b[p ~Complement~ {t}, s ~Union~ {Abs[t - Length[p]]}], {t, p}]];
%t A125183 T[n_] := Function[p, Table[Coefficient[p, x, i], {i, n}]][b[Range[n], {}]];
%t A125183 Table[T[n], {n, 1, 10}] // Flatten (* _Jean-François Alcover_, Dec 07 2019, after _Alois P. Heinz_ *)
%Y A125183 Cf. A000142, A075866, A125182.
%K A125183 nonn,tabl
%O A125183 1,2
%A A125183 _Emeric Deutsch_, Nov 24 2006
%E A125183 More terms from _Alois P. Heinz_, Feb 27 2012