我将如何修改我的 mathematica 模块以检测 n 次多项式的所有最小值？

Question

截至目前，我的模块能够检测到最接近给定输入点的最小值。模块：

Newton[x0_, fun_] := Module[{der, xcurlist = {x0}, xold = x0 - 1, xcur = x0, deltax, deltay, MinimaList={} ii = 1}, 
 Monitor[While[ii++ < 1000 && xold != xcur,
   xold = xcur;
   der = (fun[xcur + .001] - fun[xcur])/.001;
   deltax = .001*Abs[der];
   deltay = -deltax*der;
   If[Abs[deltay] > .1, deltay = .1*Sign[deltay]];
   xcur = xcur + deltay;
   AppendTo[xcurlist, xcur]];, 
   xcur];
 AppendTo[MinimaList,xcurlist[[-1]]]]

我正在测试的函数有 2 个最小值：

k[x_] := 1 - 2 x^2 + 3 x^3 + 4.7 x^4

剧情：

（注意：我的模块只接近最小值并对其进行近似。这是我将自己修复的问题，但现在我想让模块检测两个最小值）

当然是求函数导数的最小值==0

右侧最小值：

Newton[2,k]

我得到最右边的最小值大约为 x~0.3004

k'[x]==0的FindRoot实际值为0.280421

左最小值：

Newton[-1,k]

我得到了 x~-0.7637 的左最小值

k'[x]==0的FindRoot实际值为-0.759031

但我逻辑上希望它检测到这个多项式有 2 个最小值，任何其他次数多项式有 n 个最小值。一旦给定一个起点，它将运行 1000 次迭代，直到它接近第一个最小值，然后将最小值之后的点设置为新的起点并找到下一个点，以便它获得 3 个值来匹配 k'[ x]度。这 3 个中的一个是局部最大值。另一个障碍是忽略最大值，我认为 IF 循环可能会通过检测 k'[x->]<0（x 在最大值右侧）和 k'[<-x]>0（x 到最大值的左侧）将意味着两者之间的点是局部最大值，然后从最小值列表中删除。但是我还没有得到任何工作。另一个想法是，一旦它可以检测到所有 k'[x]==0 的点，它就应该制作 3 个单独的列表。然后删除最大值。最后，我们将两个列表中的 List[[-1]] 附加到最终的最小值列表，最小值列表就是输出。

所以 AppendTo[MinimaList,xcur[[-1]]] 对于模块末尾的每次迭代都有效。

Answer 1

要获得任何多项式的所有精确最小值可能是不可能的。

为您的示例获取所有精确的最小值是可能的。请注意将 4.7 替换为 47/10 以获得准确的结果。

k[x_] := 1 - 2 x^2 + 3 x^3 + 47/10 x^4;
sols=Solve[D[k[x],x]==0,x]

returns

{{x -> 0}, {x -> (-45 - Sqrt[9545])/188}, {x -> (-45 + Sqrt[9545])/188}}

和

Simplify[Map[{x,Sign[D[k[x],{x,2}]]}/.#&,sols]]

returns

{{0, -1},
 {(-45 - Sqrt[9545])/188, 1},
 {(-45 + Sqrt[9545])/188, 1}}

其中每个列表中的第一项是发生这种情况的 x 的精确值，第二项是 1 表示最小值，或者是 -1 表示二阶导数检验的最大值。

和

Cases[%,{_,1}]

只选择最小值，returns

{{(-45 - Sqrt[9545])/188, 1},
 {(-45 + Sqrt[9545])/188, 1}}

这些精确值的十进制近似值是

N[%]

{{-0.759035,1.},
 {0.280311,1.}}

非常仔细地检查它以确保没有错误，然后您应该能够调整它以在您的模块中使用。

我将如何修改我的 mathematica 模块以检测 n 次多项式的所有最小值？

How would I modify my mathematica module to detect all minima of a polynomial with degree n?

wolfram-mathematica

newtons-method

polynomials