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