1,2

NextPrim[n_] := Block[{k = n + 1}, While[ !PrimeQ[k], k++ ]; k]; PrimeExponents[n_] := Flatten[ Table[ #[[2]], {1}] & /@ FactorInteger[n]]; c = 0; p = q = 2; Do[ While[p < 10^n, q = NextPrim[p]; If[ Apply[ GCD, PrimeExponents[p + q]] > 1, c++ ]; p = q]; Print[c], {n, 1, 8}]

Cf. A001597, A091624.

Sequence in context: A088646 A090679 A031191 this_sequence A027601 A057592 A104321

Adjacent sequences: A091622 A091623 A091624 this_sequence A091626 A091627 A091628

nonn

Robert G. Wilson v (rgwv(AT)rgwv.com), Jan 24 2004