A242534 Number of cyclic arrangements of S={1,2,...,n} such that the difference of any two neighbors is not coprime to their sum.

1, 0, 0, 0, 0, 0, 0, 0, 0, 72, 288, 3600, 17856, 174528, 2540160, 14768640, 101030400, 1458266112, 11316188160, 140951577600, 2659218508800, 30255151463424, 287496736542720, 5064092578713600, 76356431941939200, 987682437203558400, 19323690313219522560

Offset: 1

Author

Stanislav Sykora, May 30 2014

Keywords

• nonn
• hard

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.

Compare this with A242533 where the property is inverted.

Examples

			The first and the last of the 72 cycles for n=10 are:
C_1={1,3,5,10,2,4,8,6,9,7} and C_72={1,7,5,10,8,4,2,6,3,9}.
There are no solutions for cycle lengths from 2 to 9.
		

Links

• Hiroaki Yamanouchi, Table of n, a(n) for n = 1..27
• 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, A242532, A242533.

Programs

Mathematica

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

Extensions

a(19)-a(27) from Hiroaki Yamanouchi, Aug 30 2014