16核全开,直接上暴力美学.
第一题: $1929374254627488900 = 1389019170^2$
第一题可以挺快的，首先平方是10的倍数，这个数必然是10的倍数，末尾可以不搜索。
其次它除以10以后，平方末三位是8x9,得到这个数末三位只有24种选择。
然后它的范围在\(10^8\)到\(\sqrt{2}10^8\)之间，我们需要穷举前5位加上最后3位24种选择共41422*24种情况。 末位数能被8整除, 所以有三种情况,$809, 849,889$. 然后就是 7位数的穷举. 我是这种思路.
如果计算模1000的情况,确实是24种情况,这样又少了3个数, 于是只需要 穷举 4位数. 重新 实现了一下mathe的思路, 很快.
tmp = Select, IntegerDigits[#^2, 10, 3][[-1]] == 9 &&IntegerDigits[#^2, 10, 3][[-3]] == 8 &];
sol = Flatten[
Table[FromDigits[
Flatten[{1, IntegerDigits,
IntegerDigits}]], {i, 1010, 38902}, {j, tmp}], 1];
Select[]], # == 1 &] &]
基于mathe的思路,改成计算平方的末尾是五位数的情况,即模10^5, 有240个解.这样,前面的只需要计算10-389的情况. 总共只需要枚举$389*240$种情况, 于是1秒钟出结果.,
tmp=Select,IntegerDigits[#^2,10,5][[{1, 3, 5}]]=={7,8,9}&];
sol=Flatten,IntegerDigits}]],{i,10,389},{j,tmp}],1];
ans=Select[]],#==1&]&] 第4题的实现代码：
ClearAll["Global`*"];
x=Permutations;y=Select<5&];
n=0;s={};
Do[]}];k=0;
Do;
k+=Times@@Boole],{a,x}];
k/=c;n+=k;AppendTo,{b,y}];{n,s}
{44680,{{11483,{8,1}},{8844,{7,2}},{2052,{7,1,1}},{6572,{6,3}},{2482,{6,2,1}},{205,{6,1,1,1}},{6424,{5,4}},{2049,{5,3,1}},{535,{5,2,2}},{646,{5,2,1,1}},{13,{5,1,1,1,1}},{942,{4,4,1}},{945,{4,3,2}},{449,{4,3,1,1}},{410,{4,2,2,1}},{54,{4,2,1,1,1}},{136,{3,3,3}},{292,{3,3,2,1}},{20,{3,3,1,1,1}},{32,{3,2,2,2}},{82,{3,2,2,1,1}},{2,{3,2,1,1,1,1}},{8,{2,2,2,2,1}},{3,{2,2,2,1,1,1}}}}
主要问题是重复计数的太多，该如何优化提速？
仿3楼代码多核同时计算：
SetSharedVariable;n=0;lst={};
x=Permutations;y=Select<5&];
ParallelDo[]}];k=0;
Do;
k+=Times@@Boole],{a,x}];
k/=c;n+=k;AppendTo,{b,y}];{n,s} 素数都是形如$6n\pm1$,所以我们按照6为模分成6组. northwolves 发表于 2025-2-22 16:30
第4题：44680
组合 数量
可读性可能不那么好,代码需要 1.1秒钟. 局部地方有重复逻辑,是可以进一步优化速度的,比较懒,暂时先这样吧.
pool = Table[{i,Select, {i}], PrimeQ]}, {i, 1,8}];
ans = GroupBy[
Flatten[Table[
Union[Sort /@
Lookup[NestWhile[
GroupBy,
Flatten[Table[
Flatten], t}],
Complement],
Flatten], t}]]}, {len,
Flatten[{Range]],
Length]]/2], Length]]}]}, {t,
Select[FromDigits /@
Permutations[
Complement],
Flatten], t}]], {len}],
PrimeQ]}], 1], {p, Lookup[#, False, {}]}],
1]], #[] == {} &] &,
GroupBy, IntegerDigits]}, {i, pool[]}], #[] == {} &],
Lookup[#, False, {}] != {} &], True, {}][]], {m, 1,4}], 1], Map &];
Length /@ ans
{{{1,8},11483},{{1,1,7},2052},{{1,2,6},2482},{{1,3,5},2049},{{1,4,4},942},{{1,1,1,6},205},{{1,1,2,5},646},{{1,1,3,4},449},{{1,2,2,4},410},{{1,2,3,3},292},{{1,1,1,1,5},13},{{1,1,1,2,4},54},{{1,1,1,3,3},20},{{1,1,2,2,3},82},{{1,2,2,2,2},8},{{1,1,1,1,2,3},2},{{1,1,1,2,2,2},3},{{2,7},8844},{{2,2,5},535},{{2,3,4},945},{{2,2,2,3},32},{{3,6},6572},{{3,3,3},136},{{4,5},6424}}
页:
1
[2]