【讨论】非线性曲线拟合，用Mathematica求逼近函数中参数 a 值，使之达到最佳。

永远

苦战了几个夜晚，终于锁定最佳 a 值，用Mathematica 编程得到的值与自己先前预测值完美一致！！！

最佳  a=46.4483021270782……

最小化最大误差值为: 0.00001872118423551505

最优 \(\lambda\) 值为: 0.898055159455627

1. (*目标函数 G(\[Lambda])*)
   
2. G[\[Lambda]_] := HypergeometricPFQ[{-1/2, -1/2}, {1}, \[Lambda]^2];
   
3. (*逼近函数 F(\[Lambda],a)*)
   
4. F[\[Lambda]_,
   
5. a_] := (1 + (3 \[Lambda]^2)/(10 +
   
6. Sqrt[4 - 3 \[Lambda]^2]))*(1 + (22/(7 \[Pi]) -
   
7. 1) (2 \[Lambda]/(1 + \[Lambda]))^a);
   
8. (*定义绝对误差函数*)
   
9. error[\[Lambda]_, a_] := Abs[F[\[Lambda], a] - G[\[Lambda]]];
   
10. (*计算给定 a 值时的最大绝对误差*)
    
11. maxError[a_?NumericQ] :=
    
12. NMaximize[{error[\[Lambda], a], 0 < \[Lambda] < 1}, \[Lambda]][[1]];
    
13. (*寻找最优 a 值*)
    
14. optimalA =
    
15. NMinimize[{maxError[a], a > 0}, a,
    
16. Method -> {"SimulatedAnnealing", "PerturbationScale" -> 3},
    
17. PrecisionGoal -> 3];
    
18. (*输出最优 a 值*)
    
19. aOpt = a /. optimalA[[2]];
    
20. \[Lambda]Opt = \[Lambda] /.
    
21. Last[NMaximize[{error[\[Lambda], aOpt],
    
22. 0 < \[Lambda] < 1}, \[Lambda]]];
    
23. Print["最优 a 值为: ", NumberForm[aOpt, 20]];
    
24. Print["最大误差为: ", NumberForm[optimalA[[1]], 20]];
    
25. Print["最优 \[Lambda] 值为: ", NumberForm[\[Lambda]Opt, 20]];
    
26. (*误差图像*)
    
27. Plot[error[\[Lambda], aOpt], {\[Lambda], 0, 1}, PlotRange -> All,
    
28. PlotLabel -> "最大误差 = " <> ToString[NumberForm[optimalA[[1]], 10]]]

复制代码

永远

Ysu2008 发表于 2025-8-7 13:55
用多项式函数拟合效果兴许更好，试试？

请教一下，前辈手中都用些啥电脑数学软件？

Ysu2008

永远 发表于 2025-8-8 12:12
请教一下，前辈手中都用些啥电脑数学软件？

wolframalpha
geogebra

永远

Ysu2008 发表于 2025-8-8 15:42
wolframalpha
geogebra

那先生编辑数学文档用啥软件？

Ysu2008

永远 发表于 2025-8-8 16:46
那先生编辑数学文档用啥软件？

WPS 个人版，都是便宜货。

永远

对11楼程序得到的当 a=46.4483021270782……  误差函数在区间内最大值为: 0.00001872118423551505

首先用老程序验证一番：

1. NumberForm[N[NMaximize[{Abs[Hypergeometric2F1[-(1/2), -(1/2), 1, x^2] -
   
2. (1 + (3 x^2)/(
   
3. 10 + Sqrt[
   
4. 4 - 3 x^2])) (1 + (22/(7 \[Pi]) - 1) ((2 x)/(1 + x))^
   
5. 46.4483021270782)], 0 < x < 1}, x]], 10]

复制代码

咋一看，似乎感觉没啥问题，事实上对于NMaximize/NMinimize虽然是全局极值求解器，当计算非线性问题时依旧可能找错位置，这在自带帮助的“更多信息和选项”部分是明确说了的。

没想到这事居然被我遇见了 ，还别说误差函数在在区间内有2个极大值点，而NMaximize返回给我的是最小的点

继续对上面的程序加强优化：

1. ClearAll["Global`*"]
   
2. G[\[Lambda]_] := Hypergeometric2F1[-1/2, -1/2, 1, \[Lambda]^2]
   
3. c = 22/(7 \[Pi]) - 1;
   
