A242531 Number of cyclic arrangements of S={1,2,...,n} such that the difference of any two neighbors is a divisor of their sum.
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
Examples
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}.
Links
- S. Sykora, On Neighbor-Property Cycles, Stan's Library, Volume V, 2014.
Crossrefs
Programs
-
Mathematica
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 *)
Extensions
a(24)-a(28) from Fausto A. C. Cariboni, May 25 2017
a(29) from Fausto A. C. Cariboni, Jul 09 2020
a(30) from Fausto A. C. Cariboni, Jul 14 2020
Comments