A242529
Number of cyclic arrangements (up to direction) of numbers 1,2,...,n such that any two neighbors are coprime.
Original entry on oeis.org
1, 1, 1, 1, 6, 2, 36, 36, 360, 288, 11016, 3888, 238464, 200448, 3176496, 4257792, 402573312, 139511808, 18240768000, 11813990400, 440506183680, 532754620416, 96429560832000, 32681097216000, 5244692024217600, 6107246661427200, 490508471914905600, 468867166554931200, 134183696369843404800
Offset: 1
There are 6 such cycles of length n=5: C_1={1,2,3,4,5}, C_2={1,2,3,5,4},
C_3={1,2,5,3,4}, C_4={1,2,5,4,3}, C_5={1,3,2,5,4}, and C_6={1,4,3,2,5}.
For length n=6, the count drops to just 2:
C_1={1,2,3,4,5,6}, C_2={1,4,3,2,5,6}.
Cf.
A242519,
A242520,
A242521,
A242522,
A242523,
A242524,
A242525,
A242526,
A242527,
A242528,
A242530,
A242531,
A242532,
A242533,
A242534.
-
A242529[n_] := Count[Map[lpf, Map[j1f, Permutations[Range[2, n]]]], 0]/2;
j1f[x_] := Join[{1}, x, {1}];
lpf[x_] := Length[Select[cpf[x], # != 1 &]];
cpf[x_] := Module[{i},
Table[GCD[x[[i]], x[[i + 1]]], {i, Length[x] - 1}]];
Join[{1, 1}, Table[A242529[n], {n, 3, 10}]]
(* OR, a less simple, but more efficient implementation. *)
A242529[n_, perm_, remain_] := Module[{opt, lr, i, new},
If[remain == {},
If[GCD[First[perm], Last[perm]] == 1, ct++];
Return[ct],
opt = remain; lr = Length[remain];
For[i = 1, i <= lr, i++,
new = First[opt]; opt = Rest[opt];
If[GCD[Last[perm], new] != 1, Continue[]];
A242529[n, Join[perm, {new}],
Complement[Range[2, n], perm, {new}]];
];
Return[ct];
];
];
Join[{1, 1},Table[ct = 0; A242529[n, {1}, Range[2, n]]/2, {n, 3, 12}] ](* Robert Price, Oct 25 2018 *)
A242530
Number of cyclic arrangements of S={1,2,...,2n} such that the binary expansions of any two neighbors differ by one bit.
Original entry on oeis.org
0, 0, 1, 0, 2, 8, 0, 0, 224, 754, 0, 26256, 0, 0, 22472304, 0, 90654576, 277251016, 0, 7852128780
Offset: 1
The two cycles for n=5 (cycle length 10) are:
C_1={1,3,7,5,4,6,2,10,8,9}, C_2={1,5,4,6,7,3,2,10,8,9}.
Cf.
A236602,
A242519,
A242520,
A242521,
A242522,
A242523,
A242524,
A242525,
A242526,
A242527,
A242528,
A242529,
A242531,
A242532,
A242533,
A242534.
-
A242530[n_] := Count[Map[lpf, Map[j1f, Permutations[Range[2, 2 n]]]], 0]/2;
j1f[x_] := Join[{1}, x, {1}];
btf[x_] := Module[{i},
Table[DigitCount[BitXor[x[[i]], x[[i + 1]]], 2, 1], {i,
Length[x] - 1}]];
lpf[x_] := Length[Select[btf[x], # != 1 &]];
Table[A242530[n], {n, 1, 5}]
(* OR, a less simple, but more efficient implementation. *)
A242530[n_, perm_, remain_] := Module[{opt, lr, i, new},
If[remain == {},
If[DigitCount[BitXor[First[perm], Last[perm]], 2, 1] == 1, ct++];
Return[ct],
opt = remain; lr = Length[remain];
For[i = 1, i <= lr, i++,
new = First[opt]; opt = Rest[opt];
If[DigitCount[BitXor[Last[perm], new], 2, 1] != 1, Continue[]];
A242530[n, Join[perm, {new}],
Complement[Range[2, 2 n], perm, {new}]];
];
Return[ct];
];
];
Table[ct = 0; A242530[n, {1}, Range[2, 2 n]]/2, {n, 1, 10}] (* Robert Price, Oct 25 2018 *)
A242531
Number of cyclic arrangements of S={1,2,...,n} such that the difference of any two neighbors is a divisor of their sum.
Original entry on oeis.org
0, 1, 1, 1, 1, 4, 3, 9, 26, 82, 46, 397, 283, 1675, 9938, 19503, 10247, 97978, 70478, 529383, 3171795, 7642285, 3824927, 48091810, 116017829, 448707198, 1709474581, 6445720883, 3009267707, 51831264296
Offset: 1
The only such cycle of length n=5 is {1,2,4,5,3}.
For n=7 there are three solutions: C_1={1,2,4,5,7,6,3}, C_2={1,2,4,6,7,5,3}, C_3={1,2,6,7,5,4,3}.
Cf.
A242519,
A242520,
A242521,
A242522,
A242523,
A242524,
A242525,
A242526,
A242527,
A242528,
A242529,
A242530,
A242532,
A242533,
A242534.
-
A242531[n_] := Count[Map[lpf, Map[j1f, Permutations[Range[2, n]]]], 0]/2;
j1f[x_] := Join[{1}, x, {1}];
dvf[x_] := Module[{i},
Table[Divisible[x[[i]] + x[[i + 1]], x[[i]] - x[[i + 1]]], {i,
Length[x] - 1}]];
lpf[x_] := Length[Select[dvf[x], ! # &]];
Join[{0, 1}, Table[A242531[n], {n, 3, 10}]]
(* OR, a less simple, but more efficient implementation. *)
A242531[n_, perm_, remain_] := Module[{opt, lr, i, new},
If[remain == {},
If[Divisible[First[perm] + Last[perm],
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[! Divisible[Last[perm] + new, Last[perm] - new], Continue[]];
A242531[n, Join[perm, {new}],
Complement[Range[2, n], perm, {new}]];
];
Return[ct];
];
];
Join[{0, 1}, Table[ct = 0; A242531[n, {1}, Range[2, n]]/2, {n, 3, 13}]] (* Robert Price, Oct 25 2018 *)
A242532
Number of cyclic arrangements of S={2,3,...,n+1} such that the difference of any two neighbors is greater than 1, and a divisor of their sum.
Original entry on oeis.org
0, 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 20, 39, 0, 0, 0, 0, 319, 967, 0, 0, 1464, 6114, 16856, 44370, 0, 0, 0, 0, 2032951, 8840796, 12791922, 101519154, 0, 0
Offset: 1
The shortest such cycle is of length n=9: {2,4,8,10,5,7,9,3,6}.
The next a(n)>0 occurs for n=14 and has 20 solutions.
The first and the last of these are:
C_1={2,4,8,10,5,7,14,12,15,13,11,9,3,6},
C_2={2,4,12,15,13,11,9,3,5,7,14,10,8,6}.
Cf.
A242519,
A242520,
A242521,
A242522,
A242523,
A242524,
A242525,
A242526,
A242527,
A242528,
A242529,
A242530,
A242531,
A242533,
A242534.
-
A242532[n_] := Count[Map[lpf, Map[j2f, Permutations[Range[3, n + 1]]]], 0]/2;
j2f[x_] := Join[{2}, x, {2}];
dvf[x_] := Module[{i},
Table[Abs[x[[i]] - x[[i + 1]]] > 1 &&
Divisible[x[[i]] + x[[i + 1]], x[[i]] - x[[i + 1]]], {i,
Length[x] - 1}]];
lpf[x_] := Length[Select[dvf[x], ! # &]];
Table[A242532[n], {n, 1, 10}]
(* OR, a less simple, but more efficient implementation. *)
A242532[n_, perm_, remain_] := Module[{opt, lr, i, new},
If[remain == {},
If[Abs[First[perm] - Last[perm]] > 1 &&
Divisible[First[perm] + Last[perm], 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[Abs[Last[perm] - new] <= 1 || !
Divisible[Last[perm] + new, Last[perm] - new], Continue[]];
A242532[n, Join[perm, {new}],
Complement[Range[3, n + 1], perm, {new}]];
];
Return[ct];
];
];
Table[ct = 0; A242532[n, {2}, Range[3, n + 1]]/2, {n, 1, 15}] (* Robert Price, Oct 25 2018 *)
A242534
Number of cyclic arrangements of S={1,2,...,n} such that the difference of any two neighbors is not coprime to their sum.
Original entry on oeis.org
1, 0, 0, 0, 0, 0, 0, 0, 0, 72, 288, 3600, 17856, 174528, 2540160, 14768640, 101030400, 1458266112, 11316188160, 140951577600, 2659218508800, 30255151463424, 287496736542720, 5064092578713600, 76356431941939200, 987682437203558400, 19323690313219522560
Offset: 1
The first and the last of the 72 cycles for n=10 are:
C_1={1,3,5,10,2,4,8,6,9,7} and C_72={1,7,5,10,8,4,2,6,3,9}.
There are no solutions for cycle lengths from 2 to 9.
Cf.
A242519,
A242520,
A242521,
A242522,
A242523,
A242524,
A242525,
A242526,
A242527,
A242528,
A242529,
A242530,
A242531,
A242532,
A242533.
-
A242534[n_] := Count[Map[lpf, Map[j1f, Permutations[Range[2, n]]]], 0]/2;
j1f[x_] := Join[{1}, x, {1}];
lpf[x_] := Length[Select[cpf[x], ! # &]];
cpf[x_] := Module[{i},
Table[! CoprimeQ[x[[i]] - x[[i + 1]], x[[i]] + x[[i + 1]]], {i,
Length[x] - 1}]];
Join[{1}, Table[A242534[n], {n, 2, 10}]]
(* OR, a less simple, but more efficient implementation. *)
A242534[n_, perm_, remain_] := Module[{opt, lr, i, new},
If[remain == {},
If[!
CoprimeQ[First[perm] + Last[perm], 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[CoprimeQ[Last[perm] + new, Last[perm] - new], Continue[]];
A242534[n, Join[perm, {new}],
Complement[Range[2, n], perm, {new}]];
];
Return[ct];
];
];
Join[{1}, Table[ct = 0; A242534[n, {1}, Range[2, n]]/2, {n, 2, 12}] ](* Robert Price, Oct 25 2018 *)
Comments