cp's OEIS Frontend

A125182 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 A125182 #35 Sep 16 2022 21:50:09
%S A125182 1,1,1,1,2,3,1,4,12,7,1,4,38,54,23,1,8,77,248,303,83,1,6,160,824,2008,
%T A125182 1636,405,1,11,285,2320,9449,15789,10352,2113,1,10,476,5564,37237,
%U A125182 102726,133293,70916,12657,1,14,799,13172,122708,536900,1158368,1177168,537373,82297
%N A125182 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 A125182 Row sums are the factorial numbers (A000142). T(n,1)=1 (the identity permutation). T(n,2) = A065608(n) = (sum of divisors of n)-(number of divisors of n). T(n,n) = A099152(n). In the first Maple program define n (<=10) to obtain row n.
%C A125182 T(n,k) is also 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). Example: T(4,2)=4 because we have 1432, 3412, 2143 and 3214. - _Emeric Deutsch_, Nov 28 2008
%H A125182 Alois P. Heinz, <a href="/A125182/b125182.txt">Rows n = 1..12, flattened</a>
%H A125182 M. Alekseyev, E. Deutsch, and J. H. Steelman, <a href="https://www.jstor.org/stable/40391132">Problem 11281</a>, Amer. Math. Monthly, 116, No. 5, 2009, p. 465. - _Emeric Deutsch_, Apr 23 2009
%F A125182 Sum_{k=1..n} k * T(n,k) = A306455(n). - _Alois P. Heinz_, Feb 16 2019
%e A125182 T(4,2) = 4 because we have 4123, 3412, 2143 and 2341.
%e A125182 Triangle starts:
%e A125182   1;
%e A125182   1, 1;
%e A125182   1, 2,  3;
%e A125182   1, 4, 12,  7;
%e A125182   1, 4, 38, 54, 23;
%e A125182   ...
%p A125182 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(P[j][i]-i,i=1..n)}) = 1 then c[1]:=c[1]+1 elif nops({seq(P[j][i]-i,i=1..n)}) = 2 then c[2]:=c[2]+1 elif nops({seq(P[j][i]-i,i=1..n)}) = 3 then c[3]:=c[3]+1 elif nops({seq(P[j][i]-i,i=1..n)}) = 4 then c[4]:=c[4]+1 elif nops({seq(P[j][i]-i,i=1..n)}) = 5 then c[5]:=c[5]+1 elif nops({seq(P[j][i]-i,i=1..n)}) = 6 then c[6]:=c[6]+1 elif nops({seq(P[j][i]-i,i=1..n)}) = 7 then c[7]:=c[7]+1 elif nops({seq(P[j][i]-i,i=1..n)}) = 8 then c[8]:=c[8]+1 elif nops({seq(P[j][i]-i,i=1..n)}) = 9 then c[9]:=c[9]+1 elif nops({seq(P[j][i]-i,i=1..n)}) = 10 then c[10]:=c[10]+1 else fi od: seq(c[i],i=1..n);
%p A125182 # second Maple program:
%p A125182 b:= proc(p, s) option remember; `if`(p={}, x^nops(s),
%p A125182       add(b(p minus {t}, s union {t+nops(p)}), t=p))
%p A125182     end:
%p A125182 T:= n-> (p-> seq(coeff(p, x, i), i=1..n))(b({$1..n}, {})):
%p A125182 seq(T(n), n=1..9);  # _Alois P. Heinz_, May 04 2014; revised, Sep 08 2018
%t A125182 b[i_, p_List, s_List] := b[i, p, s] = If[p == {}, x^Length[s], Sum[b[i+1, p ~Complement~ {t}, s ~Union~ {t+i}], {t, p}]]; T[n_] := Function[{p}, Table[ Coefficient[p, x, i], {i, 1, n}]][b[1, Range[n], {}]]; Table[T[n], {n, 1, 9}] // Flatten (* _Jean-François Alcover_, Feb 19 2015, after _Alois P. Heinz_ *)
%Y A125182 Cf. A000142, A065608, A099152, A125183, A306455.
%K A125182 nonn,tabl
%O A125182 1,5
%A A125182 _Emeric Deutsch_, Nov 24 2006