text: Re: SuperPrimes
  
  • To: mathgroup at christensen.cybernetics.net
  • Subject: [mg632] Re: [mg622] SuperPrimes
  • From: villegas (Robert Villegas)
  • Date: Mon, 3 Apr 1995 02:14:42 -0500
  
  ```> Butchering Farmer John's cows always yields the best prime rib.  You can
  
  > tell prime ribs by looking at the digits lovingly stamped across them,
  
  > one by one, by FJ and the USDA.  Farmer John ensures that a purchaser of
  
  > his prime ribs gets really prime ribs because when sliced from the right,
  
  > the numbers on the ribs continue to stay prime right down to the last
  
  > rib, e.g.:
  >
  
  >      7 3 3 1
  >
  
  > The set of ribs 7331 is prime; the three ribs 733 are prime; the two ribs
  
  > 73 are prime, and, of course, the last rib, 7, is prime.  The number 7331
  
  > is called a superprime of length 4.
  >
  
  > Create a funciton superPrime[N] that accepts a number N of ribs and
  
  > prints all the superprimes of that length.
  
  >
  
  > In[1]	superPrime[4]
  >
  > Out[1]	{2333, 2339, 2393, 2399, 2579, 2939, 3119, 3137, 3733, 3739,
  
  >          3793, 3797, 5939, 7193, 7331, 7333, 7393}
  
  >
  
  > The faster the solution the better.
  
  Don,
  
  Straight from the definition, a number is superprime if and only
  if removing the last digit (the ones' digit) leaves a superprime.
  If you continue removing digits, you find that any superprime has
  to have a prime first digit.  So you can start with the one-digit
  primes {2, 3, 5, 7} as a basis and build up the superprimes by
  induction (the induction step uses the fact that any prime of two
  or more digits has to have an odd last digit).
  
  (Basis)  Start with superprimes {2, 3, 5, 7}.
  
  (Induction)  Given any superprime s, the prospective superprimes built from
  it are s followed by 1, 3, 5, 7, or 9.  In Mathematica notation, the list of
  superprimes built from s are:
  
  Select[10 s + {1, 3, 5, 7, 9}, PrimeQ]
  
  which can be empty.
  
  My induction step is pretty much a brute-force search of possibilities.
  Maybe some number theory knowledge could be brought to bear on this
  for a much better overall method.
  
  Here's an implementation of this approach:
  
  superPrime[n_] :=
  Nest[Flatten[#, 1]& @ Map[Select[10 # + {1, 3, 5, 7, 9}, PrimeQ]&, #] &,
  {2, 3, 5, 7}, n - 1]
  
  In[5]:= superPrime[4]
  
  Out[5]= {2333, 2339, 2393, 2399, 2939, 3119, 3137, 3733, 3739, 3793, 3797,
  
  >    5939, 7193, 7331, 7333, 7393}
  
  Incidentally, the list in Out[5] doesn't have 2579 in it, because 2579
  isn't superprime:  taking the first two digits gives 25, which isn't prime.
  
  It turns out that the number of superprimes of length n increases for a
  short while and then decreases, finally vanishing at 9:  there are no
  superprimes of length 9.  Presumably because primes are getting rarer
  at larger magnitudes.  We can make a list of lists of superprimes up to,
  say, n = 10 using NestList instead of Nest, and then create a table of
  lengths:
  
  In[7]:= lists = NestList[Flatten[#, 1]& @
  Map[Select[10 # + {1, 3, 5, 7, 9}, PrimeQ]&, #] &,
  {2, 3, 5, 7}, 10 - 1];
  
  In[8]:= Transpose[{Range @ Length[lists], Length /@ lists}] //TableForm
  
  Out[8]//TableForm= 1    4
  
  2    9
  
  3    14
  
  4    16
  
  5    15
  
  6    12
  
  7    8
  
  8    5
  
  9    0
  
  10   0
  
  Knowing this, you could add a final rule that would prevent the function
  from wasting time for n >= 9:
  
  superPrime[n_ /; n >= 9] := {}
  
  On a tangent, it's possible that a more useful output for the function
  would be a list of all superprimes of length from 1 to n, instead of just
  n.  At every step, each superprime spawns a set of superprimes with an
  added digit, for instance 7 spawns two-digit superprimes {71, 73, 79}.  We
  could show that relationship by making a nested list {7, {71, 73, 79}}.
  
  This implementation separates out the successor function, which could have
  been done for the flat list approach, too.
  
  In[9]:= nestedSuccessor[list_] :=
  Map[{#, Select[10 # + {1, 3, 5, 7, 9}, PrimeQ]}&,
  list, {Depth[list] - 1}]
  
  In[13]:= nestedSuperPrime[n_] := Nest[nestedSuccessor, {2, 3, 5, 7}, n - 1]
  
  In[15]:= nestedSuperPrime[2]
  
  Out[15]= {{2, {23, 29}}, {3, {31, 37}}, {5, {53, 59}}, {7, {71, 73, 79}}}
  
  We can use 'nestedSuccessor' to compute the complete set of
  superprimes (given that we know there are no additional ones past
  a certain point) because we can keep applying it until nothing new
  
  In[16]:= complete = FixedPoint[nestedSuccessor, {2, 3, 5, 7}]
  
  The output was about a page long, so I deleted it.
  
  Robby Villegas
  
  P.S.  Here's a quick way to, um, peel off the ribs (yuck):
  
  ribs[n_] := NestList[Quotient[#, 10]&, n, Floor @ N[Log[10, n]] ]
  
  Here are some alternative formulations of the function used in Nest
  in 'superPrime'.
  
  Select[Distribute[{10 #, {1, 3, 5, 7, 9}}, List, List, List, Plus], PrimeQ]&
  
  Select[Flatten[#, 1]& @ Outer[Plus, 10 #, {1, 3, 5, 7, 9}], PrimeQ]&
  
  Select[Sort @ Flatten[#, 1], PrimeQ]& @
  Thread[Unevaluated[10 # + {1, 3, 5, 7, 9}], List, -1] &
  
  ```
  
  • Prev by Date: Re: SuperPrimes
  • Next by Date: Mm <-> Lisp on mac ?
  • Previous by thread: Re: SuperPrimes
  • Next by thread: Re: Re: SuperPrimes