Thanks for your post! Another great example of mathematics using the Wolfram language. I met many other great examples like this in your book Programming in Mathematica Third Edition (1997). I still use this book frequently. Thank you!!

I also played around a bit, but focused on the large numbers, and to check my code I repeated some of you. Since we are making prime pencils, it is (for me) not about the highest number, but rather the largest (i.e. number of digits). So there can be multiple number which have the same number of digits. Here is a table (note I gave the final numbers in base 10 because I go above base 36):

And some plots

Red lines means: don't know yet… Note that the length of the primes very nicely correlate with the amount of work that has to be done ;-)

Happy new years!

@Marco Thiel @Roman Maeder Perhaps we can give an update to Neil Sloane on this, a previous list also had question marks in it, so even a partial update would be useful I think…

I've parallelized my search code and reduced it to just searching for the largest truncatable prime, and count of all such primes. Actually generating all primes and storing them on the master kernel doesn't work for the larger cases. If the primes are desired, they could be written to disk as they are found (on the parallel subkernels) with little extra effort.

I keep track of the total number of all truncatable primes, but more interesting is the number of maximal primes, those than cannot be extended any further. All the others are just truncations of these.

For base 10, for example, there are a total of 4260 truncatable primes, but only 1442 of these are maximal.

As the branching factor is rather low, the parallel search runs quite nicely, there is never a large pool of untested primes.

Computing for base 24 on a 20 core machine took 7.6 hours. There are 379,588,962 maximal primes, and 1,052,029,701 in total; the largest one has 53 digits and is hmjejfa3a71did9mfmnfe3d3kjha61kh92ifca3lb8gf444fbb7ah. These numbers are confirmed by the published results.

Here is a snapshot of the ongoing computation:

The display updates dynamically every few seconds and shows the largest prime found so far, its number of digits, the running counts of maximal primes, total number of primes, number of kernels running, and the sizes of the global and local pools of untested primes. Synchronization between master and subkernels happens only every few seconds, where they exchange progress information and als send pool entries back and forth as needed. The last line shows the current rates of maximal and total primes produced, and the number of synchronizations per second.

I caught the program just seconds before completion. The pools are running low and some workers are paused, waiting for more work to do.

I am now tackling base 30. So far the largest prime found is "lfm6l77krkjmn6t9tt7j71h2iakp2ihh2csf179q5h91t3ohb4o1n2r4rflbndccjjbnsj" with 70 digits. The running total is around 2.4G primes.

Usually, leading zeros are not considered. As they say in the paper referenced above:

It will be noted that we have excluded 0 as a leading digit. If we do not do this, the length of the longest left-truncatable prime becomes indeterminate since, for example, there are, with probability one, infinitely many primes of the form $10^k+3$.

So leading zeros can lead to trivial cases dominating the picture.

Best wishes,

Marco

Hi Sander,

no you cannot. In base 10 that is really the largest number. The scheme is such that it builds the primes up one step at a time; sometimes there are several digits that can be prepended and still give primes The algorithm follows all branches and interactively adds first digits. It turns out that after a finite number of steps all branches "die out", i.e. no other digit can be prepended.

That has of course something to do with the fact that prime numbers get sparse as we go to larger integers. The range that can be "searched" increases in higher bases, but the prime number density decreases. It turns out that the latter always wins.

In the range that we are discussing there are only two bases missing, base 24 and 30. It appears that we might be able to manage 24. Base 30 appears to more of a challenge. I have access to HPC facilities, but this algorithm needs huge speed improvements before it would make sense to attempt base 30.

It would be kind of cool if one could crowd source CPU time for such a thing. I think that this could be done similarly to the SETI project. Imagine Wolfram would be offering a scheme to donate CPU time that can be used by other people. That has all sorts of technical and legal issues, but would be cool.

Cheers,

Marco

The number of right-truncatable primes for bases up to 42 is given in A076586 in OEIS. Their number is quite a bit smaller than the right-truncatable ones.

Hi everyone,

here is another update. My computer has been calculating for a couple of days now and here is what I've got:

bin = Databin["zR0oyN8c"]

results = SortBy[DeleteDuplicates[Flatten["Data" /. Normal[Get@bin], 1]], First]

Grid[Join[{{"base", "# sequences", "max length", "string"}}, results],Frame -> All]

As you can see only the bases 24 and 30 are missing. Here is a graph of the behaviour - with these two bases missing:

ListLinePlot[results[[All, {1, 3}]], PlotTheme -> "Marketing", FrameLabel -> {"base", "max length"}, 
LabelStyle -> Directive[Bold, 16], ImageSize -> Large]

and

ListLogPlot[results[[All, {1, 2}]], PlotTheme -> "Marketing", FrameLabel -> {"base", "number strings"}, 
LabelStyle -> Directive[Bold, 16], ImageSize -> Large, PlotRange -> All, Joined -> True]

There are several observations here. Here is a little diagram with highlights:

ListLinePlot[results[[All, {1, 3}]], PlotTheme -> "Marketing", 
 FrameLabel -> {"base", "max length"}, 
 LabelStyle -> Directive[Bold, 16], ImageSize -> Large, 
 PlotRange -> {All, {0, 75}}, 
 Epilog -> {Red, Thickness[0.01], Line[{{0, 6}, {30, 73}}], Green, 
   Line[{{0, 0}, {35, 21}}], White, Opacity[0.4], 
   Rectangle[{12.5, 8}, {17.5, 28}], 
   Rectangle[{18.5, 10}, {23.5, 40}], 
   Rectangle[{24.5, 18}, {29.5, 48}], 
   Rectangle[{30.5, 19}, {35.5, 53}]}]

