还不知道欧拉计划的点这里http://projecteuler.net，中文翻译参见http://pe.spiritzhang.com/index.php/2011-05-11-09-44-54
由于以前账号的发帖已被屏蔽，计划重新开贴，讨论各个题目的Mathematica解决，包括但不限于：题目的数学分析（如何解决，空间时间的要求），mma代码优化（代码简化，提高易读性拓展性维护性），做题心得，如此等等。
我先来抛砖引玉，把自己的做法和结果公布出来，中间也会有一些心得体会。大家有更好的思路和代码还请不舍赐教。

由于我用的小平板，运行速度慢，所以我更注重如何对代码提速。废话不多说，这是1-5题的代码。
001done
Module[{sumOfRange},
sumOfRange[x_] := Floor@x (Floor@x+ 1)/2; 3
#1[#
2/3] + 5
#1[#
2/5] - 15
#1[#
2/15] & @@ {sumOfRange, 1000 - 1}
]
233168
002done
Total@Select[
Fibonacci /@ Range[Log[4 10^6 Sqrt[5]]/Log[(Sqrt[5] + 1)/2]],
EvenQ]
4613732
以通项公式算上界
003done
Max[First /@ FactorInteger@600851475143]
6857
004done
Module[{list = Reverse@Range[100, 999], guess, ans, reverseQ},
reverseQ[x_Integer] := Reverse@# == # &@IntegerDigits@x;
guess = First@Select[
NestWhile[
(1000 - Length@#) Range[999, 999 - Length@#, -1] &,
{999 999},
! Or @@ (reverseQ /@ #) &],
reverseQ];
Max@Select[
Times @@@ Tuples[Range[Ceiling[guess/999], 999], 2],
reverseQ]
]
906609
先找出一个“比较大”的值，由此定出Tuples的范围，再找出最大值。直接用Tuples[Range[100,999],2]将耗费较多时间。
005done
LCM @@ Range@20
232792560

6-10.
006done
Total[Range@100]^2 - Total[Range[100]^2]
25164150
007done
Prime[10001]
104743
008done
Max[Times @@ # & /@
Partition[
Flatten[IntegerDigits /@
Import["E:\\work\\ProjectEuler\\008.txt", "List"]], 5, 1]]
40824
好吧我承认，从这道题我才开始学用Import导入数据……
009done
(m^2 + n^2) (m^2 - n^2) 2 m n /.
ToRules@Reduce[{2 m^2 + 2 m n == 1000, m > n > 0}, {m, n}, Integers]
31875000
010done
Module[{n = 2 10^6, sqrtn},
sqrtn = Floor@Sqrt@n;
Total@Flatten@
NestWhile[
{Complement[#1, Range[First@
#1, n, First@#
1]],
Append[
#2, First@#
1]} & @@ # &,
{Range[2, n], {}},
First@#[[1]] < sqrtn &]
]
142913828922
直观上自然是Total@Select[Range[2 10^6], PrimeQ]，考虑到用筛法不需要对每个数PrimeQ，能稍微快一些。

所以说你们真不考虑用一下ImportString吗……

11-15
011done
Times @@@
Flatten[Join[Partition[
#, 4, 1] & /@ #
,
Partition[#, 4, 1] & /@
Transpose@#, {Diagonal /@
Flatten[Partition[#, {4, 4}, {1, 1}], 1]}, {Diagonal /@
Flatten[Partition[Reverse@#, {4, 4}, {1, 1}], 1]}] &@
Import["E:\\work\\ProjectEuler\\011.txt", "Table"], 1] // Max
70600674
012done
Module[{halfFactorCount, ans},
halfFactorCount[x_] :=
If[EvenQ@x,
Times @@ (Last /@ FactorInteger[x/2] + 1) - 1,
Times @@ (Last /@ FactorInteger@x+ 1) - 1];
ans = NestWhile[
{
#1 + 1, {Last@#
2, halfFactorCount[Last@
#1 + 1]}} & @@ #
&,
{{1, 2}, {1, 1}},
(Times @@
#2 < 500) & @@ #
&];
Times @@ # &@First@ans/2
]
76576500
考虑到n和n-1互素，那么n(n-1)的因子数等于各自因子数的乘积，如此则避免了大数因子分解。注意到对偶数要先除以2再对因子计数。
013done
FromDigits@
Take[IntegerDigits@Total@Import["E:\\work\\ProjectEuler\\013.txt", "List"],
10]
5537376230
014working
Block[{$RecursionLimit = 100000, f},
f[n_] :=
f[n] = If[n == 1, 1, 1 + f[If[EvenQ[n], n/2, 3*n + 1]]];
Ordering[f /@ Range[10^6], -1]
] // Timing
837799
自己未做出，感谢@mm_酱 和@草红祥。
015done
Binomial[40, 20]
137846528820
首先得到递归式path[m,n]:=path[m-1,n]+path[m,n-1]，类比二项式的系数（杨辉三角），直接可得答案。

20-25
021done
Module[{factorSum},
factorSum[n_] :=
If[n > 1,
Times @@ ((
#1^(#
2 + 1) - 1)/(#1 - 1) & @@@ FactorInteger[n]) - n,
1];
Total@Select[Range[2, 10000],
factorSum@# != # && factorSum@factorSum@#== # &]
]
31626
022done
Module[{codeDiffrence, list, listLength, sumOfCharacters},
codeDiffrence = ToCharacterCode["A"][[1]] - 1;
list =
Sort@ImportString[
StringReplace[
Import["E:\\work\\ProjectEuler\\022.txt", "String"], {"\"" -> "", "," -> " "}], {"Text", "Words"}];
listLength = Length@list;
sumOfCharacters[s_String] :=
Total[ToCharacterCode[s] - codeDiffrence];
Total[sumOfCharacters[list[[#]]] # & /@ Range[listLength]]
]
871198282
023working
Module[{fs, list},
fs[n_] :=
Times @@ ((#1^(
#2 + 1) - 1)/(#
1 - 1) & @@@ FactorInteger[n]) - n;
list = Select[Range[2, 28123], fs@#> # &];
Total@Complement[Range@28123,
DeleteDuplicates[Total /@ Tuples[list, 2]]]
]
4179871
感觉应该能优化，但是实在找不出过剩数的规律，只能硬来……
024done
Module[{n = 10^6, max, mod},
max = Last@NestWhile[
{#1 (
#2 + 1), #
2 + 1} & @@ # &,
{1, 1},
#[[1]] < 10^6 &] - 1;
mod = Floor[n/max!];
FromDigits[{mod}~Join~
Sort[Permutations[Drop[Range[0, 9], {mod + 1}]]][[Mod[n, max!]]]]
]
2783915460
先判断第一位的数字，再对后面9位排序，比直接FromDigits[Sort[Permutations[Range[0, 9]]][[10^6]]]要快些。
025done
Ceiling[Log[Sqrt@5 10^999]/Log[(1 + Sqrt@5)/2]]
4782
以通项公式来估计。

26-30
026working
Module[{remailderList},
remailderList[n_] := Mod[#, n] & /@ (10^Range[n - 1]);
Max[First /@ Ordering /@ remailderList /@ Range[3, 999, 2]]
]
982
应该能够被优化，求大神指点。
027done
Module[{n, x},
n = Ceiling@Min[n /. Solve[n^2 + n + 41 == 1000, n]];
Times @@ CoefficientList[Expand[(x + n)^2 + (x + n) + 41], x]
]
-59231
感觉坑爹的一道题。并不是指原题有什么问题，而是很具迷惑性的“通过电脑发现了惊人的n^2-79n+1601这个式子”。注意到“f[n]=n^2+40n+41"关于"x=-1/2"对称，则f[-1]=f
[0],f[-2]=f[1],……,f[-40]=f[39]均为质数,原式满足条件的取值范围为[-40，39]，通过平移坐标轴即可有"g[n]=f[n-40]=n^2-79n+1601"对[0,79]成立。（初中的知识，要需要
用电脑找嘛……）根据原来的式子，只需找到x0<0使得f[x0]<1000并最大即可，平移变换f[n+x0]即得答案。
028done
Total[4 (2 # + 1)^2 - 12 # & /@ Range@500] + 1
669171001
找到数列规律即可。
029done
Length@DeleteDuplicates[Power @@@ Tuples[Range[2, 100], 2]]
9183
原以为需要优化，结果发现直接计算都不耗时间的……
030done
Module[{max},
max = First@NestWhile[
{#1 + 1, 9^5
#1} & @@ #
&,
{1, 9},

#[[2]] > 10^(#
[[1]] - 1) &] - 1;
Total@Select[Range[10, 9^5 max], Total[IntegerDigits[
#]^5] == #
&]
]
443839
关键在于定出上界。

运行时间不如用一个基准运算来折算。
比如N[Pi,1000000]的时间

36-40
036done
Module[{list, palindrome}, palindrome[n_] := If[EvenQ@n, FromDigits /@ (Join[
#, Reverse@#
] & /@ IntegerDigits /@ Range[10^(n/2 - 1), 10^(n/2) - 1]), FromDigits /@ (Join[
#, Rest@Reverse@#
] & /@ IntegerDigits /@ Range[10^((n + 1)/2 - 1), 10^((n + 1)/2) - 1])]; list = Flatten[palindrome /@ Range@6]; Total@Select[list, Reverse@#==
# &@IntegerDigits[#
, 2] &] ]
872187
先构造所有十进制回文数，再进行筛选。六位数的回文数由前三位数唯一决定，以Range[999]替代Range[10^6-1]的使用。
037done
Module[{list0 = {{1}, {2}, {3}, {5}, {7}, {9}}, ans, fq}, fq[list_] := And[And @@ PrimeQ /@ FromDigits /@ NestList[Rest, list, Length@list - 1], And @@ PrimeQ /@ FromDigits /@ NestList[Most, list, Length@list - 1]]; ans = FromDigits /@ Last@NestWhile[ {#1 + 1, Select[ Flatten[NestList[ Select[Flatten /@ Tuples[{list0, #1}], PrimeQ@FromDigits@# &] &, list0, #1], 1], fq@# && Length@# > 1 &]} & @@ # &, {1, {}}, Length@Last@# < 11 &]; Total@ans ]
748317
038done
Module[{list0 = Range@9, f}, f[x_] := If[x <= 9, Flatten[IntegerDigits /@ {x, 2 x, 3 x, 4 x, 5 x}], If[x <= 99, Flatten[IntegerDigits /@ {x, 2 x, 3 x, 4 x}], If[x <= 999, Flatten[IntegerDigits /@ {x, 2 x, 3 x}], Flatten[IntegerDigits /@ {x, 2 x}] ] ] ]; FromDigits /@ f /@ Select[ Join[Range@9, Range[25, 34], Range[100, 333], Range[5000, 9999]], Sort@f@#== list0 &] // Max ]
932718654
通过乘积个数对位数及取值范围进行分类。
039done
Module[{list, f}, list = Select[ 2
#[[1]]^2 + 2 #
[[1]] #[[2]] & /@ Select[Tuples[{Range@22, Range@21}], #[[1]] >
#[[2]] && ***[#
[[1]],
#[[2]]] == 1 &], #
<= 1000 &]; f[x_] := x Range[1000/x]; Commonest@Flatten[f /@ list] ]
840
用基本勾股数组{m^2-n^2,2mn,m^2+n^2}寻找即可，注意把基本数组的倍数也考虑进去。
040done
Module[{list, num, ans}, list = 10^Range[2, 6] - Accumulate[9 10^(
# - 1) #
& /@ Range@5]; num = {Floor /@ (list/Range[2, 6]), Mod[list, Range[2, 6]]}; ans =
#[[1]][[#
[[2]]]] & /@ Transpose@{IntegerDigits /@ (10^Range[1, 5] + num[[1]]), num[[2]]}; Times @@ ans ]
210
对一位数占长，两位数占长，……分别统计即可。

Count[Table[3*L^2
+3
*L+1,{L,1,Maximize[{L, 3*L^2 + 3*L + 1 <= 1000000},L,Integers][[1]]}],_?(PrimeQ[#] &)]//AbsoluteTiming欧拉计划第131题，通过这道题我更加深刻认识到暴力求解的坏处。之前我用暴力求解的方法，结果用台式机算了4个多小时还没算出来，后来通过观察，发现了规律，然后证明自己的猜测，简化之后只要0.07秒就够了，所以暴力求解真是不好

第10题计算时间可以不到0.1s的，
Clear["`*"];
primes[n_] := Module[{p = Range[1, n, 2], q, ub}, q = Length[p];
p[[1]] = 2;
ub = Sqrt@N@n;
Do[If[p[[(k + 1)/2]] != 0, p[[(k^2 + 1)/2 ;; q ;; k]] = 0], {k, 3, ub, 2}];
SparseArray[p]["NonzeroValues"]];
AccountingForm@Tr@N@primes[2 10^6 - 1] // AbsoluteTiming

24题，这样要快很多
rem = 999999; list = Range[0, 9]; FromDigits@
Table[quot = Quotient[rem, (10 - i)!] + 1; rem = Mod[rem, (10 - i)!];
res = list[[quot]]; list = Delete[list, quot]; res, {i, 10}]

第14题这样更快
A = Import["C:\\Users\\Administrator\\Desktop\\2.txt", "Table"];
AbsoluteTiming[ Do[A[[x - 1]] = Max @@@ Partition[A[[x]], 2, 1] + A[[x - 1]], {x,15,2,-1}]; A[[1]]]

第18问题，也可以用内置函数
Double[A_] :=
If[Length[A] > 2,
Flatten[{A[[1]], Table[{A[[i]], A[[i]]}, {i, 2, Length[A] - 1}],
A[[-1]]}], A];
-GraphDistance[
Graph[Flatten[{Subscript[A, 0, 0] \[DirectedEdge]
Subscript[A, 1, 1]}~Join~
Table[Table[{{Subscript[A, j, i] \[DirectedEdge]
Subscript[A, j + 1, i]}, {Subscript[A, j,
i] \[DirectedEdge] Subscript[A, j + 1, i + 1]}}, {i,
j}], {j, 14}]~Join~
Table[{Subscript[A, 15, i] \[DirectedEdge]
Subscript[A, 16, 16]}, {i, 15}]],
EdgeWeight -> -Flatten[
Double /@
Import["C:\\Users\\wengdeping\\Desktop\\Sort.txt", "Table"]]~
Join~Table[0, {i, 15}]], Subscript[A, 0, 0],
Subscript[A, 16, 16]]

67题我对Graph完全不懂，所以没太明白你的算法……我是用的下面的思路：考虑从顶点到data[[i,j]]的最大路径f[i,j]，其实可以写成data[[i,j]]+Max[{ f[i-1,j-1],f[i-1,j] }]的形式，所以我们只需要在算到每一层时都对每个点的最大路径已然确定，于是剩下的只需要从第二层开始一层一层往下算了。我的代码是：
Module[{data, length, temp, ans},
data = Import["D:\\ProjectEuler\\067.txt", "Table"];
length = Length@data; ans = data[[2]] + data[[1, 1]];
For[i = 3, i <= length, i++,
ans = Join[{First@ans + data[[i, 1]]},
data[[i, 2 ;; -2]] +
Max /@ Partition[ans, 2, 1], {Last@ans + data[[i, -1]]}]
];
Max@ans
]
7273
看了下运行时间，比18的穷举法还短得多……果然算法都是逼出来的。

26题这样应该是秒杀了！
LoopLength[p_] := (i = 1; While[! IntegerQ[(10^i - 1)/p], i++]; i);
pp = PrimePi[999];
While[LoopLength[ppp = (Prime[pp])] != ppp - 1, pp--]; ppp

欧拉项目第50题我是这样写的
i = 1; x = i + 1; maxlength = 0; maxtotal = 0; shu = 10^6; time = AbsoluteTiming[While[Prime[x = i + 1] <= shu, While[(m = Total@Prime[Range[i, x]]) <= shu, If[PrimeQ[m], If[x - i + 1 > maxlength, maxlength = x - i + 1; maxtotal = m]]; x++]; i++]]; {time, maxlength, maxtotal}
可是这完全暴力解啊 运行时间111.8秒远超了一分钟 因此想知道在我这代码该如何优化？
编译可以吗？ 好像不行，Prime库函数是不是不能编译啊。。。 那可以部分编译吗？
而且感觉 Total@Prime[Range[i, x]]这样一次次算是很耗时间的。。
还有这题目可以用模式匹配的方法吗？ 比如说先生成小于100万这个数的所有质数列表，然后用模式匹配找出小于指定数的列表并且列表中质数连续排列。。 可以这样吗？
感觉适当Fold用一下也可以减少时间 况且我觉得这里用循环肯定不好。
那么这题目有什么很快的解法吗？I

PE50:
Clear["`*"];
max = 0;
ans = 1;
range = 10^10;
For[i = 1, Sum[Prime[j], {j, i, i + max}] < range, i++,
For[j = i; sum = 0, sum += Prime[j]; sum < range, j++,
If[PrimeQ[sum] && max < j - i + 1, max = j - i + 1; ans = sum];
]];
ans
Clear["`*"];
作者Amber
-----------------------
我的解法：
Clear["`*"];
n = NestWhile[# + 1 &, 1, Total@Prime@Range[#] < 10^6 &] - 1;
list = Table[Accumulate[Prime[Range[i, n]]], {i, n}];
p = Position[PrimeQ@list, True];
p1 = Position[p, {_, p[[;; , 2]] // Max}]
p2 = Extract[p, p1 // First]
Extract[list, p2]
Clear["`*"];
I