cp's OEIS Frontend

A074063 a(n) is the number of essentially different ways in which the integers 1,2,3,...,n can be arranged in a sequence such that (1) adjacent integers sum to a prime number and (2) squares of adjacent numbers sum to a prime number. Rotations and reversals are counted only once.

%I A074063 #22 Apr 15 2025 23:25:40
%S A074063 1,1,1,1,0,1,0,0,0,3,1,1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,2,0,0,0,
%T A074063 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1481,4266,0,0,5624,0
%N A074063 a(n) is the number of essentially different ways in which the integers 1,2,3,...,n can be arranged in a sequence such that (1) adjacent integers sum to a prime number and (2) squares of adjacent numbers sum to a prime number. Rotations and reversals are counted only once.
%C A074063 It is known that a(n) > 0 for 58 <= n <= 200. It is conjectured that a(n) > 0 for all n > 57. A greedy algorithm can be used to quickly find a solution for many n. See the link to puzzle 189 for more details. The Mathematica program uses a backtracking algorithm to count the arrangements. To print the unique arrangements, remove the comments from around the print statement.
%C A074063 a(58) > 2.65*10^6; a(59) > 4.45*10^6. - _Alexander D. Healy_, Apr 07 2025
%H A074063 Carlos Rivera, <a href="http://www.primepuzzles.net/puzzles/puzz_189.htm">Puzzle 189: Squares and primes in a row</a>, The Prime Puzzles & Problems Connection.
%e A074063 a(4)=1 because there is essentially one arrangement: {3,2,1,4}.
%t A074063 nMax=12; $RecursionLimit=500; try[lev_] := Module[{t, j, circular}, If[lev>n, circular=PrimeQ[soln[[1]]^2+soln[[n]]^2]&&PrimeQ[soln[[1]]+soln[[n]]]; If[(!circular&&soln[[1]]<soln[[n]])||(circular&&soln[[1]]==1&&soln[[2]]<=soln[[n]]), (*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={1}; n=2, n<=nMax, n++, s=Table[{}, {n}]; For[i=1, i<=n, i++, For[j=1, j<=n, j++, If[i!=j&&PrimeQ[i^2+j^2]&&PrimeQ[i+j], AppendTo[s[[i]], j]]]]; soln=Table[0, {n}]; For[cnt=0; i=1, i<=n, i++, soln[[1]]=i; try[2]]; AppendTo[lst, cnt]]; lst
%Y A074063 Cf. A073451, A073452.
%K A074063 hard,more,nice,nonn
%O A074063 1,10
%A A074063 _T. D. Noe_, Aug 17 2002
%E A074063 a(52)-a(57) from _Alexander D. Healy_, Apr 01 2025