RE: Re: ALL roots of non-polynomial equation
- To: mathgroup at smc.vnet.net
- Subject: [mg35999] RE: [mg35942] Re: [mg35926] ALL roots of non-polynomial equation
- From: "DrBob" <majort at cox-internet.com>
- Date: Sun, 11 Aug 2002 05:14:05 -0400 (EDT)
- Reply-to: <drbob at bigfoot.com>
- Sender: owner-wri-mathgroup at wolfram.com
Here's a similar solution that averages points on either side of sign
changes, to get better initial starts for FindRoot:
g = Plot[Sin[x], {x, 0.1, 10.1*Pi}, DisplayFunction -> Identity];
points = First@Cases[g, Line[x_] -> x, Infinity];
signs = Sign /@ points[[All, 2]];
positions =
Union[#, # + 1] &@Flatten@Position[Rest[signs*RotateRight@signs],
-1]
starts = 1/2Plus @@@ Partition[points[[positions, 1]], 2]
x /. (FindRoot[Sin[x] == 0, {x, #1}] &) /@ starts
{27, 28, 51, 52, 74, 75, 101, 102, 126, 127, 149, 150,
177, 178, 200, 201, 226, 227, 252, 253}
{3.09198, 6.26091, 9.13801, 12.5265, 15.7722, 18.9688, 22.0933, 24.8161,
28.1494, 31.4348}
{3.14159, 6.28319, 9.42478, 12.5664, 15.708, 18.8496, 21.9911, 25.1327,
28.2743, 31.4159}
Bobby Treat
-----Original Message-----
From: Andrzej Kozlowski [mailto:andrzej at platon.c.u-tokyo.ac.jp]
To: mathgroup at smc.vnet.net
Subject: [mg35999] [mg35942] Re: [mg35926] ALL roots of non-polynomial equation
In your example, yes. Here is one way (adapted from a slightly different
problem in Stan Wagon's "Mathematica in Action")
We make use of Mathematica's ability to plot graphs:
In[1]:=
g = Plot[Sin[x], {x, 0.1, 10.1*Pi}, DisplayFunction ->
Identity];
We make a list of all the coordinates of the points represented on the
graph.
In[2]:=
points = Cases[g, Line[x_] -> x, Infinity][[1]];
We make a list of the signs of the y values:
In[3]:=
signs = Sign /@ Transpose[Cases[g, Line[x_] -> x, Infinity][[
1]]][[2]];
We find the points where the sign changes:
In[4]:=
positions = Position[Rest[signs]*Rest[RotateRight[signs]],
-1]
Out[4]=
{{27}, {51}, {74}, {101}, {126}, {149}, {177}, {200}, {226},
{252}}
We make a list of starting points for FindRoot:
In[5]:=
starts = First[Transpose[Extract[points, positions]]]
Out[5]=
{2.7825096162536145, 6.080185995733974, 8.787418231655966,
12.198138489619575, 15.464841498197309, 18.61672099859868,
21.92859710988888, 24.46767425065356, 27.840417480532142,
31.139545383515845}
We find the roots:
In[6]:=
(FindRoot[Sin[x] == 0, {x, #1}, WorkingPrecision ->
20] & ) /@ starts
Out[6]=
{{x -> 3.141592653589793238462643383255068`20},
{x -> 6.283185307179586476925286766538051`20},
{x -> 9.424777960769379715387930149825109`20},
{x -> 12.566370614359172953850573533079026`20},
{x -> 15.707963267948966192313216916378673`20},
{x -> 18.849555921538759430775860299681079`20},
{x -> 21.991148575128552669238503682979946`20},
{x -> 25.132741228718345907701147066183302`20},
{x -> 28.274333882308139146163790449476032`20},
{x -> 31.415926535897932384626433832775678`20}}
This question has been asked frequently so you can find various
approaches, including this one, in the archives. Of course there is no
guarantee. For very complex functions you may well miss some roots. The
situation can become a lot more complicated if your equation has
multiple roots.
Andrzej
On Thursday, August 8, 2002, at 07:06 PM, Mihajlo Vanevic wrote:
>
> Can Mathematica find (localize) ALL roots of non-polynomial equation
>
> eq[x]==0
>
> on a given segment x \in [a,b], a,b=Real??
>
> (for example Sin[x]==0, for 0.1<x<10.1 Pi )
>
>
>
>
>
>
>