# P11: 方阵中的最大乘积
Largest product in a grid
有一个
似乎只能暴力遍历, 练习一下 Import, 然后就变成了个矩阵.
一共有四个方向要遍历, 横向, 竖向, 主对角方向和副对角方向. 所以我们考虑的是把所有的行啊, 列啊, 对角线啊, 全部抽出来合并成一个列表.
这样就变成了长短不一的小列表的列表了. 然后每个小列表的最大乘积这个之前第 8 题已经搞定了. 分别求出最大值然后求这些最大值中的最大值就行了.
input = "\
08 02 22 97 38 15 00 40 00 75 04 05 07 78 52 12 50 77 91 08
49 49 99 40 17 81 18 57 60 87 17 40 98 43 69 48 04 56 62 00
81 49 31 73 55 79 14 29 93 71 40 67 53 88 30 03 49 13 36 65
52 70 95 23 04 60 11 42 69 24 68 56 01 32 56 71 37 02 36 91
22 31 16 71 51 67 63 89 41 92 36 54 22 40 40 28 66 33 13 80
24 47 32 60 99 03 45 02 44 75 33 53 78 36 84 20 35 17 12 50
32 98 81 28 64 23 67 10 26 38 40 67 59 54 70 66 18 38 64 70
67 26 20 68 02 62 12 20 95 63 94 39 63 08 40 91 66 49 94 21
24 55 58 05 66 73 99 26 97 17 78 78 96 83 14 88 34 89 63 72
21 36 23 09 75 00 76 44 20 45 35 14 00 61 33 97 34 31 33 95
78 17 53 28 22 75 31 67 15 94 03 80 04 62 16 14 09 53 56 92
16 39 05 42 96 35 31 47 55 58 88 24 00 17 54 24 36 29 85 57
86 56 00 48 35 71 89 07 05 44 44 37 44 60 21 58 51 54 17 58
19 80 81 68 05 94 47 69 28 73 92 13 86 52 17 77 04 89 55 40
04 52 08 83 97 35 99 16 07 97 57 32 16 26 26 79 33 27 98 66
88 36 68 87 57 62 20 72 03 46 33 67 46 55 12 32 63 93 53 69
04 42 16 73 38 25 39 11 24 94 72 18 08 46 29 32 40 62 76 36
20 69 36 41 72 30 23 88 34 62 99 69 82 67 59 85 74 04 36 16
20 73 35 29 78 31 90 01 74 31 49 71 48 86 81 16 23 57 05 54
01 70 54 71 83 51 54 69 16 92 33 48 61 43 52 01 89 19 67 48";
data1 = ImportString[input, "Table"];(* 横向列表 *)
data2 = Reverse /@ Transpose[data1];(* 竖向列表 *)
{data3, data4} = Table[Diagonal[#, k], {k, -16, 16}]& /@ {data1, data2};(* 主副对角线 *)
p8 = Max@Times@@@Partition[#, 4, 1]&;(* 第 8 题写过的拿过来 *)
Max[p8 /@ Join[data1, data2, data3, data4]](* 全部组合起来 *)# P12: 高度可约的三角形数
Highly divisible triangular number
三角形数数列是通过逐个加上自然数来生成的.三角形数数列的前十项分别是:
让我们列举出前七个三角形数的所有约数:
1: 1
3: 1,3
6: 1,2,3,6
10: 1,2,5,10
15: 1,3,5,15
21: 1,3,7,21
28: 1,2,4,7,14,28
我们可以看出, 28 是第一个拥有超过 5 个约数的三角形数.
第一个拥有超过 500 个约数的三角形数是多少?
多用用 F1, 早点认识 DivisorSigma 这个函数, 这是个积性函数, 后面很多数论题都要用到这个.
虽然有数论解法, 不过我们还是先用穷举好了. 一般这种题后面还会出现无法穷举解决的加强型问题.
Again, 永远记住你的时间远比计算机的时间值钱.
NestWhile 还记得不, 我让你记住的来着.
NestWhile[# + 1&, 1, DivisorSigma[0, # (# + 1) / 2] < 500&];# (# + 1) / 2&@%# P13: 大和
Large sum
计算出一百个 50 位数的和的前十位数字.
好吧我直接复制 import 30s 就搞定了, 不过我还是觉得我得教点什么, 就教点网页读取与处理吧, 就像这样:
input = URLExecute["https://projecteuler.net/problem=13", "Table"][[58 ;; -17]];
data = StringPartition[StringDelete[StringJoin@Flatten[input], {"<br/>", "</div>"}], 50];
IntegerDigits[Total[ToExpression /@ data]] ~ Take ~ 10 // FromDigits# P14: 最长考拉兹序列
Longest Collatz sequence
在正整数集上定义如下的迭代序列:
n → n / 2 (若 n 为偶数)
n → 3n + 1 (若 n 为奇数)
从 13 开始应用上述规则, 我们可以生成如下的序列:
可以看出这个序列(从 13 开始到 1 结束)共有 10 项.尽管还没有被证明, 但我们普遍认为, 从任何数开始最终都能迭代至 1("考拉兹猜想").
从小于一百万的哪个数开始, 能够生成最长的序列呢?
注: 序列开始生成后允许其中的项超过一百万.
本题不建议用 Mathematica 做, 因为是硬计算.
<< ExampleData/Collatz.m
Table[Length@Collatz[i], {i, 10^4 - 1}]算了将近 4 秒钟的时候我就感觉不对劲了, 不用编译药丸...
CollatzLength=Compile[{{x,_Integer}},Module[{c,n},
(For[n=x;c=1,n!=1,c+=1,If[EvenQ[n],n=Round[n/2],n=3*n+1]]);c],
CompilationTarget->"C",RuntimeAttributes->{Listable}];
Ordering[CollatzLength[Range[10^6]],-1]# P15: 网格路径
Lattice paths
从一个
对于
呃, 高中数学排列组合, 不是很想解释...
Binomial[40, 20]# P16: 幂的数字和
Power digit sum
多用 F1.
Total@IntegerDigits[2^1000]# P17: 表达数字的英文字母计数
Number letter counts
如果把 1 到 5 写成英文单词, 分别是:one, two, three, four, five, 这些单词一共用了 3 + 3 + 5 + 4 + 4 = 19 个字母.
如果把 1 到 1000 都写成英文单词, 一共要用多少个字母?
注意: 不要算上空格和连字符.例如, 342(three hundred and forty-two)包含 23 个字母, 而 115(one hundred and fifteen)包含 20 个字母.单词 "and" 的使用方式遵循英式英语的规则.
如果不懂英语语法的话... 跳过吧... 没啥意思...
IntegerName 并不符合语法. 答案里这个函数我抽了出来整合进了程序包, 我后来把语法扩展到了 10^72 以下, 一般认为 10^6 以下应该读自然语法, 10^9 以上应该读科学记法 (无 and).
不过这个并没有什么软用, 毕竟有 Wolfram Alpha.
words[x_] := Nest[StringReplace[#, n : (DigitCharacter..) :> WolframAlpha["spell" <> n, {{"Result", 1}, "Plaintext"}]]&, ToString@x, 2]
words[123456789101112]正常解法:
AusEnglish1 = {"", "one", "two", "three", "four", "five", "six", "seven", "eight", "nine"};
AusEnglish2 = {"ten", "eleven", "twelve", "thirteen", "fourteen", "fifteen", "sixteen", "seventeen", "eighteen", "nineteen", "twenty"};
AusEnglish3 = {"twenty", "thirty", "forty", "fifty", "sixty", "seventy", "eighty", "ninety"};
EnglishToNumber[s_String] := StringLength@s;
NumberToEnglish[n_Integer /; 1 <= n <= 19] := StringDelete[(AusEnglish1 ~ Join ~ AusEnglish2)[[n + 1]], "-"]
AusEnglish4 = {"", "-one", "-two", "-three", "-four", "-five", "-six", "-seven", "-eight", "-nine"};
NumberToEnglish[n_Integer /; 20 <= n <= 99] := AusEnglish3[[Floor[n, 10] / 10 - 1]] <> AusEnglish4[[Mod[n, 10] + 1]]
NumberToEnglish[n_ /; 100 <= n <= 999 && Mod[n, 100] === 0] := AusEnglish1[[Floor[n, 100] / 100 + 1]] <> "hundred";
NumberToEnglish[n_Integer /; 100 <= n <= 999] := AusEnglish1[[Floor[n, 100] / 100 + 1]] <> "hundred and" <> NumberToEnglish[Mod[n, 100]]
NumberToEnglish[1000] := "one thousand";
StringLength@StringDelete[StringJoin@Table[NumberToEnglish[i], {i, 1, 1000}], {"", "-"}]# P18: 最大路径和 I
Maximum path sum I
从下面展示的三角形的顶端出发, 不断移动到在下一行与其相邻的元素, 能够得到的最大路径和是 23.
7 4
2 4 6
8 5 9 3
如上图, 最大路径和为 3 + 7 + 4 + 9 = 23.
求从下面展示的三角形顶端出发到达底部, 所能够得到的最大路径和:
95 64
17 47 82
18 35 87 10
20 04 82 47 65
19 01 23 75 03 34
88 02 77 73 07 63 67
99 65 04 28 06 16 70 92
41 41 26 56 83 40 80 70 33
41 48 72 33 47 32 37 16 94 29
53 71 44 65 25 43 91 52 97 51 14
70 11 33 28 77 73 17 78 39 68 17 57
91 71 52 38 17 14 91 43 58 50 27 29 48
63 66 04 68 89 53 67 30 73 16 69 87 40 31
04 62 98 27 23 09 70 98 73 93 38 53 60 04 23
注意: 在这个问题中, 由于只有 16384 条路径, 通过尝试所有的路径来解决问题是可行的.但是, 对于第 67 题, 虽然是一道相同类型的题目, 但是三角形将拥有一百行, 此时暴力破解将不能解决, 而需要一个更加聪明的办法
讲真, 这个聪明的办法并不难想, 对于上层的每一个数都选下层较大的那个数走好了.
解释下 state 的结果是选择不同路径的结果, 前一个是往左走的和, 后一个是往右走的和.
choose 就是取结果大的那个, FoldPair 就是两层两层的比较的意思, FoldPair 是个二元运算符.
input = ImportString["
75
95 64
17 47 82
18 35 87 10
20 04 82 47 65
19 01 23 75 03 34
88 02 77 73 07 63 67
99 65 04 28 06 16 70 92
41 41 26 56 83 40 80 70 33
41 48 72 33 47 32 37 16 94 29
53 71 44 65 25 43 91 52 97 51 14
70 11 33 28 77 73 17 78 39 68 17 57
91 71 52 38 17 14 91 43 58 50 27 29 48
63 66 04 68 89 53 67 30 73 16 69 87 40 31
04 62 98 27 23 09 70 98 73 93 38 53 60 04 23", "Table"]
state = {PadLeft[#1, Length@#1 + 1] + #2, PadRight[#1, Length@#1 + 1] + #2}&;
choose[a_, b_] := Max@@@Transpose@state[a, b];
Max@FoldPair[{choose[#1, #2], choose[#1, #2]}&, input]# P19: 数星期日
Counting Sundays
下列信息是已知的, 当然你也不妨自己再验证一下.
1900 年 1 月 1 日是星期一.
三十天在九月中, 四六十一也相同.
剩下都是三十一, 除去二月不统一.
二十八天平常年, 多加一天在闰年.
闰年指的是能够被 4 整除却不能被 100 整除的年份, 或者能够被 400 整除的年份.
在二十世纪(1901 年 1 月 1 日到 2000 年 12 月 31 日)中, 有多少个月的 1 号是星期天?
F1....... 不想在这里深入讲, 想自己算的话, 自行搜索日期计数.
Count[DateRange[{1901, 1, 1}, {2000, 12, 31}, Sunday], {_, _, 1}]# P20: 阶乘数字和
Factorial digit sum
例如,
求出
和 16 题又有什么区别呢?
Total@IntegerDigits[100!]连续计时7分41秒,P14莫名被坑....P17未计时.
← Level1-10 Level21-30 →