Message Boards Message Boards

0
|
9288 Views
|
9 Replies
|
9 Total Likes
View groups...
Share
Share this post:

Zero crossings and zero almost-crossings

Posted 9 years ago

I try to get to get a zero crossing of a complicated function, which has local minima, see figure repulsion above a superconductor.

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)??

POSTED BY: Art Haan
9 Replies

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 

a test function

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 ...

POSTED BY: Udo Krause

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.

http://library.wolfram.com/infocenter/MathSource/4482/

FindRoot might work better if you multiply the function by 10^9

POSTED BY: Frank Kampas

It would help if you posted your code snippet

POSTED BY: Kay Herbert

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}]

enter image description here

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.

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.

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}
POSTED BY: Udo Krause
Posted 9 years ago

Thank you for the info, see attach for the code.

Attachments:
POSTED BY: Art Haan
Reply to this discussion
Community posts can be styled and formatted using the Markdown syntax.
Reply Preview
Attachments
Remove
or Discard

Group Abstract Group Abstract