A130152 Triangle read by rows: T(n,k) = number of permutations p of [n] such that max(|p(i)-i|)=k (n>=1, 0<=k<=n-1).
1, 1, 1, 1, 2, 3, 1, 4, 9, 10, 1, 7, 23, 47, 42, 1, 12, 60, 157, 274, 216, 1, 20, 151, 503, 1227, 1818, 1320, 1, 33, 366, 1669, 4833, 10402, 13656, 9360, 1, 54, 877, 5472, 18827, 50879, 96090, 115080, 75600, 1, 88, 2088, 17531, 75693, 234061, 569602, 966456, 1077840, 685440, 1, 143, 4937, 55135, 304900, 1076807, 3111243, 6791994, 10553640, 11123280, 6894720
Offset: 1
Examples
T(4,1) = 4 because we have 1243, 1324, 2134 and 2143. Triangle starts: 1; 1, 1; 1, 2, 3; 1, 4, 9, 10; 1, 7, 23, 47, 42; 1, 12, 60, 157, 274, 216; ...
Links
- Alois P. Heinz, Rows n = 1..23, flattened
- Torleiv Kløve, Spheres of Permutations under the Infinity Norm - Permutations with limited displacement, Reports in Informatics, Department of Informatics, University of Bergen, Norway, no. 376, November 2008.
Crossrefs
Programs
-
Maple
with(combinat): for n from 1 to 7 do P:=permute(n): for i from 0 to n-1 do ct[i]:=0 od: for j from 1 to n! do if max(seq(abs(P[j][i]-i),i=1..n))=0 then ct[0]:=ct[0]+1 elif max(seq(abs(P[j][i]-i),i=1..n))=1 then ct[1]:=ct[1]+1 elif max(seq(abs(P[j][i]-i),i=1..n))=2 then ct[2]:=ct[2]+1 elif max(seq(abs(P[j][i]-i),i=1..n))=3 then ct[3]:=ct[3]+1 elif max(seq(abs(P[j][i]-i),i=1..n))=4 then ct[4]:=ct[4]+1 elif max(seq(abs(P[j][i]-i),i=1..n))=5 then ct[5]:=ct[5]+1 elif max(seq(abs(P[j][i]-i),i=1..n))=6 then ct[6]:=ct[6]+1 else fi od: a[n]:=seq(ct[i],i=0..n-1): od: for n from 1 to 7 do a[n] od; # a cumbersome program to obtain, by straightforward counting, the first 7 rows of the triangle n := 8: st := proc (p) max(seq(abs(p[j]-j), j = 1 .. nops(p))) end proc: with(combinat): P := permute(n): f := sort(add(t^st(P[i]), i = 1 .. factorial(n))); # program gives the row generating polynomial for the specified n - Emeric Deutsch, Aug 13 2009 # second Maple program: b:= proc(s) option remember; (n-> `if`(n=0, 1, add((p-> add( coeff(p, x, i)*x^max(i, abs(n-j)), i=0..degree(p)))( b(s minus {j})), j=s)))(nops(s)) end: T:= n-> (p-> seq(coeff(p, x, i), i=0..n-1))(b({$1..n})): seq(T(n), n=1..10); # Alois P. Heinz, Jan 21 2019 # third Maple program: A:= proc(n, k) option remember; LinearAlgebra[Permanent]( Matrix(n, (i, j)-> `if`(abs(i-j)<=k, 1, 0))) end: T:= (n, k)-> A(n, k)-A(n, k-1): seq(seq(T(n, k), k=0..n-1), n=1..10); # Alois P. Heinz, Jan 22 2019
-
Mathematica
(* from second Maple program: *) b[s_List] := b[s] = Function[n, If[n == 0, 1, Sum[Function[p, Sum[ Coefficient[p, x, i]*x^Max[i, Abs[n - j]], {i, 0, Exponent[p, x]}]][b[s ~Complement~ {j}]], {j, s}]]][Length[s]]; T[n_] := Function[p, Table[Coefficient[p, x, i], {i, 0, n-1}]][b[Range[n]] ]; Table[T[n], {n, 1, 11}] // Flatten (* from third Maple program: *) A[n_, k_] := A[n, k] = Permanent[Table[If[Abs[i-j] <= k, 1, 0], {i, 1, n}, {j, 1, n}]]; T[n_, k_] := A[n, k] - A[n, k - 1]; Table[Table[T[n, k], {k, 0, n - 1}], {n, 1, 11}] // Flatten (* Jean-François Alcover, Dec 06 2019, after Alois P. Heinz *)
Formula
Extensions
More terms from R. J. Mathar, Oct 15 2007
Comments