FindRoot for an oscillating function

[Narasimham G.L.]

How to find all real/complex roots by sweeping through the domain
{x,0,25} using Mathematica capability? p = 1.234; q = .7654; gr = Sin[p x]/p
+ Sin[q x]/q ; Plot[gr,{x, 0, 25}]; FindRoot[gr == 0, {x, 0, 25}]

[Bobby R. Treat]

Here's an approach that takes advantage of the Plot itself. It finds
consecutive data points that bracket roots, averages the x-values,
uses those as guesses in FindRoot, and finally graphs the original
function with roots superimposed. It will only find roots internal to
the plotted interval, so I reduced the lower limit to get the root at
zero.

Needs["Graphics`"]

p = 1.234;
q = .7654;

gr[x_] = Sin[p x]/p + Sin[q x]/q;
plot = Plot[gr@x, {x, -1, 25}, DisplayFunction -> Identity];
points = First@Cases[plot, Line[a_] -> a, Infinity];
guesses = Mean /@ Extract[Partition[points[[All, 1]], 2, 1],
Position[Partition[points[[All, -1]], 2,
1], _?(Times @@ # <= 0 &), {1}]]
roots = x /. FindRoot[gr@x, {x, #}] & /@ guesses
rootPts = {#, gr@#} & /@ roots
DisplayTogether[plot, Graphics@{PointSize[0.02],
Red, Point /@ rootPts}, DisplayFunction -> $DisplayFunction];

Bobby

math...@hotmail.com (Narasimham G.L.) wrote in message news:<cj86qq$78r$1...@smc.vnet.net>...

[Bill Rowe]

On 9/27/04 at 12:42 AM, math...@hotmail.com (Narasimham G.L.)
wrote:

>How to find all real/complex roots by sweeping through the domain
>{x,0,25} using Mathematica capability? p = 1.234; q = .7654; gr =
>Sin[p x]/p + Sin[q x]/q ; Plot[gr,{x, 0, 25}]; FindRoot[gr == 0,
>{x, 0, 25}]

Try the package RootSearch written by Ted Ersek available on the Wolfram web site

<< "Enhancements`RootSearch`"
RootSearch[gr == 0, {x, 0, 25}]

{{x -> 0.},
{x -> 3.375240761520732},
{x -> 9.064643612216745},
{x -> 12.52070474282438},
{x -> 15.863528460444453},
{x -> 21.318232880791662}}
--
To reply via email subtract one hundred and four

[Paul Abbott]

In article <cjat26$nsu$1...@smc.vnet.net>,

dr...@bigfoot.com (Bobby R. Treat) wrote:

> Here's an approach that takes advantage of the Plot itself. It finds
> consecutive data points that bracket roots, averages the x-values,
> uses those as guesses in FindRoot, and finally graphs the original
> function with roots superimposed. It will only find roots internal to
> the plotted interval, so I reduced the lower limit to get the root at
> zero.
>
> Needs["Graphics`"]
> p = 1.234;
> q = .7654;
> gr[x_] = Sin[p x]/p + Sin[q x]/q;
> plot = Plot[gr@x, {x, -1, 25}, DisplayFunction -> Identity];
> points = First@Cases[plot, Line[a_] -> a, Infinity];
> guesses = Mean /@ Extract[Partition[points[[All, 1]], 2, 1],
> Position[Partition[points[[All, -1]], 2,
> 1], _?(Times @@ # <= 0 &), {1}]]
> roots = x /. FindRoot[gr@x, {x, #}] & /@ guesses
> rootPts = {#, gr@#} & /@ roots
> DisplayTogether[plot, Graphics@{PointSize[0.02],
> Red, Point /@ rootPts}, DisplayFunction -> $DisplayFunction];

This is similar to the RootsInRange function that appeared in "Finding
Roots in an Interval" in The Mathematica Journal 7(2), 1998. The code
there has also appear on this group:

Needs["Utilities`FilterOptions`"]

RootsInRange[d_, {l_, lmin_, lmax_}, opts___] :=
Module[{s, p, x, f = Function[l, Evaluate[d]]},
s = Plot[f[l], {l, lmin, lmax}, Compiled -> False,
Evaluate[FilterOptions[Plot, opts]]];
p = Cases[s, Line[{x__}] -> x, Infinity];
p = Map[First, Select[Split[p, Sign[Last[#2]] == -Sign[Last[#1]] & ],
Length[#1] == 2 & ], {2}];
Apply[FindRoot[f[l] == 0, {l, ##1},
Evaluate[FilterOptions[FindRoot, opts]]] &, p, {1}]
]

Cheers,
Paul

--
Paul Abbott Phone: +61 8 6488 2734
School of Physics, M013 Fax: +61 8 6488 1014
The University of Western Australia (CRICOS Provider No 00126G)
35 Stirling Highway
Crawley WA 6009 mailto:pa...@physics.uwa.edu.au
AUSTRALIA http://physics.uwa.edu.au/~paul