RE: Re: ALL roots of non-polynomial equation
- To: mathgroup at smc.vnet.net
- Subject: [mg36002] RE: [mg35942] Re: [mg35926] ALL roots of non-polynomial equation
- From: "DrBob" <majort at cox-internet.com>
- Date: Sun, 11 Aug 2002 05:14:09 -0400 (EDT)
- Reply-to: <drbob at bigfoot.com>
- Sender: owner-wri-mathgroup at wolfram.com
Better yet, avoid unnecessary contortions:
f[x_] = Normal[Sin[x] + O[x]^100];
Plot[f[x] - Sin[x], {x, 0.1, 10Pi}, PlotRange -> All];
Select[x /. NSolve[f[x] == 0, x], Im[#1] == 0 && 0.1 ? #1 ? 10.1Pi &]
{3.14159, 6.28319, 9.42478, 12.5664, 15.708, 18.8496, 21.9911, 25.1327,
\
28.2744, 31.4156}
The Plot should tell us whether we have enough terms in the Series.
Bobby Treat
-----Original Message-----
From: Andrzej Kozlowski [mailto:andrzej at tuins.ac.jp]
To: mathgroup at smc.vnet.net
Subject: [mg36002] Re: [mg35942] Re: [mg35926] ALL roots of non-polynomial
equation
Perhaps it's worth recalling that probably the simplest method seems to
be the one posted some time ago by Adam Strzebonski
In[1]:=
f[x_] = Normal[Sin[10.1*Pi*x] + O[x]^100];
In[2]:=
10.1*Pi*Select[x /. NSolve[f[x] == 0, x],
Im[#1] == 0 && 0.1/(Pi*10.1) <= #1 <= 1 & ]
Out[2]=
{31.41492328081239, 28.274379350873716, 25.132740219910605,
21.991148587034512, 18.84955591555759, 15.707963269122267,
12.56637061424962, 9.424777960775808, 6.283185307178523,
3.141592653590188}
The problem is of course that it is difficult to know how long a Taylor
series to take, whehter one has found all the roots and how accurate the
answers are, although with careful analysis this may be a useful
approach.
Andrzej Kozlowski
On Sunday, August 11, 2002, at 06:04 AM, DrBob wrote:
> 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
> Sent: Friday, August 09, 2002 4:18 AM
> Subject: [mg36002] [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 )
>>
>>
>>
>>
>>
>>
>>
>
>
>
>
>
Andrzej Kozlowski
Toyama International University
JAPAN
http://platon.c.u-tokyo.ac.jp/andrzej/