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