       Re: envelope of an oscillatory InterpolatingFunction

• To: mathgroup at smc.vnet.net
• Subject: [mg49832] Re: envelope of an oscillatory InterpolatingFunction
• From: Paul Abbott <paul at physics.uwa.edu.au>
• Date: Tue, 3 Aug 2004 01:11:04 -0400 (EDT)
• Organization: The University of Western Australia
• Sender: owner-wri-mathgroup at wolfram.com

```Hi Stergios:

>Thanks very much! Your RootsInRange is much better than my loop
>RootsInRange returns results of the form (where t is my
>variable):
>
>{t\$9472 -> 3.3268729370875564`*^-7}

Actually, I broke the code by changing the variables (to avoid posting
code with Greek symbols). I've appended the correct code below.

Also note that Ted Ersek's package at

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

is more robust that RootsInRange for finding all the roots of a function.

Cheers,
Paul

Notebook[{

Cell[CellGroupData[{
Cell["Envelope", "Section"],

Cell[TextData[{
"Why not compute the values of the extrema of the ",
Cell[BoxData[
FormBox[
StyleBox["InterpolatingFunction",
" and then use ",
Cell[BoxData[
FormBox[
StyleBox["FindFit",
" to determine the envelope? For example,"
}], "Text"],

Cell[BoxData[
RowBox[{"nsol", "=",
RowBox[{"First", "[",
RowBox[{"NDSolve", "[",
RowBox[{
RowBox[{"{",
RowBox[{
RowBox[{
RowBox[{\(5\ y[x]\), "+",
RowBox[{
SuperscriptBox["y", "\[Prime]",
MultilineFunction->None], "[", "x", "]"}], "+",
RowBox[{"10", " ",
RowBox[{
SuperscriptBox["y", "\[Prime]\[Prime]",
MultilineFunction->None], "[", "x", "]"}]}]}],
"\[Equal]", "0"}], ",", \(y \[Equal] 1\), ",",
RowBox[{
RowBox[{
SuperscriptBox["y", "\[Prime]",
MultilineFunction->None], "[", "0", "]"}],
"\[Equal]",
"0"}]}], "}"}], ",", "y", ",", \({x, 0, 50}\)}],
"]"}],
"]"}]}]], "Input"],

Cell[BoxData[
\(Plot[Evaluate[y[x] /. \[InvisibleSpace]nsol], {x, 0, 50},
PlotRange \[Rule] All]\)], "Input"],

Cell[TextData[{
"Compute the (absolute) values of the extrema of the ",
Cell[BoxData[
FormBox[
StyleBox["InterpolatingFunction",
":"
}], "Text"],

Cell[BoxData[
RowBox[{
RowBox[{\({x, Abs[y[x]]}\), "/.", "\[InvisibleSpace]",
RowBox[{"RootsInRange", "[",
RowBox[{
RowBox[{"Evaluate", "[",
RowBox[{
RowBox[{
SuperscriptBox["y", "\[Prime]",
MultilineFunction->None], "[", "x", "]"}], "/.",
"\[InvisibleSpace]", "nsol"}], "]"}], ",", \({x, 0,
50}\)}],
"]"}]}], "/.", "\[InvisibleSpace]", "nsol"}]], "Input"],

Cell["\<\
and then fit to find the envelope (here assuming exponential form):\
\
\>", "Text"],

Cell[BoxData[
\(FindFit[%, c + a\/\[ExponentialE]\^\(b\ x\), {a, b, c}, x]\)],
"Input"],

Cell[CellGroupData[{

Cell["Roots in Range", "Subsubsection"],

Cell["\<\
Here is some code for finding the roots of a function over a \
specified range:\
\>", "Text"],

Cell[BoxData[
\(Needs["\<Utilities`FilterOptions`\>"]\)], "Input",
InitializationCell->True],

Cell[BoxData[
\(RootsInRange[\[Delta]_, {\[Lambda]_, \[Lambda]min_,
\[Lambda]max_},
opts___] :=
Module[{p, pts, x, f = Function[\[Lambda], Evaluate[\[Delta]]]},
p = Plot[f[\[Lambda]], {\[Lambda], \[Lambda]min, \[Lambda]max},
Compiled \[Rule] False, Evaluate[FilterOptions[Plot,
opts]]];
pts = Cases[First[p], Line[{x__}] \[Rule] x, \[Infinity]];
pts = Map[First,
Select[Split[pts, Sign[Last[#2]] \[Equal]
\(-Sign[Last[#1]]\) &],
Length[#1] \[Equal] 2 &], {2}]; \((FindRoot[
f[\[Lambda]] \[Equal] 0, {\[Lambda], Sequence @@ ##1},
Evaluate[FilterOptions[FindRoot, opts]]] &)\) /@
pts]\)], "Input",
InitializationCell->True],

Cell[BoxData[
\(RootsInRange::"\<usage\>" = "\<RootsInRange[f,{x,xmin,xmax}]
generates \
a plot of f as a function of x from xmin to xmax and then uses FindRoot
to \
determine the roots of f in the range (xmin,xmax).\>"; \)], "Input",
InitializationCell->True]
}, Open  ]]
}, Open  ]]
},
FrontEndVersion->"5.0 for Macintosh",
ScreenRectangle->{{0, 1436}, {0, 878}},
AutoGeneratedPackage->None,
WindowSize->{861, 787},
WindowMargins->{{124, Automatic}, {Automatic, 24}}
]

--
Paul Abbott                                   Phone: +61 8 9380 2734
School of Physics, M013                         Fax: +61 8 9380 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: Re: PutAppend Command and Data Output
• Next by Date: Forcing Argument Evaluation
• Previous by thread: Re: envelope of an oscillatory InterpolatingFunction
• Next by thread: Re: DiscreteDelta Evaluation Question