A051252
Number of essentially different ways of arranging numbers 1 through 2n around a circle so that sum of each pair of adjacent numbers is prime.
Original entry on oeis.org
1, 1, 1, 2, 48, 512, 1440, 40512, 385072, 3154650, 106906168, 3197817022, 82924866213, 4025168862425, 127854811616691
Offset: 1
One arrangement for 2n=6 is 1,4,3,2,5,6 and this is essentially unique, so a(3)=1.
- R. K. Guy, Unsolved Problems in Number Theory, second edition, Springer, 1994. See section C1.
Cf.
A000341,
A070897,
A072616,
A072617,
A072618,
A072676,
A072184,
A103839,
A227050,
A228917,
A242527,
A242528.
-
$RecursionLimit=500; try[lev_] := Module[{t, j}, If[lev>2n, (*then make sure the sum of the first and last is prime*) If[PrimeQ[soln[[1]]+soln[[2n]]]&&soln[[2]]<=soln[[2n]], (*Print[soln]; *) cnt++ ], (*else append another number to the soln list*) t=soln[[lev-1]]; For[j=1, j<=Length[s[[t]]], j++, If[ !MemberQ[soln, s[[t]][[j]]], soln[[lev]]=s[[t]][[j]]; try[lev+1]; soln[[lev]]=0]]]]; For[lst={}; n=1, n<=7, n++, s=Table[{}, {2n}]; For[i=1, i<=2n, i++, For[j=1, j<=2n, j++, If[i!=j&&PrimeQ[i+j], AppendTo[s[[i]], j]]]]; soln=Table[0, {2n}]; soln[[1]]=1; cnt=0; try[2]; AppendTo[lst, cnt]]; lst (* T. D. Noe *)
A242522
Number of cyclic arrangements of S={1,2,...,n} such that the difference between any two neighbors is at least 2.
Original entry on oeis.org
0, 0, 0, 0, 1, 5, 33, 245, 2053, 19137, 196705, 2212037, 27029085, 356723177, 5058388153, 76712450925, 1239124984693, 21241164552785, 385159565775633, 7365975246680597, 148182892455224845, 3128251523599365177, 69149857480654157545, 1597343462243140957757
Offset: 1
The 5 cycles of length n=6 having this property are {1,3,5,2,4,6}, {1,3,5,2,6,4}, {1,3,6,4,2,5}, {1,4,2,5,3,6}, {1,4,2,6,3,5}.
- Andrew Woods, Table of n, a(n) for n = 1..100 (terms up to a(24) from _Hiroaki Yamanouchi_, Aug 28 2014)
- F. C. Holroyd and W. J. G. Wingate, Cycles in the complement of a tree or other graph, Discrete Math., 55 (1985), 267-282.
- S. Sykora, On Neighbor-Property Cycles, Stan's Library, Volume V, 2014.
- Eric Weisstein's World of Mathematics, Dipyramidal Graph
- Eric Weisstein's World of Mathematics, Hamiltonian Cycle
- Eric Weisstein's World of Mathematics, Path Complement Graph
- Eric Weisstein's World of Mathematics, Radio Labeling
- Eric Weisstein's World of Mathematics, Wheel Graph
Cf.
A242519,
A242520,
A242521,
A242523,
A242524,
A242525,
A242526,
A242527,
A242528,
A242529,
A242530,
A242531,
A242532,
A242533,
A242534.
-
a[n_ /; n < 5] = 0; a[5] = 1; a[6] = 5; a[n_] := a[n] = n a[n - 1] - (n - 5) a[n - 2] - (n - 4) a[n - 3] + (n - 4) a[n - 4]; Array[a, 24] (* Jean-François Alcover, Oct 07 2017 *)
Join[{0, 0}, RecurrenceTable[{a[n] == n a[n - 1] - (n - 5) a[n - 2] - (n - 4) a[n - 3] + (n - 4) a[n - 4], a[3] == a[4] == 0, a[5] == 1, a[6] == 5}, a, {n, 20}]] (* Eric W. Weisstein, Apr 12 2018 *)
A242528
Number of cyclic arrangements of {0,1,...,n-1} such that both the difference and the sum of any two neighbors are prime.
Original entry on oeis.org
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 2, 4, 18, 13, 62, 8, 133, 225, 209, 32, 2644, 4462, 61341, 113986, 750294, 176301, 7575912, 3575686, 7705362, 36777080, 108638048, 97295807
Offset: 1
For n=12 (the first n for which a(n)>0) there are two such cycles:
C_1={0, 5, 2, 9, 4, 1, 6, 11, 8, 3, 10, 7},
C_2={0, 7, 10, 3, 8, 5, 2, 9, 4, 1, 6, 11}.
Cf.
A227050,
A242519,
A242520,
A242521,
A242522,
A242523,
A242524,
A242525,
A242526,
A242527,
A242529,
A242530,
A242531,
A242532,
A242533,
A242534.
-
A242528[n_] :=
Count[Map[lpf, Map[j0f, Permutations[Range[n - 1]]]], 0]/2;
j0f[x_] := Join[{0}, x, {0}];
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[A242528[n], {n, 1, 8}]
(* OR, a less simple, but more efficient implementation. *)
A242528[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[]];
A242528[n, Join[perm, {new}],
Complement[Range[n - 1], perm, {new}]];
];
Return[ct];
];
];
Table[ct = 0; A242528[n, {0}, Range[n - 1]]/2, {n, 1, 18}]
(* Robert Price, Oct 22 2018 *)
A242519
Number of cyclic arrangements of S={1,2,...,n} such that the difference between any two neighbors is 2^k for some k=0,1,2,...
Original entry on oeis.org
0, 1, 1, 1, 4, 8, 14, 32, 142, 426, 1204, 3747, 9374, 26306, 77700, 219877, 1169656, 4736264, 17360564, 69631372, 242754286, 891384309, 3412857926, 12836957200, 42721475348, 152125749587, 549831594988
Offset: 1
The four such cycles of length 5 are:
C_1={1,2,3,4,5}, C_2={1,2,4,3,5}, C_3={1,2,4,5,3}, C_4={1,3,2,4,5}.
The first and the last of the 426 such cycles of length 10 are:
C_1={1,2,3,4,5,6,7,8,10,9}, C_426={1,5,7,8,6,4,3,2,10,9}.
Cf.
A001710,
A236602,
A242520,
A242521,
A242522,
A242523,
A242524,
A242525,
A242526,
A242527,
A242528,
A242529,
A242530,
A242531,
A242532,
A242533,
A242534.
-
A242519[n_] := Count[Map[lpf, Map[j1f, Permutations[Range[2, n]]]], 0]/2;
j1f[x_] := Join[{1}, x, {1}];
lpf[x_] := Length[Select[Abs[Differences[x]], ! MemberQ[t, #] &]];
t = Table[2^k, {k, 0, 10}];
Join[{0, 1}, Table[A242519[n], {n, 3, 10}]]
(* OR, a less simple, but more efficient implementation. *)
A242519[n_, perm_, remain_] := Module[{opt, lr, i, new},
If[remain == {},
If[MemberQ[t, Abs[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[! MemberQ[t, Abs[Last[perm] - new]], Continue[]];
A242519[n, Join[perm, {new}],
Complement[Range[2, n], perm, {new}]];
];
Return[ct];
];
];
t = Table[2^k, {k, 0, 10}];
Join[{0, 1}, Table[ct = 0; A242519[n, {1}, Range[2, n]]/2, {n, 3, 12}]] (* Robert Price, Oct 22 2018 *)
A242520
Number of cyclic arrangements of S={1,2,...,2n} such that the difference between any two neighbors is 3^k for some k=0,1,2,...
Original entry on oeis.org
1, 1, 2, 3, 27, 165, 676, 3584, 19108, 80754, 386776, 1807342, 8218582, 114618650, 1410831012, 12144300991, 126350575684
Offset: 1
The two such cycles of length n=6 are:
C_1={1,2,3,6,5,4}, C_2={1,2,5,6,3,4}.
The first and last of the 27 such cycles of length n=10 are:
C_1={1,2,3,4,5,6,7,8,9,10}, C_27={1,4,7,8,5,2,3,6,9,10}.
Cf.
A242519,
A242521,
A242522,
A242523,
A242524,
A242525,
A242526,
A242527,
A242528,
A242529,
A242530,
A242531,
A242532,
A242533,
A242534.
-
A242520[n_] := Count[Map[lpf, Map[j1f, Permutations[Range[2, 2 n]]]], 0]/2;
j1f[x_] := Join[{1}, x, {1}];
lpf[x_] := Length[Select[Abs[Differences[x]], ! MemberQ[t, #] &]];
t = Table[3^k, {k, 0, 10}];
Join[{1}, Table[A242520[n], {n, 2, 5}]]
(* OR, a less simple, but more efficient implementation. *)
A242520[n_, perm_, remain_] := Module[{opt, lr, i, new},
If[remain == {},
If[MemberQ[t, Abs[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[! MemberQ[t, Abs[Last[perm] - new]], Continue[]];
A242520[n, Join[perm, {new}],
Complement[Range[2, 2 n], perm, {new}]];
];
Return[ct];
];
];
t = Table[3^k, {k, 0, 10}];
Join[{1}, Table[ct = 0; A242520[n, {1}, Range[2, 2 n]]/2, {n, 2, 8}]] (* Robert Price, Oct 22 2018 *)
A242521
Number of cyclic arrangements (up to direction) of {1,2,...,n} such that the difference between any two neighbors is b^k for some b>1 and k>1.
Original entry on oeis.org
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 2, 4, 6, 9, 42, 231, 1052, 3818, 10086, 27892, 90076, 310301, 993680, 4663558, 22038882, 162588454, 1246422151, 8655752023, 58951670318, 347675502245
Offset: 1
The two cycles of length n=13 (the smallest n such that a(n)>0) are: C_1={1,5,9,13,4,8,12,3,7,11,2,6,10}, C_2={1,9,5,13,4,8,12,3,7,11,2,6,10}.
Cf.
A242519,
A242520,
A242522,
A242523,
A242524,
A242525,
A242526,
A242527,
A242528,
A242529,
A242530,
A242531,
A242532,
A242533,
A242534.
-
A242521[n_] := Count[Map[lpf, Map[j1f, Permutations[Range[2, n]]]], 0]/2;
j1f[x_] := Join[{1}, x, {1}];
lpf[x_] := Length[Select[Abs[Differences[x]], ! MemberQ[t, #] &]];
t = Flatten[Table[b^k, {k, 2, 5}, {b, 2, 5}]];
Table[A242521[n], {n, 1, 10}]
(* OR, a less simple, but more efficient implementation. *)
A242521[n_, perm_, remain_] := Module[{opt, lr, i, new},
If[remain == {},
If[MemberQ[t, Abs[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[! MemberQ[t, Abs[Last[perm] - new]], Continue[]];
A242521[n, Join[perm, {new}],
Complement[Range[2, n], perm, {new}]];
];
Return[ct];
];
];
t = Flatten[Table[b^k, {k, 2, 5}, {b, 2, 5}]];
Table[ct = 0; A242521[n, {1}, Range[2, n]]/2, {n, 1, 18}] (* Robert Price, Oct 24 2018 *)
A242523
Number of cyclic arrangements of S={1,2,...,n} such that the difference between any two neighbors is at least 3.
Original entry on oeis.org
0, 0, 0, 0, 0, 0, 1, 11, 125, 1351, 15330, 184846, 2382084, 32795170, 481379278, 7513591430, 124363961357, 2176990766569, 40199252548280, 781143277669538, 15937382209774353, 340696424417421213, 7616192835573406931, 177723017354688250713, 4321711817908214684734
Offset: 1
The shortest cycle with this property has length n=7: {1,4,7,3,6,2,5}.
Cf.
A242519,
A242520,
A242521,
A242522,
A242524,
A242525,
A242526,
A242527,
A242528,
A242529,
A242530,
A242531,
A242532,
A242533,
A242534.
-
A242523[n_] := Count[Map[lpf, Map[j1f, Permutations[Range[2, n]]]], 0]/2;
j1f[x_] := Join[{1}, x, {1}];
lpf[x_] := Length[Select[Abs[Differences[x]], # < 3 &]];
Table[A242523[n], {n, 1, 10}]
(* OR, a less simple, but more efficient implementation. *)
A242523[n_, perm_, remain_] := Module[{opt, lr, i, new},
If[remain == {},
If[Abs[First[perm] - Last[perm]] >= 3, ct++];
Return[ct],
opt = remain; lr = Length[remain];
For[i = 1, i <= lr, i++,
new = First[opt]; opt = Rest[opt];
If[Abs[Last[perm] - new] < 3, Continue[]];
A242523[n, Join[perm, {new}],
Complement[Range[2, n], perm, {new}]];
];
Return[ct];
];
];
Table[ct = 0; A242523[n, {1}, Range[2, n]]/2, {n, 1, 11}] (* Robert Price, Oct 24 2018 *)
A242524
Number of cyclic arrangements of S={1,2,...,n} such that the difference between any two neighbors is at least 4.
Original entry on oeis.org
0, 0, 0, 0, 0, 0, 0, 0, 1, 24, 504, 8320, 131384, 2070087, 33465414, 561681192, 9842378284, 180447203232, 3462736479324, 69517900171056, 1458720714556848, 31955023452174314, 729874911380470641, 17359562438053760533, 429391730229931885360
Offset: 1
The shortest such cycle has length n=9: {1,5,9,4,8,3,7,2,6}.
Cf.
A242519,
A242520,
A242521,
A242522,
A242523,
A242525,
A242526,
A242527,
A242528,
A242529,
A242530,
A242531,
A242532,
A242533,
A242534.
-
A242524[n_] := Count[Map[lpf, Map[j1f, Permutations[Range[2, n]]]], 0]/2;
j1f[x_] := Join[{1}, x, {1}];
lpf[x_] := Length[Select[Abs[Differences[x]], # < 4 &]];
Table[A242524[n], {n, 1, 10}]
(* OR, a less simple, but more efficient implementation. *)
A242524[n_, perm_, remain_] := Module[{opt, lr, i, new},
If[remain == {},
If[Abs[First[perm] - Last[perm]] >= 4, ct++];
Return[ct],
opt = remain; lr = Length[remain];
For[i = 1, i <= lr, i++,
new = First[opt]; opt = Rest[opt];
If[Abs[Last[perm] - new] < 4, Continue[]];
A242524[n, Join[perm, {new}],
Complement[Range[2, n], perm, {new}]];
];
Return[ct];
];
];
Table[ct = 0; A242524[n, {1}, Range[2, n]]/2, {n, 1, 12}] (* Robert Price, Oct 24 2018 *)
A242525
Number of cyclic arrangements of S={1,2,...,n} such that the difference between any two neighbors is at most 3.
Original entry on oeis.org
1, 1, 1, 3, 6, 10, 17, 31, 57, 104, 188, 340, 616, 1117, 2025, 3670, 6651, 12054, 21847, 39596, 71764, 130065, 235730, 427238, 774328, 1403395, 2543518, 4609881, 8354965, 15142569, 27444447, 49740415, 90149708, 163387657, 296124381, 536696900
Offset: 1
For n=4, The three cycles are: C_1={1,2,3,4}, C_2={1,2,4,3}, C_3={1,3,2,4}.
The first and the last of the 104 such cycles of length n=10 are: C_1={1,2,3,5,6,8,9,10,7,4}, C_104={1,3,6,9,10,8,7,5,2,4}.
Cf.
A242519,
A242520,
A242521,
A242522,
A242523,
A242524,
A242526,
A242527,
A242528,
A242529,
A242530,
A242531,
A242532,
A242533,
A242534.
-
A242525[n_] := Count[Map[lpf, Map[j1f, Permutations[Range[2, n]]]], 0]/2;
j1f[x_] := Join[{1}, x, {1}];
lpf[x_] := Length[Select[Abs[Differences[x]], # > 3 &]];
Join[{1, 1}, Table[A242525[n], {n, 3, 10}]]
(* OR, a less simple, but more efficient implementation. *)
A242525[n_, perm_, remain_] := Module[{opt, lr, i, new},
If[remain == {},
If[Abs[First[perm] - Last[perm]] <= 3, ct++];
Return[ct],
opt = remain; lr = Length[remain];
For[i = 1, i <= lr, i++,
new = First[opt]; opt = Rest[opt];
If[Abs[Last[perm] - new] > 3, Continue[]];
A242525[n, Join[perm, {new}],
Complement[Range[2, n], perm, {new}]];
];
Return[ct];
];
];
Join[{1, 1},
Table[ct = 0; A242525[n, {1}, Range[2, n]]/2, {n, 3, 12}] ](* Robert Price, Oct 24 2018 *)
-
lista(nn) = {my(v=[1, 1, 1, 3, 6, 10, 17]); for(n=8, nn, v = concat(v, v[n-1] + v[n-2] + v[n-4] + v[n-5])); v}; \\ Yifan Xie, Mar 20 2025
A242526
Number of cyclic arrangements of S={1,2,...,n} such that the difference between any two neighbors is at most 4.
Original entry on oeis.org
1, 1, 1, 3, 12, 36, 90, 214, 521, 1335, 3473, 9016, 23220, 59428, 152052, 389636, 999776, 2566517, 6586825, 16899574, 43352560, 111213798, 285319258, 732016006, 1878072638, 4818362046, 12361809384, 31714901077, 81366445061, 208750870961
Offset: 1
The 3 cycles of length n=4 are: {1,2,3,4},{1,2,4,3},{1,3,2,4}.
The first and the last of the 1335 such cycles of length n=10 are:
C_1={1,2,3,4,6,7,8,10,9,5}, C_1335={1,4,8,10,9,7,6,3,2,5}.
Cf.
A242519,
A242520,
A242521,
A242522,
A242523,
A242524,
A242525,
A242527,
A242528,
A242529,
A242530,
A242531,
A242532,
A242533,
A242534.
-
A242526[n_] := Count[Map[lpf, Map[j1f, Permutations[Range[2, n]]]], 0]/2;
j1f[x_] := Join[{1}, x, {1}];
lpf[x_] := Length[Select[Abs[Differences[x]], # > 4 &]];
Join[{1, 1}, Table[A242526[n], {n, 3, 10}]]
(* OR, a less simple, but more efficient implementation. *)
A242526[n_, perm_, remain_] := Module[{opt, lr, i, new},
If[remain == {},
If[Abs[First[perm] - Last[perm]] <= 4, ct++];
Return[ct],
opt = remain; lr = Length[remain];
For[i = 1, i <= lr, i++,
new = First[opt]; opt = Rest[opt];
If[Abs[Last[perm] - new] > 4, Continue[]];
A242526[n, Join[perm, {new}],
Complement[Range[2, n], perm, {new}]];
];
Return[ct];
];
];
Join[{1, 1}, Table[ct = 0; A242526[n, {1}, Range[2, n]]/2, {n, 3, 12}] ](* Robert Price, Oct 25 2018 *)
Showing 1-10 of 19 results.
Comments