找回密码
 注册
Simdroid-非首页
查看: 271|回复: 19

[欧拉习题] Project Euler No.4: Find the largest palindrome

[复制链接]
发表于 2008-12-9 13:43:10 | 显示全部楼层 |阅读模式 来自 江苏无锡
A palindromic number reads the same both ways. The largest palindrome made from the product of two 2-digit numbers is 9009 = 91 * 99.

Find the largest palindrome made from the product of two 3-digit numbers.


找出最大的回文数字,它们是由两个3位数字的乘积。


My Answer with Mathematica Code


  1. Timing@Select[Range[999*999,100*100,-1],
  2. (IntegerDigits[#]==Reverse[IntegerDigits[#]])&&
  3. (Length[k=Select[Sort[Divisors[#],Greater],100<=#<=999&]]>=2)&&
  4. (Times[k[[1]],k[[2]]]==#)&,1]


复制代码
{0.735, {906609}}

[ 本帖最后由 FreddyMusic 于 2008-12-9 16:20 编辑 ]
发表于 2008-12-9 14:41:09 | 显示全部楼层 来自 陕西安康
Simdroid开发平台
Code 1

  1. In[1]:= ClearSystemCache[]
  2. Timing@(
  3.   data1 = Range[100, 999];
  4.   data2 =
  5.    Union[Flatten[
  6.      Table[data1[[i]] data1[[j]], {i, 1, 899}, {j, i + 1, 900}]]];
  7.   Max@Select[data2, IntegerDigits[#] == Reverse[IntegerDigits[#]] &])
  8. Out[2]= {1.872, 906609}
复制代码


Code 2

  1. In[3]:= ClearSystemCache[]
  2. Timing@(data1 = Range[100, 999];
  3.   data3 = {0, 0, 0};
  4.   For[i = 1, i <= 899, i++,
  5.    For[j = 2, j <= 900, j++, data = data1[[i]]*data1[[j]];
  6.     If[IntegerDigits[data] == Reverse[IntegerDigits[data]] &&
  7.       data > data3[[1]],
  8.      data3 = {data, data1[[i]], data1[[j]]}
  9.      ]
  10.     ]
  11.    ])
  12. data3
  13. Out[4]= {7.613, Null}
  14. Out[5]= {906609, 913, 993}
复制代码


Code 3

  1. In[7]:= Timing@(data1 = Range[100, 999];
  2.   data2 =
  3.    Sort[Select[
  4.      Flatten[Table[{data1[[i]] data1[[j]], data1[[i]],
  5.         data1[[j]]}, {i, 1, 899}, {j, i + 1, 900}], 1],
  6.      IntegerDigits[#[[1]]] == Reverse@IntegerDigits[#[[1]]] &],
  7.     #1[[1]] > #2[[1]] &];)
  8. data2[[1]]
  9. Out[7]= {3.323, Null}
  10. Out[8]= {906609, 913, 993}
复制代码

[ 本帖最后由 changqing 于 2008-12-9 15:06 编辑 ]
回复 不支持

使用道具 举报

 楼主| 发表于 2008-12-9 14:45:46 | 显示全部楼层 来自 江苏无锡
changqing's answer is right. The right answer is 906609 = 814 * 894

My previous answer is wrong, which is 997799 = 90709 *11
回复 不支持

使用道具 举报

发表于 2008-12-9 14:50:46 | 显示全部楼层 来自 陕西安康

回复 3# FreddyMusic 的帖子

输入有误。
回复 不支持

使用道具 举报

 楼主| 发表于 2008-12-9 16:04:16 | 显示全部楼层 来自 江苏无锡
I has reached a better running time with a better understanding the constrain relation.


  1. In[87]:= Timing@
  2. Select[
  3. Range[999*999,100*100,-1],
  4. (IntegerDigits[#]==Reverse[IntegerDigits[#]])&&
  5. (Length[Select[Sort[Divisors[#],Greater],100<=#<=999&]]>= 2)&&
  6. (Times[First@Select[Sort[Divisors[#],Greater],100<=#<=999&,2],Last@Select[Sort[Divisors[#],Greater],100<=#<=999&,2]]==#)&,1]

  7. Out[87]= {0.86,{906609}}

复制代码
回复 不支持

使用道具 举报

发表于 2008-12-9 16:48:07 | 显示全部楼层 来自 山西太原
  1. In[8]:= ClearSystemCache[];
  2. Timing@Max@
  3.   Select[Union@Flatten@Outer[Times, a = Range[999], a],
  4.    IntegerDigits[#] == Reverse[IntegerDigits[#]] &]

  5. Out[9]= {1.56, 906609}
复制代码
回复 不支持

使用道具 举报

发表于 2008-12-9 18:54:50 | 显示全部楼层 来自 甘肃兰州
我觉得这个题比较难……
大家给出的代码也好多看不懂,继续研究中……
回复 不支持

使用道具 举报

发表于 2008-12-9 22:29:56 | 显示全部楼层 来自 北京

回复 6# marveloustau 的帖子

:victory: ,你的Outer用的恰到好处。

应该不难看出六位数的回文数一定是11的倍数,于是推知,至少有一个三位数是11的倍数,这样可以把范围缩小,同时Union命令也就可以去掉了。
  1. Timing@Max@Select[Flatten@Outer[Times, Range[100, 999], 11 Range[10, 90]], IntegerDigits[#] == Reverse[IntegerDigits[#]] &]
复制代码
回复 不支持

使用道具 举报

发表于 2008-12-9 22:39:41 | 显示全部楼层 来自 北京

回复

用Pick也可以,不过慢了一点
  1. Timing@Max@Pick[a = Flatten@Outer[Times, Range[100, 999], 11 Range[10, 90]], IntegerDigits[#] == Reverse[IntegerDigits[#]] & /@ a]
复制代码
回复 不支持

使用道具 举报

 楼主| 发表于 2008-12-10 08:31:43 | 显示全部楼层 来自 江苏无锡
I used a statistic way to find the Top 10 of biggest number to minimize the computering.


  1. ClearSystemCache[];
  2. Max[Select[
  3.    Flatten[Outer[Times, Range[999, 100, -1], Range[999, 100, -1]]],
  4.    IntegerDigits[#] == Reverse[IntegerDigits[#]] &, 10]] // Timing
复制代码
Actually the biggest number comes, when at 3.


  1. ClearSystemCache[];
  2. Max[Select[
  3.    Flatten[Outer[Times, Range[999, 100, -1], Range[999, 100, -1]]],
  4.    IntegerDigits[#] == Reverse[IntegerDigits[#]] &, 3]] // Timing
复制代码
I cann't yet prove that to be correct from mathematics viewpoint, but if you plot all palindrome number in the range,
You would see, it makes some sence.

  1. ListPlot[Select[
  2.   Flatten[Outer[Times, Range[999, 100, -1], Range[999, 100, -1]]],
  3.   IntegerDigits[#] == Reverse[IntegerDigits[#]] &]]
复制代码
That may need a condition or criteria, that shows if the new searching number is always going down.

[ 本帖最后由 FreddyMusic 于 2008-12-10 08:42 编辑 ]

本帖子中包含更多资源

您需要 登录 才可以下载或查看,没有账号?注册

×
回复 不支持

使用道具 举报

 楼主| 发表于 2008-12-10 09:56:59 | 显示全部楼层 来自 江苏无锡
OK, another small programming. Using Functional programming + Command programming.  :lol

It's reaching 0.14 s in my laptop. Any new record ?


  1. ClearSystemCache[];
  2. number = {};
  3. Timing@
  4. For[k = 1, k <= 9, k++,
  5.   For[j = 0, j <= 9, j++,
  6.    For[i = 0, i <= 9, i++,
  7.     t = k*100001 + j*10010 + i*1100;
  8.     If[(Length[
  9.          Select[Sort[Divisors[t], Greater], 100 <= # <= 999 &]] >=
  10.         2) &&
  11.       (Times[
  12.          First@Select[Sort[Divisors[t], Greater], 100 <= # <= 999 &,
  13.            2], Last@
  14.           Select[Sort[Divisors[t], Greater], 100 <= # <= 999 &, 2]] ==
  15.          t),
  16.      number = Append[number, t]; Break[]
  17.      ]
  18.     ]
  19.    ]
  20.   ]
  21. Max[number]

复制代码
回复 不支持

使用道具 举报

 楼主| 发表于 2008-12-10 17:03:55 | 显示全部楼层 来自 江苏无锡
Just use way code to test new technology.
Much faster...............................................


  1. Timing@Parallelize@
  2.   Max@Pick[a =
  3.      Flatten@Outer[Times, Range[100, 999], 11 Range[10, 90]],
  4.     IntegerDigits[#] == Reverse[IntegerDigits[#]] & /@ a]

复制代码


0.016
回复 不支持

使用道具 举报

发表于 2008-12-10 22:11:15 | 显示全部楼层 来自 山西太原
啊?直接这么用就可以?
回复 不支持

使用道具 举报

 楼主| 发表于 2008-12-11 10:05:18 | 显示全部楼层 来自 江苏无锡
Parallel computing don't help for all problem. Sometimes it's almost same as one core.

But this problem fit the parallel computing very comfortable.
回复 不支持

使用道具 举报

发表于 2008-12-11 10:10:01 | 显示全部楼层 来自 北京海淀

回复 14# FreddyMusic 的帖子

你好像还没把用法摸透吧?
据我所知,好像还可以用户自己分配任务吧?

不过,程序本身如果很简单,就会出现得不偿失的现象,:lol
回复 不支持

使用道具 举报

 楼主| 发表于 2008-12-11 10:19:56 | 显示全部楼层 来自 江苏无锡
I assume we have all equiped with 7.0.

Anyway, we don't know which task assign to one of the core? and How ?

I find the time of paralle computering is not correctly. It's obvious longer than 10 seconds, but Mathematica shows Zero almost.

  1. ClearSystemCache[];
  2. reps = 100;
  3. {allTime, res} =
  4.   Timing@
  5.    Do[
  6.     Parallelize@
  7.      Max@Select[
  8.        Flatten@Outer[Times, Range[100, 999], 11 Range[10, 90]],
  9.        IntegerDigits[#] == Reverse[IntegerDigits[#]] &]
  10.     , {reps}];
  11. allTime
  12. ScientificForm[allTime/reps]
复制代码
回复 不支持

使用道具 举报

发表于 2008-12-11 10:26:34 | 显示全部楼层 来自 北京海淀

回复 16# FreddyMusic 的帖子

是系统自动分配的,你只需启动所有的核,设置一下,
我的是老机子,不支持Parallel Computating,你看看帮助文件嘛,
guide/ParallelComputationSetupAndConfiguration

$KernelCount
ParallelEvaluate[expr]

[ 本帖最后由 waynebuaa 于 2008-12-11 10:27 编辑 ]
回复 不支持

使用道具 举报

发表于 2008-12-11 11:34:04 | 显示全部楼层 来自 山西太原
对了看帮助说Timing是CPU时间,不知道会不会是把所有Kernel的用时加起来了。还有一个AbsoluteTiming你可以试试

评分

1

查看全部评分

回复 不支持

使用道具 举报

 楼主| 发表于 2008-12-11 11:56:05 | 显示全部楼层 来自 江苏无锡
tau,

You are right, That's my question.

The Timing or CPU timing is reduceing through paralle programming,

But the Absolute timing is increasing, with paralle programming.

see my notebook below to save your time.

本帖子中包含更多资源

您需要 登录 才可以下载或查看,没有账号?注册

×
回复 不支持

使用道具 举报

发表于 2010-7-19 15:22:25 | 显示全部楼层 来自 江苏南通
本帖最后由 chyanog 于 2010-8-27 14:36 编辑

好久没有上网了,,暑假无聊温故下PE部分习题,又有了新思路
效率自觉还算可以.

  1. Intersection[
  2.    Flatten@Table[100001 i + 10010 j + 1100 k, {i, 9}, {j, 0, 9}, {k, 0, 9}],
  3.    Union @@ Outer[Times,  Range[100, 999], Range[110, 990, 11]]] //
  4.   Max // Timing
复制代码
{0.015, 906609}

  1. Timing[
  2. test[n_] :=
  3.   MemberQ[IntegerLength[
  4.     Table[#[[{i, -i}]], {i, 2, Length[#]/2}] &[Divisors[n]]], {3, 3}];
  5. Select[Table[1000 i + FromDigits@Reverse@IntegerDigits, {i, 100, 999}],
  6.    test] // Max
  7. ]

复制代码
{0.047, 906609}
回复 不支持

使用道具 举报

您需要登录后才可以回帖 登录 | 注册

本版积分规则

Archiver|小黑屋|联系我们|仿真互动网 ( 京ICP备15048925号-7 )

GMT+8, 2024-3-29 20:01 , Processed in 0.062219 second(s), 18 queries , Gzip On, MemCache On.

Powered by Discuz! X3.5 Licensed

© 2001-2024 Discuz! Team.

快速回复 返回顶部 返回列表