As of right now my module is able to detect the minima closest to the input point given. The module:
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]]]]
The function I'm testing has 2 minima:
k[x_] := 1 - 2 x^2 + 3 x^3 + 4.7 x^4
It's plot:
(Note: my module only gets close to the minima and approximates it. This is something I'll work on fixing myself but for right now I'd like to get the module to detect both minima)
It's finding the minima by approaching the function's derivative==0 of course
Right minima:
Newton[2,k]
I get the rightmost minima approx of x~0.3004
Actual value by using FindRoot of k'[x]==0 is 0.280421
Left minima:
Newton[-1,k]
I get the left minima approx of x~-0.7637
Actual value by using FindRoot of k'[x]==0 is -0.759031
But I logically want it to detect that there are 2 minima for this polynomial, and n minima for any other degree polynomial. Once given a starting point it will run 1000 iterations until it approaches the first minima, then set the point after the minima as a new starting point and find the next one so that it gets 3 values to match the k'[x] degree. One of those 3 being the local maxima. Another obstacle is ignoring the maxima which I thought maybe an IF loop would help with by detecting whether k'[x->]<0 (x to the right of the maxima) and k'[<-x]>0 (x to the left of the maxima) would mean the point between is a local maxima and then be removed from the minima list. However I haven't gotten anything to work. Another idea is once it can detect all points where k'[x]==0 it should make 3 separate lists. Then remove the maxima. Finally with what's left we have List[[-1]] of the two lists append to the final Minima list and the minima list is the output.
So AppendTo[MinimaList,xcur[[-1]]]
for each iteration at the end of the module works.
To get all the exact minima for any polynomial may be impossible.
To get all the exact minima for your example is possible. Note replacing 4.7 with 47/10 to get exact results.
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}}
and
Simplify[Map[{x,Sign[D[k[x],{x,2}]]}/.#&,sols]]
returns
{{0, -1},
{(-45 - Sqrt[9545])/188, 1},
{(-45 + Sqrt[9545])/188, 1}}
where the first item in each list is the exact value of x where this happens, the second item is 1 for a minima or is -1 for a maxima by the second derivative test.
and
Cases[%,{_,1}]
selects only the minima and returns
{{(-45 - Sqrt[9545])/188, 1},
{(-45 + Sqrt[9545])/188, 1}}
The decimal approximations for those exact values are
N[%]
{{-0.759035,1.},
{0.280311,1.}}
Check this very carefully to make certain there are no mistakes and then you should be able to adapt this for use in your Module.