I try to get to get a zero crossing of a complicated function, which has local minima, see figure
If I use FindRoot of this function at zero, It does not find the crossing at 13 micron (as in the figure) but at 9.2 micron, which has a value close to zero.
Why isn’t there an Intersection algorithm for functions in Mathematica?
NSolve is too slow and accuracygoal and precisiongoal does not help.
Is there a way to get the intersection value with the zero line (zero crossing)??
You might want to try the RootSearch package from Ted Ersek from the Wolfram Library Archive. I’m not certain if it still works in Version 10, but it was very good at finding roots of single parameter functions.
FindRoot might work better if you multiply the function by 10^9
It would help if you posted your code snippet
Here is an example of Ted Ersek’s RootSearch package that you can get from the Wolfram Library Archive. I did slightly modify his package so it’s in an Ersek folder in my Applications folder. And I think I may have added several Quiet statements.
<< Ersek`RootSearch`
f1[x_] := Sin[4 x] - (1 + x)/8;
Plot[f1[x], {x, -13, 12}]
RootSearch[f1[x] == 0, {x, -13, 12}]
giving:
{{x -> -8.34829}, {x -> -8.12893}, {x -> -6.86295}, {x -> -6.47147},
{x -> -5.35392}, {x -> -4.83746}, {x -> -3.83638}, {x -> -3.21162},
{x -> -2.31492}, {x -> -1.58923}, {x -> -0.791902}, {x -> 0.0323512},
{x -> 0.730877}, {x -> 1.65538}, {x -> 2.25155}, {x -> 3.28282},
{x -> 3.76739}, {x -> 4.92069}, {x -> 5.27249}, {x -> 6.59611}, {x -> 6.73982}}
Ted’s code will find all the roots within a specified range of the parameter. It even finds roots where the function just touches zero but doesn’t cross it. Mathematica has many ways of finding roots, some of them based of algebraic methods or Solve or Reduce. But it lacks a simple 1-dimensional numerical search. Ted’s program is very good at that.
But it lacks a simple 1-dimensional numerical search.
Because it’s not simple. The simple search is known as Newton’s method:
In[32]:= nsZ[f_, x0_, n_Integer: 100] := If[NumericQ[f[x0]],
FixedPoint[(# - f[#]/f'[#])&, N[x0], n], (* else *)
Print["Function f = ", f, " is not numeric at x0 = ", x0];
Return[$Failed]
]
In[40]:= Clear[f]
f[x_] := 3 (x - 1)^3 - (x + 1)^2 + x
it has in its naive form some problems (e.g. if it hits a local extremum by chance)
In[43]:= f /@ (nsZ[f, #]& /@ Range[0, 4])
Out[43]= {35.0768, 123.983, 7.02827*10^-7, 3.10862*10^-14, 0.0000145634}
but is easy to implement and very fast as long as evaluation of the function and it’s derivative are fast.
Less naive, one could fold Newton’s method first to find the extrema than the zeroes …
Yes but Ted’s RootSearch algorithm, based on the literature, is much more than a bare Newton’s method. It finds all of the roots within a search range and it doesn’t get thrown off if a Newton iteration is outside the search range. And it is simple to use.
f[x_] := 3 (x - 1)^3 - (x + 1)^2 + x
RootSearch[f[x] == 0, {x, -1, 4}, PrecisionGoal -> 20]
giving:
{{x -> 2.4730512839991728510}}
This did not require a “good” starting point. No starting point was specified, only the search domain.
Thank you for the info, see attach for the code.
Art,
Here is the solution using Ted Ersek’s RootSearch package.
<< Ersek`RootSearch`
RootSearch[Ftot[x, 0, 5*^-6] + k0*(x - 7.53*^-6) == 0, {x, 0*^-6, 20*^-6}]
giving:
{{x -> 0.000012988}}
And here is the zero using the built-in FindRoot
In[24]:= FindRoot[Ftot[x, 0, 5 10^(-6)] + k0*(x - 7.53 10^(-6)) == 0, {x, 0},
WorkingPrecision -> 2 $MachinePrecision]
During evaluation of In[24]:= FindRoot::precw: The precision of the argument function (<<1>>==0) is less than WorkingPrecision (31.909179540382006`). >>
Out[24]= {x -> 0.000012988020154476412351028027555890}
In[25]:= $MachinePrecision
Out[25]= 15.9546
working in the nanometer range it is clear that usual WorkingPrecision is not enough (Frank Kampas intended to point that out with his post). Quite often Mathematica built-in functions work far better than their absent-minded usage seems to suggest.
The FindRoot::precw message can be avoided if the constants are given with the precision needed, with other words
In[32]:= FindRoot[
SetPrecision[Ftot[x, 0, 5 10^(-6)] + k0*(x - 7.53 10^(-6)), #] == 0, {x, 0}, WorkingPrecision -> #] &[2 $MachinePrecision]
Out[32]= {x -> 0.000012988020154476412351028027555890}