A069866 Primes in which repeatedly deleting the most significant digit then the least significant digit gives a prime at every step until a single-digit prime remains.
2, 3, 5, 7, 13, 17, 23, 37, 43, 47, 53, 67, 73, 83, 97, 131, 137, 173, 179, 223, 229, 271, 331, 337, 353, 359, 373, 379, 431, 479, 523, 571, 631, 653, 659, 673, 773, 823, 829, 853, 859, 929, 937, 953, 971, 1031, 1373, 1433, 1439, 1733, 2029, 2053, 2131, 2137
Offset: 1
Links
- Michael De Vlieger, Table of n, a(n) for n = 1..645 (Primes p <= 10^7).
Programs
-
Mathematica
Select[Prime@ Range@ 400, AllTrue[FromDigits /@ Rest@ Fold[Append[#1, Delete[Last[#1], 1 - 2 Boole[EvenQ@ #2]]] &, {#}, Range[Length@ # - 1]] &@ IntegerDigits[#], PrimeQ] &] (* Michael De Vlieger, Jan 20 2018 *)
Extensions
Corrected and extended by Larry Reeves (larryr(AT)acm.org), Sep 24 2002