%I
%S 11,13,19,23,31,37,47,53,73,97,107,127,163,193,257,383,487,577,863,
%T 1153,2593,2917,4373,8747,995327,1492993,1990657,5308417,28311553,
%U 86093443,6879707137,1761205026817,2348273369087,5566277615617,7421703487487,21422803359743
%N Prime numbers p such that p^2  1 has exactly one distinct prime factor other than 2 and 3.
%C a) Only primes 2, 3, 5, 7 and 17 are known with the property that p^2  1 has no prime factors other than 2 and/or 3.
%C b) These prime numbers have p+1 in the form of 2^m*3^n and 2^j*q^k respectively, where q is a prime number other than 2 and 3.
%C c) Up to the 100000000th prime number (2038074743), first 30 terms were confirmed using first mathematica program.
%C d) Based on comment b), the second mathematica program checked up to the 12000th term of A003586, 54 terms were found.
%C e) So far only 97 and 577 have their prime factor repeated.
%C Item b) above is false for members 31 = 2^51; 127 = 2^71; and 257 = 2^8+1. Here one of the neighbors to p is of form 2^m, and the other one is of form 2*3^j*q^k. Call such members exceptional terms. The exceptional terms constitute the only difference between this sequence and A284037. The exceptional terms are either Fermat primes (A019434) or Mersenne primes (A000668).  _Jeppe Stig Nielsen_, Dec 01 2020
%C a(71) >= 10^300.  _David A. Corneth_, Dec 21 2020
%H David A. Corneth, <a href="/A215504/b215504.txt">Table of n, a(n) for n = 1..70</a> (first 53 terms from Lei Zhou)
%e For any primes less than 11, p^2  1 does not have factors other than 2 or 3.
%e 11^2  1 = 120 = 2^3*3*5, 5 is the only prime factor other than 2 and 3, so a(1) = 11;
%e 13^2  1 = 168 = 2^3*3*5, so a(2) = 13;
%e 17^2  1 = 288 = 2^5*3^2, so 17 is a not a term;
%e 19^2  1 = 360 = 2^3*3^2*5, so a(3) = 19.
%e 97^2  1 = 9408 = 2^6 * 3 * 7^2 which shows the other prime (7 here) can have multiplicity > 1.  _David A. Corneth_, Dec 21 2020
%t (* Method a *)
%t Table[While[p = Prime[i++]; Length[Delete[Delete[FactorInteger[p^2  1], 1], 1]] != 1]; p, {k, 1, 30}]
%t (* Method b *)
%t f[n_] := Block[{p2, p3 = 3^Range[0, Floor@ Log[3, n] + 1]}, p2 = 2^Floor[ Log[2, n/p3] + 1]; Min[ Select[ p2*p3, IntegerQ]]]; fQ[n_] := Block[{pq = n}, While[ Mod[pq, 2] == 0, pq /= 2]; While[ Mod[pq, 3] == 0, pq /= 3]; PrimeNu@ pq == 1]; k = 1; lst = {}; While[k < 10^50, If[ PrimeQ[k  1] && fQ[k  2], AppendTo[lst, k  1]]; If[ PrimeQ[k + 1] && fQ[k + 2], AppendTo[lst, k + 1]]; k = f@ k]; lst (* _Robert G. Wilson v_, Aug 23 2012 *)
%Y Cf. A003586, A284037.
%K nonn,hard
%O 1,1
%A _Lei Zhou_, Aug 13 2012