4. a = 46.4483021270782`50;
   
5. F[\[Lambda]_,
   
6.   a_] := (1 + (3 \[Lambda]^2)/(10 + Sqrt[4 - 3 \[Lambda]^2]))*(1 +
   
7.     c*(2 \[Lambda]/(1 + \[Lambda]))^a)
   
8. error[\[Lambda]_] := Abs[G[\[Lambda]] - F[\[Lambda], a]];
   
9. obj[\[Lambda]_] = (G[\[Lambda]] - F[\[Lambda], a])^2;
   
10. crit = \[Lambda] /.
    
11.    NSolve[{D[obj[\[Lambda]], \[Lambda]] == 0,
    
12.      0 <= \[Lambda] <= 1}, \[Lambda], Reals, WorkingPrecision -> 30];
    
13. errorAtCrit = error /@ crit;
    
14. Transpose[{crit, errorAtCrit}] // Select[#, #[[2]] > 10^-6 &] & //
    
15. Grid[#, Frame -> All] &
    
16. Plot[error[\[Lambda]], {\[Lambda], 0, 1}, PlotRange -> All]

复制代码

继续对上面的最大值验证程序优化：

1. ClearAll["Global`*"]
   
2. c = 22/(7 \[Pi]) - 1;
   
3. a = 46.4483021270782`100;
   
4. G[\[Lambda]_] = Hypergeometric2F1[-1/2, -1/2, 1, \[Lambda]^2];
   
5. F[\[Lambda]_] = (1 + (3 \[Lambda]^2)/(10 +
   
6.         Sqrt[4 - 3 \[Lambda]^2]))*(1 +
   
7.      c*(2 \[Lambda]/(1 + \[Lambda]))^a);
   
8. Error[\[Lambda]_] = Abs[F[\[Lambda]] - G[\[Lambda]]];
   
9. (*全局搜索：正确写法*)
   
10. res = NMaximize[{Error[\[Lambda]], 0 <= \[Lambda] <= 1}, \[Lambda],
    
11.    Method -> {"DifferentialEvolution", "SearchPoints" -> 30,
    
12.      "RandomSeed" -> 1234},
    
13.    MaxIterations -> 500,(* \[LeftArrow]放在 Method 外面*)
    
14.    WorkingPrecision -> 50];
    
15. (*正确提取*)
    
16. maxVal = res[[1]];
    
17. maxPos = \[Lambda] /. res[[2]];
    
18. {maxVal, maxPos} // N[#, 30] &
    
19. Plot[Error[\[Lambda]], {\[Lambda], 0, 1}, PlotRange -> All,
    
20. Frame -> True, FrameLabel -> {"\[Lambda]", "|F - G|"},
    
21. PlotLabel ->
    
22.   "Error |F(\[Lambda],a)-G(\[Lambda])|\n" <> "Max = " <>
    
23.    ToString@N[maxVal, 10] <> " at \[Lambda] = " <>
    
24.    ToString@N[maxPos, 10],
    
25. Epilog -> {Red, PointSize[Large], Point[{maxPos, maxVal}]},
    
26. ImageSize -> 500]

复制代码

综上：

所以当 a=46.4483021270782……时，误差函数在 λ=0.98704513088618…… 取最大值0.0000188768114766472……

而对于11楼，误差函数在 λ= 0.898055159455627…… 误差函数值0.00001872118423551505…… 显然不是最大值点。

永远

对于NMaximize/NMinimize虽然是全局极值求解器，当计算非线性问题时依旧可能找错位置，这在自带帮助的“更多信息和选项”部分是明确说了的。

因此对11楼程序得到的当 a=46.4483021270782…… 得到的最大值点也是错的。

那么对 11楼 进行改进优化：

1. ClearAll["Global`*"]
   
2. c = 22/(7 \[Pi]) - 1;
   
3. G[\[Lambda]_] = Hypergeometric2F1[-1/2, -1/2, 1, \[Lambda]^2];
   
4. F[\[Lambda]_,
   
5.    a_] = (1 + (3 \[Lambda]^2)/(10 + Sqrt[4 - 3 \[Lambda]^2]))*(1 +
   
6.      c*(2 \[Lambda]/(1 + \[Lambda]))^a);
   
7. \[Lambda]Grid = Subdivide[0.001, 0.999, 1000]; bestA =
   
8. FindFit[{#, G@#} & /@ \[Lambda]Grid, F[\[Lambda], a], a, \[Lambda],
   
9.   NormFunction -> (Norm[#, Infinity] &)];
   
10. bestAValue = a /. bestA;
    
11. Print["最小化最大误差的最佳 a \[TildeTilde] ", bestAValue];
    
12. Plot[{G[\[Lambda]], F[\[Lambda], bestAValue]}, {\[Lambda], 0, 1},
    
13. PlotStyle -> {Blue, {Red, Dashed}},
    
14. PlotLegends -> {"G(\[Lambda])", "F(\[Lambda], a)"},
    
15. PlotLabel -> "最小化最大误差下的逼近效果"]

复制代码

永远

小结一下，误差函数类似于波形函数，也就是说凡是类似于波形函数在区间内求最大值点，都要小心用FindMaximum、NMaximize命令
最保险是对误差函数求导取极值点一个一个比较

永远

待续……%