A242526 Number of cyclic arrangements of S={1,2,...,n} such that the difference between any two neighbors is at most 4.

1, 1, 1, 3, 12, 36, 90, 214, 521, 1335, 3473, 9016, 23220, 59428, 152052, 389636, 999776, 2566517, 6586825, 16899574, 43352560, 111213798, 285319258, 732016006, 1878072638, 4818362046, 12361809384, 31714901077, 81366445061, 208750870961

Offset

1,4

Comments

a(n)=NPC(n;S;P) is the count of all neighbor-property cycles for a specific set S of n elements and a specific pair-property P. For more details, see the link and A242519.

Links

Andrew Howroyd, Table of n, a(n) for n = 1..100

S. Sykora, On Neighbor-Property Cycles, Stan's Library, Volume V, 2014.

Formula

From Andrew Howroyd, Apr 08 2016: (Start)

Empirical: a(n) = 2*a(n-1) + a(n-2) - a(n-4) + 9*a(n-5) + 5*a(n-6) - a(n-7) - 7*a(n-8) - 10*a(n-9) + 2*a(n-10) + 2*a(n-11) + 2*a(n-12) + 4*a(n-13) - 2*a(n-17) - a(n-18) for n>20.

Empirical g.f.: x + (3 - 6*x - 2*x^2 - x^3 + 3*x^4 - 22*x^5 - 5*x^6 + x^7 + 8*x^8 + 14*x^9 - 6*x^10 + 2*x^11 - 6*x^12 - 6*x^13 - 3*x^15 + x^16 + 3*x^17) / (1 - 2*x - x^2 + x^4 - 9*x^5 - 5*x^6 + x^7 + 7*x^8 + 10*x^9 - 2*x^10 - 2*x^11 - 2*x^12 - 4*x^13 + 2*x^17 + x^18). (End)

Example

The 3 cycles of length n=4 are: {1,2,3,4},{1,2,4,3},{1,3,2,4}.
The first and the last of the 1335 such cycles of length n=10 are:
C_1={1,2,3,4,6,7,8,10,9,5}, C_1335={1,4,8,10,9,7,6,3,2,5}.

Mathematica

A242526[n_] := Count[Map[lpf, Map[j1f, Permutations[Range[2, n]]]], 0]/2;
j1f[x_] := Join[{1}, x, {1}];
lpf[x_] := Length[Select[Abs[Differences[x]], # > 4 &]];
Join[{1, 1}, Table[A242526[n], {n, 3, 10}]]
(* OR, a less simple, but more efficient implementation. *)
A242526[n_, perm_, remain_] := Module[{opt, lr, i, new},
   If[remain == {},
     If[Abs[First[perm] - Last[perm]] <= 4, ct++];
     Return[ct],
     opt = remain; lr = Length[remain];
     For[i = 1, i <= lr, i++,
      new = First[opt]; opt = Rest[opt];
      If[Abs[Last[perm] - new] > 4, Continue[]];
      A242526[n, Join[perm, {new}],
       Complement[Range[2, n], perm, {new}]];
      ];
     Return[ct];
     ];
   ];
Join[{1, 1}, Table[ct = 0; A242526[n, {1}, Range[2, n]]/2, {n, 3, 12}] ](* Robert Price, Oct 25 2018 *)

Prog

(C++) See the link.

Crossrefs

Cf. A242519, A242520, A242521, A242522, A242523, A242524, A242525, A242527, A242528, A242529, A242530, A242531, A242532, A242533, A242534.

Sequence in context: A101069 A225259 A334891 * A167667 A292291 A215919

Adjacent sequences: A242523 A242524 A242525 * A242527 A242528 A242529

Keyword

nonn

Author

Stanislav Sykora, May 27 2014

Extensions

a(22)-a(30) from Andrew Howroyd, Apr 08 2016

Status

approved