|
%I #10 Jun 03 2021 16:07:13
%S 137,4337,8291,9419,10937,13757,19427,20981,36011,38327,43397,59441,
%T 71327,74717,76871,90437,91571,117239,120941,121019,167021,181787,
%U 191561,196871,197597,221717,228881,239387,240881,271277,279119,289031
%N Lesser of twin primes such that both twin primes have no bases b, 1 < b < p-1, in which p is a palindrome.
%C Also primes in A016038 which are 2 less than their immediate successors.
%C Prime index of A138348: {33, 592, 1040, 1165, 1328, 1627, 2201, 2359, 3826, 4046, 4524, 6009, 7060, 7367, 7557, 8756, 8852, ...
%H Robert G. Wilson v, <a href="/A138348/b138348.txt">Table of n, a(n) for n = 1..95</a>
%t palindromicBases[n_] := Module[{p}, Table[p = IntegerDigits[n, b]; If[p == Reverse[p], {b, p}, Sequence @@ {}], {b, 2, n - 2}]]; lst = {}; Do[ If[ Length@ palindromicBases@ Prime@ n == 0, AppendTo[lst, Prime@n]], {n, 22189}]; lst[[ # ]] & /@ Select[ Range@ Length@ lst - 1, lst[[ # ]] + 2 == lst[[ # + 1]] &]
%t f[n_] := Block[{k = 2}, While[id = IntegerDigits[n, k]; id != Reverse@ id, k++ ]; k]; lst = {2}; Do[p = Prime@ n; If[ f@p == p - 1, AppendTo[lst, p]; Print@p], {n, 128149}]; lst[[ # ]] & /@ Select[Range@11284, lst[[ # ]] + 2 == lst[[ # + 1]] &]
%t nbQ[n_]:=NoneTrue[Table[IntegerDigits[n,b],{b,2,n-2}],#==Reverse[#]&] && NoneTrue[ Table[IntegerDigits[n+2,b],{b,2,n}],#==Reverse[#]&]; Select[ Select[Partition[Prime[Range[26000]],2,1],#[[2]]-#[[1]]==2&][[All,1]],nbQ] (* Requires Mathematica version 10 or later *) (* _Harvey P. Dale_, Jun 03 2021 *)
%Y Cf. A001359, A016038.
%K nonn,base
%O 1,1
%A _Robert G. Wilson v_, Mar 09 2008
|
