欧拉计划的解密计划的交流计划

由于我用的小平板，运行速度慢，所以我更注重如何对代码提速。废话不多说，这是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，能稍微快一些。

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]]]