login

Year-end appeal: Please make a donation to the OEIS Foundation to support ongoing development and maintenance of the OEIS. We are now in our 61st year, we have over 378,000 sequences, and we’ve reached 11,000 citations (which often say “discovered thanks to the OEIS”).

Number of cyclic arrangements of {0,1,...,n-1} such that both the difference and the sum of any two neighbors are prime.
20

%I #16 Oct 23 2018 03:03:02

%S 0,0,0,0,0,0,0,0,0,0,0,2,4,18,13,62,8,133,225,209,32,2644,4462,61341,

%T 113986,750294,176301,7575912,3575686,7705362,36777080,108638048,

%U 97295807

%N Number of cyclic arrangements of {0,1,...,n-1} such that both the difference and the sum of any two neighbors are prime.

%C 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.

%C In this case the set is S={0 through n-1}. For the same pair-property P but the set S={1 through n}, see A227050.

%H S. 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.

%e For n=12 (the first n for which a(n)>0) there are two such cycles:

%e C_1={0, 5, 2, 9, 4, 1, 6, 11, 8, 3, 10, 7},

%e C_2={0, 7, 10, 3, 8, 5, 2, 9, 4, 1, 6, 11}.

%t A242528[n_] :=

%t Count[Map[lpf, Map[j0f, Permutations[Range[n - 1]]]], 0]/2;

%t j0f[x_] := Join[{0}, x, {0}];

%t lpf[x_] := Length[

%t Join[Select[asf[x], ! PrimeQ[#] &],

%t Select[Differences[x], ! PrimeQ[#] &]]];

%t asf[x_] := Module[{i}, Table[x[[i]] + x[[i + 1]], {i, Length[x] - 1}]];

%t Table[A242528[n], {n, 1, 8}]

%t (* OR, a less simple, but more efficient implementation. *)

%t A242528[n_, perm_, remain_] := Module[{opt, lr, i, new},

%t If[remain == {},

%t If[PrimeQ[First[perm] - Last[perm]] &&

%t PrimeQ[First[perm] + Last[perm]], ct++];

%t Return[ct],

%t opt = remain; lr = Length[remain];

%t For[i = 1, i <= lr, i++,

%t new = First[opt]; opt = Rest[opt];

%t If[! (PrimeQ[Last[perm] - new] && PrimeQ[Last[perm] + new]),

%t Continue[]];

%t A242528[n, Join[perm, {new}],

%t Complement[Range[n - 1], perm, {new}]];

%t ];

%t Return[ct];

%t ];

%t ];

%t Table[ct = 0; A242528[n, {0}, Range[n - 1]]/2, {n, 1, 18}]

%t (* _Robert Price_, Oct 22 2018 *)

%o (C++) See the link.

%Y Cf. A227050, A242519, A242520, A242521, A242522, A242523, A242524, A242525, A242526, A242527, A242529, A242530, A242531, A242532, A242533, A242534.

%K nonn,hard,more

%O 1,12

%A _Stanislav Sykora_, May 30 2014

%E a(29)-a(33) from _Fausto A. C. Cariboni_, May 20 2017