5
$\begingroup$

Here is a video on Truncatable Primes. I tried to build it myself. Here is what I have tried using the method in the video for left Truncatable Primes.

myNextList[n_] := Select[10^(Length[IntegerDigits[n]])*Range[9] + n, PrimeQ];
SetAttributes[myNextList, Listable];

So a bit of testing:

myNextList[91]

{191, 491, 691, 991}

myNextList[3947]

{}

and

myNextList[{13, 23, 43, 53, 73, 83}]

{{113, 313, 613}, {223, 523, 823}, {443, 643, 743}, {353, 653, 853, 953}, {173, 373, 673, 773}, {283, 383, 683, 883, 983}}

Now the goal is to repeate the proccess until we get none of them returns a prime. So I tried

NestWhileList[myNextList, 7, AllTrue[#, PrimeQ] &]
NestWhile[myNextList, 7, AllTrue[#, PrimeQ] &]

{{317, 617}, {137, 337, 937}, {347, 547, 647, 947}, {167, 367, 467, 967}, {197, 397, 797, 997}}

which should be continued ...

myNextList[%]

{{{6317, 8317}, {2617, 3617}}, {{2137, 3137, 9137}, {4337, 6337, 9337}, {4937, 7937}}, {{2347, 3347, 5347}, {3547, 4547, 6547, 7547, 9547}, ...

I think it's an easy fix, with the test part, which I have used AllTrue[#, PrimeQ] &. But I don't know how to fix it.

If I just use

Nest[myNextList, 1, 8]
Nest[myNextList, 7, 8]
Nest[myNextList, 7, 16]

for example, it all worked fine. But I want to repeat something from the video and find all 1422 end points (as stated in the video at 04:49)

$\endgroup$

2 Answers 2

5
$\begingroup$

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

$\endgroup$
4
  • $\begingroup$ maybe if we add myNextList[0]={2,3,5,7}; and start the nesting from 0 (that is, g = NestGraph[myNextList,0,10^3]), then leaves // Length gives 1442. (+1 of course) $\endgroup$
    – kglr
    Sep 14, 2019 at 8:51
  • $\begingroup$ @kglr Yup, that did it. Thank you! $\endgroup$
    – C. E.
    Sep 14, 2019 at 15:08
  • 1
    $\begingroup$ Related post on the Wolfram Community site. $\endgroup$ Sep 14, 2019 at 17:19
  • $\begingroup$ @RohitNamjoshi Thanks. $\endgroup$
    – CasperYC
    Sep 15, 2019 at 0:09
5
$\begingroup$

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

$\endgroup$
1
  • $\begingroup$ Seemed like my initial code myNextList isn't good after all as it can not get the whole list of 1442 numbers. I thought about using FixedPointList but then got a bit confused. Thanks. $\endgroup$
    – CasperYC
    Sep 14, 2019 at 15:44

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service and acknowledge you have read our privacy policy.

Not the answer you're looking for? Browse other questions tagged or ask your own question.