A227050 Number of essentially different ways of arranging numbers 1 through 2n around a circle so that the sum and absolute difference of each pair of adjacent numbers are prime.

0, 0, 0, 0, 0, 2, 1, 4, 88, 0, 976, 22277, 22365, 376002, 3172018, 5821944, 10222624, 424452210, 6129894510, 38164752224

Offset: 1

Author

Tim Cieplowski, Jun 29 2013

Keywords

• nonn
• more
• hard

Comments

See a similar problem, but for the set of numbers {0 through (n-1)}. - Stanislav Sykora, May 30 2014

Examples

			For n = 6 the a(6) = 2 solutions are (1, 4, 9, 2, 5, 12, 7, 10, 3, 8, 11, 6) and (1, 6, 11, 8, 3, 10, 7, 4, 9, 2, 5, 12) because abs(1 - 4) = 3 and 1 + 4 = 5 are prime, etc.
		

Links

• Gary Antonick, Numberplay: Bernardo Recamán’s Primes in a Circle Puzzle, Jun 17 2013.
• Stanislav Sykora, On Neighbor-Property Cycles, Stan's Library, Volume V, 2014; Table III.

Crossrefs

Cf. similar sequences: A051252 (with sums of neighbors prime), A242527 (with sums of neighbors prime), A228626 (with differences of neighbors prime), A242528 (with sums and differences of neighbors prime).

Programs

Mathematica

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

Extensions

a(15)-a(18) added by Tim Cieplowski, Jan 04 2015

a(19) from Fausto A. C. Cariboni, Jun 06 2017

a(20) from Bert Dobbelaere, Feb 15 2020