ProjEuler[35]：How many circular primes are there below one million?

jimogsh

The number, 197, is called a circular prime because all rotations of the digits: 197, 971, and 719, are themselves prime.

There are thirteen such primes below 100: 2, 3, 5, 7, 11, 13, 17, 31, 37, 71, 73, 79, and 97.

How many circular primes are there below one million?

数字197被称作“循环质数”，因为它的几个数位“（同方向）旋转”后得到的数字197，971仍然是质数。
要求找出1000000之内的所有“循环质数”。

jimogsh

1# jimogsh 我自己的做法：

1. In[1]:= primes = Select[Range[10^6], PrimeQ];
   
2. rr1[x_] :=
   
3. NestList[FromDigits[RotateRight[IntegerDigits[#]]] &, x,
   
4.   IntegerLength[x] - 1]; sum = 0;
   
5. If[Union@PrimeQ[rr1[#]] == {True}, sum += 1] & /@ primes; sum // Timing
   
6. 
   
7. Out[2]= {3.74267*10^-16, 55}

复制代码

期待更好的代码。

FreddyMusic

孺子可教矣。

waynebuaa

2# jimogsh

说明一下，你的Timing用的不对，因为后缀//优先级高于语句分隔符“;”

1. In[6]:= Timing[primes = Select[Range[10^6], PrimeQ];rr1[x_] :=NestList[FromDigits[RotateRight[IntegerDigits[#]]] &, x, IntegerLength[x] - 1]; sum = 0;
   
2. If[Union@PrimeQ[rr1[#]] == {True}, sum += 1] & /@ primes; sum]
   
3. Out[6]= {3.172, 55}

复制代码

1. 
   
2. In[8]:=  Timing[f = FromDigits /@ NestList[RotateRight, IntegerDigits[#], IntegerLength[#] - 1] &;Count[Prime@Range@PrimePi[10^6], x_ /;Not@MemberQ[PrimeQ[f[x]], False]]]
   
3. 
   
4. Out[8]= {2.375, 55}
   

复制代码

waynebuaa

由于该数的数字不可能含有偶数，所以，在算法上改进，速度又可以提高很多
以下代码仅供参考：

1. In[2]:= Timing[ f = FromDigits /@ NestList[RotateRight, IntegerDigits[#], IntegerLength[#] - 1] &; Count[Prime@Range@PrimePi[10^6], x_ /; Not@MemberQ[PrimeQ[f[x]], False]]]
   
2. Out[2]= {2.359, 55}

复制代码

1. 
   
2. In[5]:= Timing[f = FromDigits /@ NestList[RotateRight, IntegerDigits[#], IntegerLength[#] - 1] &;
   
3. Count[DeleteCases[Prime@Range@PrimePi[10^6], x_ /; MemberQ[OddQ[IntegerDigits[x]], False]],  x_ /; Not@MemberQ[PrimeQ[f[x]], False]] + 1]
   
4. Out[5]= {0.547, 55}
   

复制代码

jimogsh

2# jimogsh

说明一下，你的Timing用的不对，因为后缀//优先级高于语句分隔符“;”
In[6]:= Timing[primes = Select[Range[10^6], PrimeQ];rr1[x_] :=NestList[FromDigits[RotateRight]] &, x, IntegerLength[x] ...
waynebuaa 发表于 2009-10-12 10:45

这个我后来意识到了，把//Timing前面的所有内容加个括号就可以了。

AeroMusic

还有一种方法，用 1 ,3, 5, 9, 生成组合，6位数以下组合，然后验证。但是需要些数学证明。

总之，提出来一个问题：有一个洋葱头，要拨掉皮，每次拨多少合适？共拨几次？

AeroMusic

1. 
   
2. 
   
3. AbsoluteTiming[
   
4. primesDigitsRotate[x_]:=FromDigits/@NestList[RotateRight,IntegerDigits[x],IntegerLength[x]-1];
   
5. Count[Select[FromDigits/@Flatten[Table[Tuples[Range[1,9,2],i],{i,6}],1],PrimeQ],x_/;Not@MemberQ[PrimeQ[primesDigitsRotate[x]],False]]+1
   
6. ]
   

复制代码

Out[1]= {0.2343750,55}

waynebuaa

8# AeroMusic

呵呵,不错不错~~你的方法省了很多素性检验

在你的基础上,其实,还可以改进一下.
因为,循环素数不可能含有5

1. 
   
2. AbsoluteTiming[
   
3. primesDigitsRotate[x_] :=
   
4.   FromDigits /@
   
5.    NestList[RotateRight, IntegerDigits[x], IntegerLength[x] - 1];
   
6. Count[Select[
   
7.     FromDigits /@ Flatten[Table[Tuples[{1, 3, 7, 9}, i], {i, 6}], 1],
   
8.     PrimeQ],
   
9.    x_ /; Not@MemberQ[PrimeQ[primesDigitsRotate[x]], False]] + 2]
   
10. 
    

复制代码

加2是因为需要单独考虑2和5这两个素数

waynebuaa

很有意思,我加大了范围,发现后面的循环素数很少.
{2,3,5,7,11,13,17,37,79,113,197,199,337,1193,3779,
11939,19937,193939,199933,1111111111111111111,11111111111111111111111}

FreddyMusic

的确如此，它在 7 位和 8 位数上的优势更明显，是数量级的差异。

但是有一个问题，需要数学证明，证明仅有 {1, 3, 7, 9} 的组合。
这样的算法才是正确有效的，否则就是瞎蒙，答案是蒙对的。

我说的并不是，你要证明这道题，因为这道题太小了，仅是趣味练习。
我说的是一种普适而严谨的科学方法。