Building Truncatable Primes using Nest(List), While, Fold
Update 2: An alternative approach using FixedPoint
ClearAll[g0, g1, nextDigit]
nextDigit[a__] := Select[Range[9], PrimeQ[FromDigits[{#, a}]] &] /. {} -> {0};
g0[{0, a__}] := {{0, a}}
g0[{0}] := List /@ {2, 3, 5, 7}
g0[{a__}] := {#, a} & /@ nextDigit[a]
g1 = Join @@ g0 /@ # &;
ltprimes3 = FromDigits /@
DeleteCases[SplitBy[Join @@ FixedPoint[g1, {{0}}], # == 0 &], {0}];
Length @ ltprimes3
1442
Max @ ltprimes3
357686312646216567629137
Sort @ ltprimes3 == Sort @ ltprimes2
True
Update: To get the list of 1442 primes
ClearAll[myNextList2, f0, f1]
myNextList2[n_] := Select[10^(Length[IntegerDigits[n]])*Range[9] + n, PrimeQ] /. {} -> {""};
myNextList2[0] = {2, 3, 5, 7};
myNextList2[""] = Sequence[];
f0[Except[_List]] := Sequence[]
f0[{a___, ""}] := {a, ""}
f0[{a___, b_}] := {a, b, #} & /@ myNextList2[b]
f1 = Join @@ f0 /@ # &;
ltprimes2 = Cases[Join @@ FixedPointList[f1, {{0}}], {0, ___, x_, ""} :> x];
ltprimes2 // Sort // Short
{2, 5, 773, <<1436>>, 95918918997653319693967, 96686312646216567629137, 357686312646216567629137}
Max @ ltprimes2
357686312646216567629137
Length @ ltprimes2
1442
Original answer:
You can use FixedPointList
:
ltprimes = Join @@ FixedPointList[Composition[Flatten, myNextList], {2, 3, 5, 7}];
Length @ ltprimes
4260
Last @ ltprimes
357686312646216567629137
IntegerLength @ Last @ ltprimes
24
Count[FixedPoint[myNextList, {2, 3, 5, 7}], {}, {0, Infinity}]
1442
NestGraph
seems like a good choice:
ClearAll[myNextList]
myNextList[0] := {2, 3, 5, 7}
myNextList[n_] := Select[10^(Length[IntegerDigits[n]])*Range[9] + n, PrimeQ];
g = NestGraph[myNextList, 0, 10^3];
leaves = Pick[VertexList[g], VertexOutDegree[g], 0];
leaves // Length
1442
Max[leaves]
357686312646216567629137