A242532 Number of cyclic arrangements of S={2,3,...,n+1} such that the difference of any two neighbors is greater than 1, and a divisor of their sum.

0, 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 20, 39, 0, 0, 0, 0, 319, 967, 0, 0, 1464, 6114, 16856, 44370, 0, 0, 0, 0, 2032951, 8840796, 12791922, 101519154, 0, 0

Offset: 1

Author

Stanislav Sykora, May 30 2014

Keywords

• nonn
• hard
• more

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.

For this property P and sets {0,1,2,...,n-1} or {1,2,...,n} the problem does not appear to have any solution.

a(40)=a(41)=a(42)=a(43)=a(46)=a(47)=0. - Fausto A. C. Cariboni, May 17 2017

Examples

			The shortest such cycle is of length n=9: {2,4,8,10,5,7,9,3,6}.
The next a(n)>0 occurs for n=14 and has 20 solutions.
The first and the last of these are:
C_1={2,4,8,10,5,7,14,12,15,13,11,9,3,6},
C_2={2,4,12,15,13,11,9,3,5,7,14,10,8,6}.
		

Links

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

Crossrefs

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

Programs

Mathematica

A242532[n_] := Count[Map[lpf, Map[j2f, Permutations[Range[3, n + 1]]]], 0]/2;
j2f[x_] := Join[{2}, x, {2}];
dvf[x_] := Module[{i},
   Table[Abs[x[[i]] - x[[i + 1]]] > 1 &&
     Divisible[x[[i]] + x[[i + 1]], x[[i]] - x[[i + 1]]], {i,
     Length[x] - 1}]];
lpf[x_] := Length[Select[dvf[x], ! # &]];
Table[A242532[n], {n, 1, 10}]
(* OR, a less simple, but more efficient implementation. *)
A242532[n_, perm_, remain_] := Module[{opt, lr, i, new},
   If[remain == {},
     If[Abs[First[perm] - Last[perm]] > 1 &&
       Divisible[First[perm] + Last[perm], First[perm] - Last[perm]],
      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] <= 1 || !
         Divisible[Last[perm] + new, Last[perm] - new], Continue[]];
      A242532[n, Join[perm, {new}],
       Complement[Range[3, n + 1], perm, {new}]];
      ];
     Return[ct];
     ];
   ];
Table[ct = 0; A242532[n, {2}, Range[3, n + 1]]/2, {n, 1, 15}] (* Robert Price, Oct 25 2018 *)

Extensions

a(29)-a(37) from Fausto A. C. Cariboni, May 17 2017