函数逼近求最佳a值。
mathematica吧
全部回复
仅看楼主
level 8
晓笨笨🌐 楼主
代码:
(*常数*)c = 22/(7 \[Pi]) - 1;
(*函数*)
G[\[Lambda]_] = Hypergeometric2F1[-1/2, -1/2, 1, \[Lambda]^2];
F[\[Lambda]_,
a_] = (1 + (3 \[Lambda]^2)/(10 + Sqrt[4 - 3 \[Lambda]^2]))*(1 +
c*(2 \[Lambda]/(1 + \[Lambda]))^a);
(*离散化 \[Lambda] 区间*)
\[Lambda]Grid =
Subdivide[0.001, 0.999, 1000];(*避开端点 0 和 1*)(*最大绝对误差(离散版)*)
maxError[a_?NumericQ] := Max[Abs[F[
#, a] - G[#
]] & /@ \[Lambda]Grid];
(*最小化最大误差*)
{minMaxError, bestA} =
NMinimize[{maxError[a], 0 < a < 100}, a,
Method -> "DifferentialEvolution"];
(*结果*)
bestAValue = a /. bestA;
Print["最小化最大误差的最佳 a \[TildeTilde] ", bestAValue,
", 最大误差 \[TildeTilde] ", minMaxError];
(*验证*)
Plot[{G[\[Lambda]], F[\[Lambda], bestAValue]}, {\[Lambda], 0, 1},
PlotStyle -> {Blue, {Red, Dashed}},
PlotLegends -> {"G(\[Lambda])", "F(\[Lambda], a)"},
PlotLabel -> "最小化最大误差下的逼近效果"]
2025年08月06日 09点08分 1
level 8
晓笨笨🌐 楼主
楼上代码运行后得:最小化最大误差的最佳 a=46.4826……
可实际上a=46.449……
另外楼上代码运行有点卡,不知道怎么改代码使之运行快一点?
以上情况还望前辈们指导一二。
2025年08月06日 09点08分 2
最小化最大误差的最佳 a=46.4……
2025年08月07日 04点08分
level 9
ClearAll["`*"];
c = 22/(7 \[Pi]) - 1;
G[\[Lambda]_] := Hypergeometric2F1[-1/2, -1/2, 1, \[Lambda]^2];
F[\[Lambda]_,
a_] := (1 + (3 \[Lambda]^2)/(10 + Sqrt[4 - 3 \[Lambda]^2]))*(1 +
c*(2 \[Lambda]/(1 + \[Lambda]))^a);
something[a_?NumericQ] :=
NMaxValue[{Abs[G[\[Lambda]] - F[\[Lambda], a]],
0 <= \[Lambda] < 1}, \[Lambda]];
data1 = ParallelMap[{
#, something[#
]} &, Range[0, 100, 0.5]];
从粗糙的数据data1中得出极小值点在46和47之间
ListPlot@data1
MinimalBy[data1, Last, 4]
然后再使用
NMinimize[{something[a], 46 <= a <= 47}, a]
得出a.
这个NMinimize需要花费较长时间, 我想是因为函数之差的绝对值something疑似是不连续的
ListPlot[
ParallelMap[{
#, something[#
]} &, Range[46.446, 46.450, 0.00005]],
PlotRange -> All]
不知道是什么原因.
2025年08月06日 18点08分 4
最小化最大误差的最佳 a=46.4……
2025年08月07日 04点08分
请看13楼
2025年08月18日 14点08分
level 7
按照你对maxError的定义,确实是在a=46.4826取到最小值,不知道你认为“实际上a=46.449”的理由是什么
要加速代码,只需要用内置函数拟合即可
(*前面到\[Lambda]Grid的定义为止都是一样的*)
bestA=FindFit[{
#,G@#
}&/@\[Lambda]Grid,F[\[Lambda],a],a,\[Lambda],NormFunction->(Norm[#,Infinity]&)]
这里将NormFunction选项设定为无穷范数,指定优化目标为最小化最大误差,不带参数的情况下,FindFit默认是求最佳的最小平方拟合
2025年08月07日 00点08分 5
2楼a=46.449说法确实不妥,应该是最小化最大误差的最佳 a=46.4附近
2025年08月07日 04点08分
此楼的46.4826应该是正确答案(至少比lz算出的结果优)。并且只要编程得当,计算时间可以控制在5秒内。高精度验算所需的时间也不会超过10秒。
2025年08月18日 08点08分
@xzcyr 最佳 a=46.4483021270782……知 a≈46.4484 误差=0.00001872138763348019
2025年08月18日 14点08分
请看13楼
2025年08月18日 14点08分
level 8
晓笨笨🌐 楼主
主贴问题已解决:
苦战了几个夜晚,终于锁定最佳 a 值,用Mathematica 编程得到的值与自己先前预测值完美一致!!!
最佳 a=46.4483021270782……
最小化最大误差值为: 0.0000
18721184235
51505……
最优 λ 值为: 0.898055159455627……
2025年08月15日 12点08分 6
……要是别人在你的提问帖下面回一句“这问题我解决了,但是怎么解决的我不告诉你”,你是啥感觉?
2025年08月18日 06点08分
吧务
level 15
而且你6楼算出来的也不是最优值,当a取你说的值时,误差函数的极值应该在0.987附近:
avalue = 46.4483021270782;
N[With[{\[Lambda] = Rationalize[0.987097692805233`, 0]},
Abs[F[\[Lambda], Rationalize[avalue, 0]] - G[\[Lambda]]]], 16]
此时的误差最大值为0.0000
18876652759
33527。至于我咋算出来的嘛,我不告诉你。
2025年08月18日 08点08分 8
最佳 a=46.4483021270782……知 a≈46.4484 误差=0.00001872138763348019
2025年08月18日 14点08分
请看13楼
2025年08月18日 14点08分
level 8
晓笨笨🌐 楼主
2025年08月18日 13点08分 9
level 8
晓笨笨🌐 楼主
用Mathematica检验所求的最大误差值是不是最小值:
NumberForm[N[NMaximize[{Abs[Hypergeometric2F1[-(1/2), -(1/2), 1, x^2] -
(1 + (3 x^2)/(
10 + Sqrt[
4 - 3 x^2])) (1 + (22/(7 \[Pi]) - 1) ((2 x)/(1 + x))^
46.4483021270782)], 0 < x < 1}, x]], 10]
2025年08月18日 14点08分 10
level 8
晓笨笨🌐 楼主
特别的,当a≈46.4484 误差=0.0000
18721387633
48019
NumberForm[N[NMaximize[{Abs[Hypergeometric2F1[-(1/2), -(1/2), 1, x^2] -
(1 + (3 x^2)/(
10 + Sqrt[
4 - 3 x^2])) (1 + (22/(7 \[Pi]) - 1) ((2 x)/(1 + x))^
46.4484)], 0 < x < 1}, x]], 10]
2025年08月18日 14点08分 11
level 8
晓笨笨🌐 楼主
从图片上显示误差
a=46.4826,误差=0.0000
18792507331
166775`
a=46.4484,误差=0.0000
18721387633
48019
2025年08月18日 14点08分 12
level 8
晓笨笨🌐 楼主
a=46.4483021270782……
代码:
(*目标函数 G(\[Lambda])*)
G[\[Lambda]_] := HypergeometricPFQ[{-1/2, -1/2}, {1}, \[Lambda]^2];
(*逼近函数 F(\[Lambda],a)*)
F[\[Lambda]_,
a_] := (1 + (3 \[Lambda]^2)/(10 +
Sqrt[4 - 3 \[Lambda]^2]))*(1 + (22/(7 \[Pi]) -
1) (2 \[Lambda]/(1 + \[Lambda]))^a);
(*定义绝对误差函数*)
error[\[Lambda]_, a_] := Abs[F[\[Lambda], a] - G[\[Lambda]]];
(*计算给定 a 值时的最大绝对误差*)
maxError[a_?NumericQ] :=
NMaximize[{error[\[Lambda], a], 0 < \[Lambda] < 1}, \[Lambda]][[1]];
(*寻找最优 a 值*)
optimalA =
NMinimize[{maxError[a], a > 0}, a,
Method -> {"SimulatedAnnealing", "PerturbationScale" -> 3},
PrecisionGoal -> 3];
(*输出最优 a 值*)
aOpt = a /. optimalA[[2]];
\[Lambda]Opt = \[Lambda] /.
Last[NMaximize[{error[\[Lambda], aOpt],
0 < \[Lambda] < 1}, \[Lambda]]];
Print["最优 a 值为: ", NumberForm[aOpt, 20]];
Print["最大误差为: ", NumberForm[optimalA[[1]], 20]];
Print["最优 \[Lambda] 值为: ", NumberForm[\[Lambda]Opt, 20]];
(*误差图像*)
Plot[error[\[Lambda], aOpt], {\[Lambda], 0, 1}, PlotRange -> All,
PlotLabel -> "最大误差 = " <> ToString[NumberForm[optimalA[[1]], 10]]]
2025年08月18日 14点08分 13
13楼的代码运行时有点卡,但能运行
2025年08月18日 14点08分
level 8
晓笨笨🌐 楼主
可惜的是13楼的代码运行时有点卡,但能运行。
2025年08月18日 14点08分 14
吧务
level 15
还在这执迷不悟呢,我8楼已经说了,当a取46.4483…时,误差函数的最大值根本不在0.898…,而在0.987…,用于验算的代码就在8楼,不要视而不见。NMaximize/NMinimize虽然是全局极值求解器,当计算非线性问题时依旧可能找错位置,这在自带帮助的“更多信息和选项”部分是明确说了的。
2025年08月19日 00点08分 15
请问吧主:当a取46.4483…时,误差函数的最大值在0.987…处怎么编程得到?
2025年08月19日 04点08分
吧务
level 15
take = (Reverse[Cases[#, Line[lst_] :> lst, Infinity][[1]], 2] //
Sort) &;
help[a_?NumericQ] := ({max, lambdavalue} =
take@Plot[Abs[F[\[Lambda], a] - G[\[Lambda]]], {\[Lambda], 0, 1},
PlotRange -> All] // Last; max)
help[46.4483]
lambdavalue
(*
0.0000188764
0.986958
*)
2025年08月19日 07点08分 16
吧主你好我算的当a=46.4483021270782时误差函数最大值在λ=0.987045130886181399428246756385处为0.00001887681147664729485361374与你的0.986958怎么有微小偏差[疑问]
2025年08月19日 11点08分
代码请看楼下,看我我代码编的是不是有问题
2025年08月19日 11点08分
@晓笨笨🌐 差一点正常,我上面的代码没调精度也没重新校正。
2025年08月19日 11点08分
@xzcyr 请问前辈该楼层你的代码精度怎么调?可否给出代码?
2025年08月19日 12点08分
level 8
晓笨笨🌐 楼主
ClearAll["Global`*"]
G[\[Lambda]_] := Hypergeometric2F1[-1/2, -1/2, 1, \[Lambda]^2]
c = 22/(7 \[Pi]) - 1;
a = 46.4483021270782`50;
F[\[Lambda]_,
a_] := (1 + (3 \[Lambda]^2)/(10 + Sqrt[4 - 3 \[Lambda]^2]))*(1 +
c*(2 \[Lambda]/(1 + \[Lambda]))^a)
error[\[Lambda]_] := Abs[G[\[Lambda]] - F[\[Lambda], a]];
obj[\[Lambda]_] = (G[\[Lambda]] - F[\[Lambda], a])^2;
crit = \[Lambda] /.
NSolve[{D[obj[\[Lambda]], \[Lambda]] == 0,
0 <= \[Lambda] <= 1}, \[Lambda], Reals, WorkingPrecision -> 30];
errorAtCrit = error /@ crit;
Transpose[{crit, errorAtCrit}] // Select[#, #[[2]] > 10^-6 &] & //
Grid[#, Frame -> All] &
Plot[error[\[Lambda]], {\[Lambda], 0, 1}, PlotRange -> All]
2025年08月19日 11点08分 17
1