login
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.
5
0, 0, 0, 0, 0, 2, 1, 4, 88, 0, 976, 22277, 22365, 376002, 3172018, 5821944, 10222624, 424452210, 6129894510, 38164752224, 2489148327658
OFFSET
1,6
COMMENTS
See a similar problem, but for the set of numbers {0 through (n-1)}. - Stanislav Sykora, May 30 2014
LINKS
EXAMPLE
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.
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 *)
PROG
(C++) // Listed in the Sykora link.
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).
Sequence in context: A053374 A383083 A355517 * A242927 A093876 A375605
KEYWORD
nonn,more,hard
AUTHOR
Tim Cieplowski, Jun 29 2013
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
a(21) from Martin Fuller, Mar 11 2026
STATUS
approved