The green and red lines are to guide the eye and show estimates for lowest and highest values expected. The grey boxes indicate an M like structure. Left and right of which we expect particularly long sequences. The two values that are missing at 24 and 30 are exactly between two if these M like structures. So particularly high values occur at bases that are multiples of 6.

If this type of linear interpolation was correct we might expect string lengths of 58-60 for base 24 and something close to length 70 for base 30. It appears that the CPU time needed increases roughly exponentially with the length of the sequence, so we might have to wait for quite a bit for results on these bases.

Members of this Community have contacted me and have started to use more sophisticated methods to tackle these bases. I am convinced that they will beat me to it. I would love to see their results.

Also, I think that we all use PrimeQ. This uses heuristics for large prime numbers. It might be necessary to check whether these results are actually correct.

I have not found a list of left truncatable primes that has bases as large as the ones discussed here, so it is difficult to compare.

Also, we might want to start implementing something to be able to compute this for bases larger than 35 and perhaps think about mathematical arguments for the multiples of 6 observation. One thought is that this behaves a bit like the number of divisors of the respective base.

Cheers,

Marco

Very nice to consider other bases.

I haven't seen a discussion of primes that are truncatable from the right. There aren't too many of these shrinkable primes:

Clear[ShrinkablePrimes];

ShrinkablePrimes[] := Sort[ShrinkablePrimes[Range[9]]];

ShrinkablePrimes[ps_List] := Join @@ (ShrinkablePrimes /@ ps);

With[{appendDigits = Append /@ Range[9]},
  ShrinkablePrimes[p_Integer?PrimeQ] :=
   Prepend[ShrinkablePrimes[FromDigits /@ Through[appendDigits[IntegerDigits[p]]]], p]
  ];

ShrinkablePrimes[p_Integer] := {}

What's nice is that now all single-digit primes get a chance to contribute:

In[13]:= ShrinkablePrimes[]

Out[13]= {2, 3, 5, 7, 23, 29, 31, 37, 53, 59, 71, 73, 79, 233, 239,
293, 311, 313, 317, 373, 379, 593, 599, 719, 733, 739, 797, 2333,
2339, 2393, 2399, 2939, 3119, 3137, 3733, 3739, 3793, 3797, 5939,
7193, 7331, 7333, 7393, 23333, 23339, 23399, 23993, 29399, 31193,
31379, 37337, 37339, 37397, 59393, 59399, 71933, 73331, 73939,
233993, 239933, 293999, 373379, 373393, 593933, 593993, 719333,
739391, 739393, 739397, 739399, 2339933, 2399333, 2939999, 3733799,
5939333, 7393913, 7393931, 7393933, 23399339, 29399999, 37337999,
59393339, 73939133}

So the largest one is 73939133, which makes for a rather short pencil. Given the upcoming holiday season, one could consider printing it on the side of a prime candle.

I have now slightly updated the program and am running it on a multi core machine - I haven't actually tried to speed up the code in any intelligent way.

On one multi-core machine I am defining as before:

digitrange = Join[CharacterRange["1", "9"], CharacterRange["a", "z"]];

TruncatablePrimes[p_String, basis_Integer] := 
  With[{digits = Characters[p]}, h = FromDigits[p, basis];
   If[PrimeQ[h], {p, 
     TruncatablePrimes[ToString[#], 
        basis] & /@ (StringJoin[#] & /@ (Flatten[
            Prepend[digits, #]] & /@ (List /@ 
            digitrange[[1 ;; basis - 1]])))}, {}]];

generateAllStrings[basis_Integer] := 
 DeleteDuplicates[
  SortBy[
   Flatten[
    TruncatablePrimes[#, basis] & /@ 
     Flatten[(List /@ 
        Select[digitrange[[1 ;; basis - 1]], 
         PrimeQ[FromDigits[#, basis]] &])]], StringLength[#] &]]

I then create a data bin:

CreateDatabin[]

bin = Databin["zR0oyN8c"]

I also set the permissions public so you should be able to access the databin. I then launch my kernels:

LaunchKernels[]

and execute

results = {}; ParallelDo[
 AppendTo[
  results, {k, Length[#], StringLength[#[[-1]]], #[[-1]]} &@
   generateAllStrings[k]]; DatabinAdd[bin, results];, {k, 3, 35}]

From a second computer I can now check the progress:

bin = Databin["zR0oyN8c"]

results = 
SortBy[DeleteDuplicates[Flatten["Data" /. Normal[Get@bin], 1]], First];

Grid[results, Frame -> All]

which gives

I can now plot the length of the string vs the base:

ListLinePlot[results[[All, {1, 3}]], PlotTheme -> "Marketing", 
 FrameLabel -> {"base", "max length"}, 
 LabelStyle -> Directive[Bold, 16], ImageSize -> Large]

I will try to update this once I have some of the outstanding bases.

Cheers,

Marco

Very Good - I particularly like the recursive routine you came up with.