# RootSearch warning “too small to represent as a normalized machine number”

RootSearch is a package for finding all roots within a range from Ted Ersek. As I test it, it is quite robust. But I also encountered some issue that I can not resolve.

I define a function

ClearAll[f];
f[r_?NumericQ] :=
Sort[Re@Eigenvalues[{{3.5 - 1.6 Cos[Im[E^(I 0.) r]] -
2.4 Cos[Re[E^(I 0.) r]], 0, -0.07, 0}, {0,
3.5 - 2.4 Cos[Im[E^(I 0.) r]] - 1.6 Cos[Re[E^(I 0.) r]],
0, -0.07}, {-0.07,
0, -3.5 + 1.6 Cos[Im[E^(I 0.) r]] + 2.4 Cos[Re[E^(I 0.) r]],
0}, {0, -0.07,
0, -3.5 + 2.4 Cos[Im[E^(I 0.) r]] +
1.6 Cos[Re[E^(I 0.) r]]}}]][[3]]


the plot is quite usual

Now I want to find points where the first derivative of f are zero using RootSearch.

If I do it as

roots = RootSearch[f'[t] == 0, {t, 0., 1.}];


there will be a warning

General::munfl: 2.2204510^-16 2.2250710^-308 is too small to represent as a normalized machine number; precision may be lost.

And no result came out after I waited for several minutes.

However, If I do

roots = RootSearch[f'[t] == 0.0001, {t, 0., 1.}];


It finishes in seconds.

and

vals = Table[{i, f[i]}, {i, Flatten[roots][[;; , -1]]}];
Plot[f[x], {x, 0.1, 1}, PlotRange -> All,
Epilog -> {PointSize[Medium], Red, Point[vals]}]


shows

So, why is RootSearch[f'[t] == 0, {t, 0., 1.}] not working?

I also find as simple as RootSearch[Sin[x] == 0, {x, 0, 100}] will also gives precision lost warning, but it gives result immediately.

PS:

I found that if I change the interval to {0.1,1} then

RootSearch[f'[t] == 0, {t, 0.1, 1.}]


will work. So it is t=0 cause the problem. Why is that?

another much simple case I just found is

ClearAll[g];
g[x_?NumericQ]:=x^3;


and

RootSearch[g'[x] == 0, {x, -1, 1}]


will not give an answer. But

RootSearch[3x^2 == 0, {x, -1, 1}]


This is a valuable case, because Plot based root finding or NDSolve event locating method can not deal with this case( first derivative only touch x axis, not penetrating it)

• Not related to the problem here, but I don't think it's a good idea to rely on that feature of Derivative, just compare: inter = FunctionInterpolation[f[t], {t, 0, 1}, MaxRecursion -> 10]; Plot[{inter'@x, f'[t]}, {x, 0.1, 1}] Other examples: mathematica.stackexchange.com/q/29329/1871 mathematica.stackexchange.com/q/196998/1871 – xzczd Oct 7 '20 at 13:08
• @xzczd You are right. I already found ' is not reliable. It seems that it has no precision control. ND is controllable with Scale option. If this post can be solved. I actually will use ND for my problem for better precision. – matheorem Oct 7 '20 at 13:16

RootSearch is an old program and changes in Mathematica since my last update cause RootSearch to have problems when looking for a root of f[x] near x=0. There is a function Ulp2[x1,x2] in the package that determines how far it is from x1 to the nearest approximate number towards x2. Ulp2 gets hung up when x1 is machine precision zero. I might put an updated version on the Wolfram Function Repository in the coming weeks. Your problem can be simplified considerably. Change 0.0 to integer zero. Then for real r:

Im[E^(I*0)*r]->0
Re[E^(I*0)*r]->r


Eigenvalues[{
{35 - 16 - 24*Cos[r], 0, -7/10, 0},
{0, 35 - 24 - 16*Cos[r], 0, -7/10},
{-7/10, 0, -35 + 16 + 24*Cos[r], 0},
{0, -7/10, 0, -35 + 24 + 16*Cos[r]}}/10]


$$\left\{-\frac{1}{100} \sqrt{-35200 \cos (r)+12800 \cos (2 r)+24949},\frac{1}{100} \sqrt{-35200 \cos (r)+12800 \cos (2 r)+24949},-\frac{1}{100} \sqrt{-91200 \cos (r)+28800 \cos (2 r)+64949},\frac{1}{100} \sqrt{-91200 \cos (r)+28800 \cos (2 r)+64949}\right\}$$

The output of NMinimize below shows that for any real r, you are taking the square root of a positive number in the above.

N@Minimize[24949-35200 Cos[r]+12800 Cos[2 r],Element[r,Reals]]
N@Minimize[64949-91200 Cos[r]+28800 Cos[2 r],Element[r,Reals]]


You will always have two positive and two negative eigen-values. Next I find r where one of the positive eigen-values becomes greater than the other positive eigen-value.

FindRoot[24949-35200 Cos[r]+12800 Cos[2 r]==64949-91200 Cos[r]+28800 Cos[2 r],{r,0.7}]


(* Out[]= {r->0.722734} *)

The following f[r_] gives the same result as yours, but it provides much more insight into your problem.

Clear[f]
f[r_]:=Piecewise[{
{Sqrt[ 64949-91200 Cos[r]+28800 Cos[2 r]]/100,r<0.7227342478134149},
{Sqrt[24949-35200 Cos[r]+12800 Cos[2 r]]/100,0.7227342478134149<=r}
}];
Plot[f[x],{x,0,1}]


• Hi, @Ted Ersek. Thank you so much for answering. It is happy to see respond of the author of RootSearch:) . I definitely wish an updated version of RootSearch. I learned a lot by reading your example nb, and I tried hard toying with Mathematica built in functions like FindRoot and FindMinimum, currently can not find ways to surpass the robustness of your Golden-secant method for three point case. – matheorem Oct 9 '20 at 7:18
• I think Mathematica should adopt your golden-secant method :) – matheorem Oct 9 '20 at 7:20
• I created a simplified version according to your RootSearch rely on FindRoot and FindMinimum. It is pretty good as far as I test. But far not as delicate as yours :) mathematica.stackexchange.com/a/231577/4742 – matheorem Oct 10 '20 at 2:03