Services & Resources / Wolfram Forums
-----
 /
MathGroup Archive
2004
*January
*February
*March
*April
*May
*June
*July
*August
*September
*October
*November
*December
*Archive Index
*Ask about this page
*Print this page
*Give us feedback
*Sign up for the Wolfram Insider

MathGroup Archive 2004

[Date Index] [Thread Index] [Author Index]

Search the Archive

Re: FindRoot for an oscillating function

  • To: mathgroup at smc.vnet.net
  • Subject: [mg50961] Re: FindRoot for an oscillating function
  • From: Paul Abbott <paul at physics.uwa.edu.au>
  • Date: Wed, 29 Sep 2004 07:09:26 -0400 (EDT)
  • Organization: The University of Western Australia
  • References: <cj86qq$78r$1@smc.vnet.net> <cjat26$nsu$1@smc.vnet.net>
  • Sender: owner-wri-mathgroup at wolfram.com

In article <cjat26$nsu$1 at smc.vnet.net>,
 drbob at 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 at {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:paul at physics.uwa.edu.au 
AUSTRALIA                            http://physics.uwa.edu.au/~paul


  • Prev by Date: Re: wavelet transform
  • Next by Date: File Menu, 5 last notebooks
  • Previous by thread: Re: FindRoot for an oscillating function
  • Next by thread: Polynomial functions and equations discovered