A216725 Duplicate of A174073.
3, 24, 100, 594, 4389, 35744, 325395, 3288600
Offset: 3
This is a front-end for the Online Encyclopedia of Integer Sequences, made by Christian Perfect. The idea is to provide OEIS entries in non-ancient HTML, and then to think about how they're presented visually. The source code is on GitHub.
For n=5 (0,2,4,1,3) is an example of a permutation with an i,i+2,i+4 triple. If we look at 0,2,4 as a block, then we have 3! ways to permute the triple with the remaining 1 & 3. Hence a(5) = 5! - 3! = 114.
b:= proc(s, x, y) option remember; `if`(s={}, 1, add(
`if`(x=0 or x-y<>2 or y-j<>2, b(s minus {j}, y, j), 0), j=s))
end:
a:= n-> b({$1..n}, 0$2):
seq(a(n), n=0..14); # Alois P. Heinz, Apr 13 2021
b[s_, x_, y_] := b[s, x, y] = If[s == {}, 1, Sum[
If[x == 0 || x - y != 2 || y - j != 2,
b[s ~Complement~ {j}, y, j], 0], {j, s}]];
a[n_] := b[Range[n], 0, 0];
Table[a[n], {n, 0, 14}] (* Jean-François Alcover, Mar 02 2022, after Alois P. Heinz *)
Since a(5)=22, there are (5-1)!-22=2 circular permutations with consecutive triples i,i+2,i+4 in all circular permutations of length 5. They are exactly (0,2,4,1,3) and (0,2,4,3,1).
Since a(5)=18, there are (5-1)!-18=4 circular permutations with modular consecutive triples i,i+2,i+4 in all circular permutations of length 5. These are exactly (0,2,4,1,3), (0,2,4,3,1), (0,4,2,1,3), and (0,3,2,4,1). Note some have more than one modular progression.
f[i_,n_,k_]:=If[i==0 && k==0,1,If[i==n && n==k,1,Binomial[k-1,k-i]*Binomial[n-k-1,k-i-1] + 2*Binomial[k-1,k-i-1]*Binomial[n-k-1,k-i-1]+Binomial[k-1,k-i-1]*Binomial[n-k-1,k-i]]];
w1[i_,n_,k_]:=If[n-2k+i<0,0,If[n-2k+i==0,1,(n-2k+i-1)!]];
a[n_,k_]:=Sum[f[i,n,k]*w1[i,n,k],{i,0,k}];
A165962[n_]:=(n-1)!+Sum[(-1)^k*a[n,k],{k,1,n}];
b[n_,k_]:=Sum[Sum[Sum[f[j,n/2,p]*f[i-j,n/2,k-p]*w2[i,j,n,k,p],{p,0,k}],{j,0,i}],{i,0,k-1}];
w2[i_,j_,n_,k_,p_]:=If[n/2-2p+j<=0 || n/2-2(k-p)+(i-j)<=0,0,(n-2k+i-1)!];
A216727[n_?EvenQ]:=(n-1)!+Sum[(-1)^k*b[n,k],{k,1,n}];
A216727[n_?OddQ]:=A165962[n];
Table[A216727[n],{n,3,23}] (* David Scambler, Sep 18 2012 *)
For n=4, there are 4!-a(4)=8 permutations with some consecutive triple i,i+d,i+2d (mod 4). Here only d=1 and d=3 works, and the permutations are (0,1,2,3), (1,2,3,0), (2,3,0,1), (3,0,1,2), (0,3,2,1), (3,2,1,0), (2,1,0,3), and (1,0,3,2)
Triangle begins:
1
1
2
3 3
24 0
100 15 0 5
594 108 18 0
4389 504 119 21 0 7
35744 3520 960 64 32 0
325395 31077 5238 927 207 27 0 9
3288600 288300 42050 8800 900 100 50 0
...
b:= proc(s, x, y, n) option remember; expand(`if`(s={}, 1, add(
`if`(x>0 and irem(n+x-y, n)=2 and irem(n+y-j, n)=2, z, 1)*
b(s minus {j}, y, j, n), j=s)))
end:
T:= n-> (p-> seq(coeff(p, z, i), i=0..max(0,
iquo(n-1,2)*2-1)))(b({$1..n}, 0$2, n)):
seq(T(n), n=0..11); # Alois P. Heinz, Apr 13 2021
b[s_, x_, y_, n_] := b[s, x, y, n] = Expand[If[s == {}, 1, Sum[
If[x>0 && Mod[n + x - y, n] == 2 && Mod[n + y - j, n] == 2, z, 1]*
b[s~Complement~{j}, y, j, n], {j, s}]]];
T[n_] := Function[p, Table[Coefficient[p, z, i], {i, 0, Max[0,
Quotient[n - 1, 2]*2 - 1]}]][b[Range[n], 0, 0, n]];
Table[T[n], {n, 0, 11}] // Flatten (* Jean-François Alcover, Mar 06 2022, after Alois P. Heinz *)
Comments