login
Palindromic primes whose squares are the sum of three consecutive primes.
1

%I #8 Jul 26 2023 17:20:05

%S 7,11,151,191,929,10301,14741,15451,76667,98689,1062601,1153511,

%T 1175711,1215121,1300031,1317131,1489841,1597951,3075703,3127213,

%U 3362633,3441443,7354537,7472747,7662667,9127219,9196919,9451549,9561659

%N Palindromic primes whose squares are the sum of three consecutive primes.

%C The number of such palindromic primes less than 10^n: 1, 2, 5, 5, 10, 10, 30, 30, 141, 141, 843, 843, 5856, 5856, 42675, 42675, ....

%H Robert G. Wilson v, <a href="/A130704/b130704.txt">Table of n, for n = 1..1000</a>.

%F Intersection of A002385 and A034961.

%e 7^2 = 49 = 13 + 17 + 19.

%e 11^2 = 121 = 37 + 41 + 43.

%t NextPalindrome[n_] := Block[{l = Floor[Log[10, n] + 1], idn = IntegerDigits[n]}, If[ Union[idn] == {9}, Return[n + 2], If[l < 2, Return[n + 1], If[ FromDigits[ Reverse[ Take[idn, Ceiling[l/2]]]] > FromDigits[ Take[idn, -Ceiling[l/2]]], FromDigits[ Join[ Take[ idn, Ceiling[l/2]], Reverse[Take[idn, Floor[l/2]]]]], idfhn = FromDigits[ Take[idn, Ceiling[l/2]]] + 1; idp = FromDigits[ Join[ IntegerDigits[ idfhn], Drop[ Reverse[ IntegerDigits[ idfhn]], Mod[l, 2]]]]]]]];

%t PrevPrim[n_] := Block[{k = n - 1}, While[ ! PrimeQ[k], k-- ]; k]; NextPrim[n_] := Block[{k = n + 1}, While[ ! PrimeQ[k], k++ ]; k]; fQ[n_] := Block[{p, q, r, s}, q = PrevPrim[ Ceiling[n^2/3]]; p = PrevPrim@q; r = NextPrim[ Floor[n^2/3]]; s = NextPrim@r; n^2 == p + q + r || n^2 == q + r + s];

%t pd = 6; lst = {}; Do[pd = NextPalindrome@pd; If[ PrimeQ@pd && fQ@pd, AppendTo[lst, pd]], {n, 10^8}]; lst

%t Select[Sqrt[#]&/@(Total/@Partition[Prime[Range[10^7]],3,1]),PalindromeQ[#]&&PrimeQ[#]&] (* The program generates the first 8 terms of the sequence. To generate more, increase the Range constant, but the program may take a long time to run. *) (* _Harvey P. Dale_, Jul 26 2023 *)

%K base,nonn,less

%O 1,1

%A _Robert G. Wilson v_, Jun 19 2007