Mathematica 9 is now available
Services & Resources / Wolfram Forums
-----
 /
MathGroup Archive
1995
*January
*February
*March
*April
*May
*June
*July
*August
*September
*October
*November
*December
*Archive Index
*Ask about this page
*Print this page
*Give us feedback
*Sign up for the Wolfram Insider

MathGroup Archive 1995

[Date Index] [Thread Index] [Author Index]

Search the Archive

Re: SuperPrimes

  • To: mathgroup at christensen.cybernetics.net
  • Subject: [mg634] Re: [mg622] SuperPrimes
  • From: lou (Lou D'Andria)
  • Date: Mon, 3 Apr 1995 10:35:37 -0600

At 11:04 PM 3/30/95, Don Piele wrote:
>I invite your input on a short little problem called:
>
>                  SUPERPRIME RIB
>
>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}



In[1]:= next[previous_] := Select[Flatten @
        Outer[10 #1 + #2 &,previous,Range[1,9,2]],PrimeQ];

In[2]:= superPrime[n_] := Nest[next,{2,3,5,7},n-1];

In[3]:= superPrime[4]

Out[3]= {2333, 2339, 2393, 2399, 2939, 3119, 3137, 3733, 3739, 3793, 3797,

>    5939, 7193, 7331, 7333, 7393}


I think you had one too many numbers in your example: 2579 isn't a superprime

What about repus prime rib, for all those left-handed butchers out here?
(Eg: 7, 907, and 6907 are prime, so 6907 is in repusPrime[4].)  This
problem seems fundamentally harder.  Here's the obvious slow method.  Any
one care to speed it up?


In[4]:= repusPrimeQ[n_] := And @@
        Map[ PrimeQ[Mod[n,#]]&,10^Range[Length @ IntegerDigits[n]] ]

In[5]:= repusPrime[n_] := Select[Range[10^(n-1),10^n-1],repusPrimeQ]

In[6]:= repusPrime[3]

Out[6]= {103, 107, 113, 137, 167, 173, 197, 223, 283, 307, 313, 317, 337,

>    347, 353, 367, 373, 383, 397, 443, 467, 503, 523, 547, 607, 613, 617,

>    643, 647, 653, 673, 683, 743, 773, 797, 823, 853, 883, 907, 937, 947,

>    953, 967, 983, 997}


Finally, for the ambidextrous butcher:

In[7]:= reallysuperPrime[n_] := Select[superPrime[n],repusPrimeQ]

In[8]:= Flatten[reallysuperPrime /@ Range[8]]

Out[8]= {2, 3, 5, 7, 23, 37, 53, 73, 313, 317, 373, 797, 3137, 3797,

>    739397}


Lou




  • Prev by Date: Re: elliptic integrals
  • Next by Date: Re: SuperPrimes
  • Previous by thread: SuperPrimes
  • Next by thread: Re: SuperPrimes