|
| |
|
|
A073467
|
|
a(n) is the number of essentially different ways in which the integers 1,2,3,...,2n can be arranged in a circle such that (1) all pairs of adjacent integers sum to a prime number and (2) all pairs of integers opposite each other on the circle sum to a prime.
|
|
0
|
|
|
|
1, 0, 0, 0, 4, 0, 8, 0, 556, 0, 16156, 0, 4545745, 0, 1697587998, 0
(list;
graph;
refs;
listen;
history;
text;
internal format)
|
|
|
|
OFFSET
|
1,5
|
|
|
COMMENTS
|
Note that a(n) = 0 for all even n because opposite numbers sum to an even number. The Mathematica program uses a backtracking algorithm to count the arrangements. To print the unique arrangements, remove the comments from around the print statement.
|
|
|
LINKS
|
|
|
|
EXAMPLE
|
a(5)=4 because there are four essential different arrangements: {1,2,3,4,7,6,5,8,9,10}, {1,2,3,10,7,6,5,8,9,4}, {1,2,9,4,7,6,5,8,3,10} and {1,2,9,10,7,6,5,8,3,4}.
|
|
|
MATHEMATICA
|
maxN=9; $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]]], If[lev<=n||MemberQ[s[[soln[[lev-n]]]], s[[t]][[j]]], soln[[lev]]=s[[t]][[j]]; try[lev+1]; soln[[lev]]=0]]]]]; For[lst={}; n=1, n<=maxN, 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]]]]; Delete[s[[1]], -1]; (* these will all be duplicates *) soln=Table[0, {2n}]; soln[[1]]=1; cnt=0; try[2]; AppendTo[lst, cnt]]; lst
|
|
|
CROSSREFS
|
|
|
|
KEYWORD
|
hard,more,nice,nonn
|
|
|
AUTHOR
|
|
|
|
EXTENSIONS
|
|
|
|
STATUS
|
approved
|
| |
|
|
