OFFSET
0,1
MATHEMATICA
f[n_] := Block[{p = Prime@ n, k = 0, w}, w = {p}; While[w != {}, w = Flatten@ Map[Block[{m = #, L = {}, q = 10, a, b, v}, While[q <= m, a = Floor[m/q]; b = Mod[m, q]; v = 10 q a + b; If[b >= q/10 && PrimeQ[v], AppendTo[L, v]]; q *= 10]; L] &, w]; k++]; k - 1]; With[{s = Array[f, 10^5]}, Map[If[# == 0, 0, Prime@ #] &@ First[FirstPosition[s, #] /. k_ /; MissingQ@ k -> {0}] &, Range[0, Max@ s]]] (* Michael De Vlieger, Jul 24 2017, after Giovanni Resta at A290174 *)
PROG
(PARI) insertzero(num, pos) = 10*(num-num%10^pos)+(num%10^pos)
zeroprimevec_num(n) = my(w=[]); for(k=1, #Str(n)-1, my(x=insertzero(n, k)); if(ispseudoprime(x), w=concat(w, [x]))); vecsort(w, , 8)
zeroprimevec_vec(v) = my(w=[]); for(k=1, #v, w=concat(w, zeroprimevec_num(v[k]))); vecsort(w, , 8)
a290174(n) = my(i=0, p=prime(n), v=zeroprimevec_num(p)); while(1, if(#v==0, return(i), i++); v=zeroprimevec_vec(v))
a(n) = my(x=1); while(1, if(a290174(x)==n, return(prime(x)), x++))
(PARI) first(n) = {n--; my(v = vector(n), todo = n, x=1); while(todo>0,
r = a290174(x); if(0<r&&r<=n, if(v[r]==0, v[r]=prime(x); todo--)); x++); concat([2], v)} \\ This prog uses the prog 'a290174' above. David A. Corneth, Jul 24 2017
CROSSREFS
KEYWORD
nonn,more
AUTHOR
Felix Fröhlich, Jul 24 2017
EXTENSIONS
a(20)-a(30) from Giovanni Resta, Jul 24 2017
STATUS
approved