我如何修改我的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]]]]

我正在测试的函数有两个最小值。

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。

用FindRoot计算k'[x]==0的实际值为-0.759031。

但从逻辑上讲，我希望它能检测到这个多项式有2个最小值，而任何其他度多项式有n个最小值。一旦给定一个起点，它将运行1000次迭代，直到接近第一个最小值，然后将最小值之后的点设为新的起点，并找到下一个点，使其得到3个与k'[x]度相匹配的值。这3个值中有一个是局部最大值.另一个障碍是忽略最大值，我想也许一个IF循环可以帮助解决这个问题，检测k'[x->]<0(最大值右边的x)和k'[<-x]>0(最大值左边的x)是否意味着这两者之间的点是局部最大值，然后从最小值列表中删除。然而我还没有得到任何工作.另一个想法是，一旦它能检测到k'[x]==0的所有点，它应该做出3个独立的列表。然后去掉最大值。最后剩下的，我们将两个列表中的List[[-1]]追加到最后的Minima列表中，最小值列表就是输出。

所以 AppendTo[MinimaList,xcur[[-1]]] 为模块最后的每次迭代工作。

Answer 1

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

在你的例子中得到所有精确的最小值是可能的。请注意用4710替换4.7以获得精确结果。

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

返回

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

和

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

返回

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

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

和

Cases[%,{_,1}]

只选择最小值并返回

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

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

N[%]

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

仔细检查以确保没有错误，然后你应该能够将其改编为你的模块使用。