cp's OEIS Frontend

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.

%I A227050 #70 Feb 16 2020 01:17:48
%S A227050 0,0,0,0,0,2,1,4,88,0,976,22277,22365,376002,3172018,5821944,10222624,
%T A227050 424452210,6129894510,38164752224
%N 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.
%C A227050 See a similar problem, but for the set of numbers {0 through (n-1)}. - _Stanislav Sykora_, May 30 2014
%H A227050 Gary Antonick, <a href="http://wordplay.blogs.nytimes.com/2013/06/17/primes-circle/?_r=0">Numberplay: Bernardo Recamán’s Primes in a Circle Puzzle</a>, Jun 17 2013.
%H A227050 Stanislav Sykora, <a href="http://dx.doi.org/10.3247/SL5Math14.002">On Neighbor-Property Cycles</a>, <a href="http://ebyte.it/library/Library.html#math">Stan's Library</a>, Volume V, 2014; Table III.
%e A227050 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.
%t A227050 A227050[n_] :=
%t A227050 Count[Map[lpf, Map[j1f, Permutations[Range[2,2 n]]]], 0]/2;
%t A227050 j1f[x_] := Join[{1}, x, {1}];
%t A227050 lpf[x_] := Length[
%t A227050    Join[Select[asf[x], ! PrimeQ[#] &],
%t A227050     Select[Differences[x], ! PrimeQ[#] &]]];
%t A227050 asf[x_] := Module[{i}, Table[x[[i]] + x[[i + 1]], {i, Length[x] - 1}]];
%t A227050 Table[A227050[n], {n, 1, 6}]
%t A227050 (* OR, a less simple, but more efficient implementation. *)
%t A227050 A227050[n_, perm_, remain_] := Module[{opt, lr, i, new},
%t A227050    If[remain == {},
%t A227050      If[PrimeQ[First[perm] - Last[perm]] &&
%t A227050        PrimeQ[First[perm] + Last[perm]], ct++];
%t A227050      Return[ct],
%t A227050      opt = remain; lr = Length[remain];
%t A227050      For[i = 1, i <= lr, i++,
%t A227050       new = First[opt]; opt = Rest[opt];
%t A227050       If[! (PrimeQ[Last[perm] - new] && PrimeQ[Last[perm] + new]),
%t A227050        Continue[]];
%t A227050       A227050[n, Join[perm, {new}],
%t A227050        Complement[Range[2 n], perm, {new}]];
%t A227050       ];
%t A227050      Return[ct];
%t A227050      ];
%t A227050    ];
%t A227050 Table[ct = 0; A227050[n, {1}, Range[2, 2 n]]/2, {n, 1, 10}]
%t A227050 (* _Robert Price_, Oct 22 2018 *)
%o A227050 (C++) // Listed in the Sykora link.
%Y A227050 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).
%K A227050 nonn,more,hard
%O A227050 1,6
%A A227050 _Tim Cieplowski_, Jun 29 2013
%E A227050 a(15)-a(18) added by _Tim Cieplowski_, Jan 04 2015
%E A227050 a(19) from _Fausto A. C. Cariboni_, Jun 06 2017
%E A227050 a(20) from _Bert Dobbelaere_, Feb 15 2020