五道难题求解

mathe

wayne 发表于 2025-2-22 08:37
16核全开,直接上暴力美学.
第一题: $1929374254627488900 = 1389019170^2$

第一题可以挺快的，首先平方是10的倍数，这个数必然是10的倍数，末尾可以不搜索。
其次它除以10以后，平方末三位是8x9,得到这个数末三位只有24种选择。
然后它的范围在\(10^8\)到\(\sqrt{2}10^8\)之间，我们需要穷举前5位加上最后3位24种选择共41422*24种情况。

wayne

末位数能被8整除, 所以有三种情况,$809, 849,889$. 然后就是 7位数的穷举. 我是这种思路.
如果计算模1000的情况,确实是24种情况,这样又少了3个数, 于是只需要 穷举 4位数. 重新 实现了一下mathe的思路, 很快.

1. tmp = Select[Range[10^3 - 1], IntegerDigits[#^2, 10, 3][[-1]] == 9 &&  IntegerDigits[#^2, 10, 3][[-3]] == 8 &];
   
2. sol = Flatten[
   
3.    Table[FromDigits[
   
4.      Flatten[{1, IntegerDigits[i, 10, 5],
   
5.        IntegerDigits[j, 10, 3]}]], {i, 1010, 38902}, {j, tmp}], 1];
   
6. Select[sol, AllTrue[Differences[IntegerDigits[#^2][[1 ;; -1 ;; 2]]], # == 1 &] &]

复制代码

wayne

基于mathe的思路,改成计算平方的末尾是五位数的情况,即模10^5, 有240个解.这样,前面的只需要计算10-389的情况. 总共只需要枚举$389*240$种情况, 于是1秒钟出结果.,

1. tmp=Select[Range[10^5-1],IntegerDigits[#^2,10,5][[1]]==7&&IntegerDigits[#^2,10,5][[3]]==8&&IntegerDigits[#^2,10,5][[5]]==9&];
   
2. sol=Flatten[Table[FromDigits[Flatten[{1,IntegerDigits[i,10,3],IntegerDigits[j,10,5]}]],{i,10,389},{j,tmp}],1];
   
3. ans=Select[sol,AllTrue[Differences[IntegerDigits[#^2][[1;;-1;;2]]],#==1&]&]

复制代码

northwolves

第4题的实现代码：

1. ClearAll["Global`*"];
   
2. x=Permutations[Range@9];y=Select[IntegerPartitions@9,Length@#>1&&Count[#,1]<5&];
   
3. n=0;s={};
   
4. Do[c=Product[m!,{m,Tally[b][[All,2]]}];k=0;
   
5. Do[r=TakeList[a,b];
   
6. k+=Times@@Boole[Union[PrimeQ/@FromDigits/@r]],{a,x}];
   
7. k/=c;n+=k;AppendTo[s,{k,b}],{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}}}}

主要问题是重复计数的太多，该如何优化提速？

northwolves

仿3楼代码多核同时计算：

1. SetSharedVariable[n,lst];n=0;lst={};
   
2. x=Permutations[Range@9];y=Select[IntegerPartitions@9,Length@#>1&&Count[#,1]<5&];
   
3. ParallelDo[c=Product[m!,{m,Tally[b][[All,2]]}];k=0;
   
4. Do[r=TakeList[a,b];
   
5. k+=Times@@Boole[Union[PrimeQ/@FromDigits/@r]],{a,x}];
   
6. k/=c;n+=k;AppendTo[s,{k,b}],{b,y}];{n,s}

复制代码

wayne

素数都是形如$6n\pm1$,所以我们按照6为模分成6组.