mathematica趣题解答
Clear["Global`*"]
人民币是中国的流通货币。它由如下面额货币组成：
1 分，2分，5分，1角，2角，5角，1元，2元
如果要组成 2元钱 可以是
2 元钱= 1 个*1元 + 1 个*5角 + 2 个*2角 + 1 个*5分 + 1 个*2分 + 3 个*1分
你可以使用以上任意货币面额组成2 元钱，问共有多少种方式？
Block[
{money, cnt, i,j, k},
money = {1, 2,5, 10, 20, 50, 100, 200};
cnt = Table[0,{200}, {8}];
Table[cnt[[1,i]] = 1, {i, 8}];
For[i = 2, i <201, i++,
For[j = 1, j <9, j++,
cnt[[i, j]] =0;
For[k = 1, k<= j, k++,
If[money[[k]]< i, cnt[[i, j]] += cnt[[i - money[[k]], k]],
If[money[[k]]== i, cnt[[i, j]]++]]]]];
cnt[[200, 8]]
] // Timing
{0.06699, 73682}
120 可以写为三组勾股数（整数） 之和，分别是 {20, 48,52}, {24, 45, 51}, {30, 40, 50} 。要求在不超过1000的数字中求出可以写为最多组勾股数之和的数。
Module[
{found, cnt, i,j, k},
found = {};
cnt = Table[0,{1000}];
For[i = 1, i <500, i++,
For[j = 1, j <i, j++,
If[2 i j + 2i i > 1000, Break[]];
For[k = 1, k< 1000, k++,
If[k (2 i j+ 2 i i) > 1000, Break[]];
If[!MemberQ[found, Hash[{2 i j k, k (i i - j j), k (i i + j j)}]],
cnt[[k (2 ij + 2 i i)]]++;
found =Append[found, Hash[{2 i j k, k (i i - j j), k (i i + j j)}]]
]
]
]
];
j = 1;
For[i = 2, i <1001, i++, If[cnt[[j]] < cnt[[i]], j = i]];
j
] // Timing
{0.030996, 840}
找出最小的一个数x，要求它的2倍，3位直到6倍各数字都与原数的数位组成是相同的，只能是顺序不同。
Module[
{i, j, num,lst},
For[i = 1, i <100, i++,
lst =RealDigits@(1/Prime[i]);
If[Depth[lst]> 3,
num =FromDigits@lst[[1, 1]];
For[j = 2, j< 8, j++,
If[j == 7,Return[num]];
If[Sort@IntegerDigits[num]!= Sort@IntegerDigits[num*j],
Break[]
];
]
]
]
]; // Timing
{0.,Return[142857]}
1487, 4817, 8147这三个数有如下特征：都是素数；由相同的数位组成（1, 4, 7, 8）；三者构成等差数列。
已知在四位数中仍然有一组与此类似的等差数列，试找出来这三个数，并且按照这三个数字大小递增的顺序写出这十二个位数来。
Quiet@Module[
{list, i, nn,n, m, curlist, order, orderlist},
list =Select[Range[1000, 9999], PrimeQ];
list =IntegerDigits /@ list;
list =GatherBy[list, Sort[#1] == Sort[#2] &];
list =Map[FromDigits, Select[Flatten[list, 0], Length[#] >= 3 &],{2}];
m =Length[list];
order =Table[Permutations[Range[i], {3}], {i, 1, Max[Length /@ list]}];
For[i = 1, i<= m, i++,
curlist =list[[i]];
n =Length[curlist];
nn =Length[order[[n]]];
For[j = 1, j<= nn, j++,
orderlist =order[[n, j]];
If[curlist[[orderlist[[2]]]]- curlist[[orderlist[[1]]]] ==
curlist[[orderlist[[3]]]]- curlist[[orderlist[[2]]]],
Print[{curlist[[orderlist[[1]]]],curlist[[orderlist[[2]]]],
curlist[[orderlist[[3]]]]}]
]
]
]
] // Timing
{1487,4817,8147}
{8147,4817,1487}
{2969,6299,9629}
{9629,6299,2969}
{0.149977, Null}
Clear["Global`*"]
f[n_] := n (3 n -2)/2;
eq1 =Simplify[f[a] + f[b] == f[c]]
eq2 =Simplify[f[a] - f[b] == f[d]]
eq =Simplify[eq1[[1]] - eq1[[2]] - eq2[[1]] + eq2[[2]]]
eq = 2 f[a] -f[c] - f[d] // Simplify
eq = 2 f[b] -f[c] + f[d] // Simplify
3 a^2 + 3 b^2 +(2 - 3 c) c == 2 (a + b)
3 a^2 + 2 b + (2- 3 d) d == 2 a + 3 b^2
-4 b + 6 b^2 + 2c - 3 c^2 + d (-2 + 3 d)
-2 a + 3 a^2 + c- (3 c^2)/2 + d - (3 d^2)/2
-2 b + 3 b^2 + c- (3 c^2)/2 + 1/2 d (-2 + 3 d)
Reduce[{eq1, eq2,c > 0, d > 0, a > 0, b > 0}, {a, b}, Integers];
%[[3, 1, 1, 2]]
Minimize[%, d]
3 a^2 + 3 b^2 +(2 - 3 c) c == 2 (a + b)
a (-2 + 3 a) + (2- 3 b) b + (2 - 3 d) d == 0
1/3 + 1/3 Sqrt[-1- 6 d + 9 d^2]
{1/3 + 1/3Sqrt[-1 + 3 (-(2/3) (1 + Sqrt[2]) + 1/3 (1 + Sqrt[2])^2)], {d ->
1/3 (1 +Sqrt[2])}}
