- 注册时间
- 2015-8-20
- 最后登录
- 1970-1-1
- 威望
- 星
- 金币
- 枚
- 贡献
- 分
- 经验
- 点
- 鲜花
- 朵
- 魅力
- 点
- 上传
- 次
- 下载
- 次
- 积分
- 1304
- 在线时间
- 小时
|
发表于 2023-8-30 06:51:57
|
显示全部楼层
本帖最后由 Jack315 于 2023-8-30 07:12 编辑
先说个直觉,这个补偿函数可能有个天花板。
直觉来自图形,不是证明。先用下列代码看下图……
首先是函数的定义:
- target[x_] := Hypergeometric2F1[-(1/2), -(1/2), 1, x^2]
- ramanujan[x_] := 1 + (3 x^2)/(10 + Sqrt[4 - 3 x^2])
- compensation[x_, a_, b_, c_, d_] := ((3 x^10)/2^17 (1 + ((79/48 + (\[Mu] - 1 - 79/48) x) x^2)/(1 + x^a (1 - x^b)^c)^d)) /. \[Mu] -> 2^17/3 (4/\[Pi] - 14/11)
- err[x_, a_, b_, c_, d_] := target[x] - ramanujan[x] - compensation[x, a, b, c, d]
复制代码
接下来是个函数拟合优劣的评估函数:
- sseMean[aVal_, bVal_, cVal_, dVal_] :=
- Module[{a = aVal, b = bVal, c = cVal, d = dVal, \[Delta], data, sse},
- (*计算数据点时采用的步长*)
- \[Delta] = 0.01;
- (*产生数据点平方*)
- data = Table[(err[x, a, b, c, d])^2, {x, \[Delta], 1, \[Delta]}];
- (*计算 SSE*)
- sse = Total[data];
- (*返回 SSE 的平均值*)
- sse \[Delta]
- ]
复制代码
略微说明下评估拟合的原理:
如果能100%拟合,则两曲线将会重合;
不然的话,两个曲线之间所夹的面积就代表了失拟(曲线形状失配)的程度。
这个面积应该用积分来计算。但计算积分比较耗时,
所以改成离散点上误差平方和的平均值。
与计算两曲线间的最大误差功能类似。但计算速度上可能会更快一点。
下面是用这个函数画图的代码。函数前面加了负号,
使得最小值成为最大值,就是把曲面翻了个个,便于观察。
第一幅图:
- Plot3D[{-sseMean[a, b, 10, 20],
- -sseMean[a, b, 20, 10],
- -sseMean[a, b, 20, 40],
- -sseMean[a, b, 40, 20]},
- {a, 1, 100}, {b, 1, 100},
- MeshFunctions -> {#3 &},
- BoundaryStyle -> Thick,
- AxesLabel -> Automatic,
- PlotLegends -> {"c,d=10,20", "c,d=20,10", "c,d=20,40", "c,d=40,20"}]
复制代码
第二幅图:
- Plot3D[{-sseMean[10, b, c, 20],
- -sseMean[20, b, c, 10],
- -sseMean[20, b, c, 40],
- -sseMean[40, b, c, 20]},
- {b, 1, 100}, {c, 1, 100},
- MeshFunctions -> {#3 &},
- BoundaryStyle -> Thick,
- AxesLabel -> Automatic,
- PlotLegends -> {"a,d=10,20", "a,d=20,10", "a,d=20,40", "a,d=40,20"}]
复制代码
第三幅图:
- Plot3D[{-sseMean[10, 20, c, d],
- -sseMean[20, 10, c, d],
- -sseMean[20, 40, c, d],
- -sseMean[40, 20, c, d]},
- {c, 1, 100}, {d, 1, 100},
- MeshFunctions -> {#3 &},
- BoundaryStyle -> Thick,
- AxesLabel -> Automatic,
- PlotLegends -> {"a,b=10,20", "a,b=20,10", "a,b=20,40", "a,b=40,20"}]
复制代码
第四幅图:
- Plot3D[{-sseMean[a, 10, 20, d],
- -sseMean[a, 20, 10, d],
- -sseMean[a, 20, 40, d],
- -sseMean[a, 40, 20, d]},
- {a, 1, 100}, {d, 1, 100},
- MeshFunctions -> {#3 &},
- BoundaryStyle -> Thick,
- AxesLabel -> Automatic,
- PlotLegends -> {"b,c=10,20", "b,c=20,10", "b,c=20,40", "a,b=40,20"}]
复制代码
从图上可以看出参数的不同只影响最佳参数点的位置,并不影响最佳参数点的值。
这是直觉的由来。若要证这一点,或可从误差函数的级数展开式入手。
注:全局搜索的结果就是到了这个参数最佳点,但这个点上拟合效果并不好。
再放两个演示参数变化如何影响拟合误差的动画。
选的演示点就在全局最佳参数的区域。
第一动画 err ~ a, b :
- Animate[Plot[err[x, a, b, 3, 10],
- {x, 0, 1},
- GridLines -> Automatic,
- PlotRange -> All,
- Frame -> True],
- {a, 1, 100},
- {b, 1, 100},
- AnimationRunning -> False]
复制代码
第二个动画 err ~ c, d :
- Animate[Plot[err[x, 9, 16, c, d],
- {x, 0, 1},
- GridLines -> Automatic,
- PlotRange -> All,
- Frame -> True],
- {c, 1, 100},
- {d, 1, 100},
- AnimationRunning -> False]
复制代码
在动画演示的过程中还可以看到计算发生困难的情况。
这是因为在补偿函数里采用了指数函数的原因:
\[\begin{matrix}f(x)=a^x,&a>0且a\ne1\end{matrix}\]
虽然有这个直觉,但并不能否定有可以满足拟合精度要求的解。
不过即使有,找到这个点的概率可能也不太大,就是要有点运气的意思。
鉴于成功前景不佳,所以只能另寻其它方法了。 |
|