A061018

[Wouter Meeussen]

ID Number: A061018 : 
text should be:
a(n,m) number of permutations of (1,2,...,n) with one ore more fixed points in the m first positions

Table[Count[Permutations[Range[n]],p_/;( Times@@Take[(p-Range[n]),k]===0)],{n,7},{k,n}]

{{1}, {1, 1}, {2, 3, 4}, {6, 10, 13, 15}, {24, 42, 56, 67, 76}, {120, 216, 
    294, 358, 411, 455}, {720, 1320, 1824, 2250, 2612, 2921, 3186}}

========= whose row sums are the number of derangements of size n+1
========= can be made by:

Table[(n+1)! -T[n,m],{n,0,7},{m,0,n}]

{{1}, {1, 1}, {2, 3, 4}, {6, 10, 13, 15}, {24, 42, 56, 67, 76}, {120, 216, 
    294, 358, 411, 455}, {720, 1320, 1824, 2250, 2612, 2921, 3186}, {5040, 
    9360, 13080, 16296, 19086, 21514, 23633, 25487}}

========= or

Table[ n! + Sum[T[n-1,k],{k,0,m-1}]  ,{n,0,7},{m,0,n}]

{{1}, {1, 1}, {2, 3, 4}, {6, 10, 13, 15}, {24, 42, 56, 67, 76}, {120, 216, 
    294, 358, 411, 455}, {720, 1320, 1824, 2250, 2612, 2921, 3186}, {5040, 
    9360, 13080, 16296, 19086, 21514, 23633, 25487}}

========= using recurrence :

T[n_?Negative,_]:=0;
T[0,0]:=0;
T[n_,0]:=n n!;
T[n_,m_]:=T[n,m]=T[n,m-1]-T[n-1,m-1]


========= where I don't know if this deserves a name :

Table[T[n,m],{n,0,7},{m,0,n}]

{{0}, {1, 1}, {4, 3, 2}, {18, 14, 11, 9}, {96, 78, 64, 53, 44}, {600, 504, 
    426, 362, 309, 265}, {4320, 3720, 3216, 2790, 2428, 2119, 1854}, {35280, 
    30960, 27240, 24024, 21234, 18806, 16687, 14833}}

(the last entry on each row gives the derangements again)

wouter.