Search All of the Math Forum:

Views expressed in these public forums are not endorsed by NCTM or The Math Forum.

Topic: InterpolatingFunction
Replies: 1   Last Post: Oct 14, 1996 2:19 AM

 Messages: [ Previous | Next ]
 Harald Berndt Posts: 24 Registered: 12/7/04
Re: InterpolatingFunction
Posted: Oct 14, 1996 2:19 AM

Andr=E9 Hautot wrote:
> =

> Who can help me? I am studying mathematica and I ask the following
> question. Suppose I wish to study the function y[t] defined by the
> oversimplified differential equation
> =

> sol:=3DNDSolve[{y''[t]+y[t]=3D=3D0,y[0]=3D=3D1,y'[0]=3D=3D1},y,{t,0,20}=
,
> MaxSteps->2000]
> =

> How can I find ALL the roots of y[t]=3D0 in the range {t,0,20}?
> I have tried a lot of things but they don't work. Mathematica user's
> guide does not help me very much.
> This kind of question arises when trying to draw Poincare sections of
> chaotic motions in dynamics.
> Since I am not yet registered in a mathematica group, please reply to
> Thank you in advance, AH.

Well, it would be nice if there was an "automatic" way. I know of none.
Using intuition and observation, though, one can arrive at a complete
solution. I'd like to seee other suggestions, but for now, here's mine:

(1) Why use NDSolve in this case? It's so much slower than simply

In[11]:=3D
DSolve[{y''[t]+y[t]=3D=3D0,y[0]=3D=3D1,y'[0]=3D=3D1}, y[t], t]
Out[11]=3D
{{y[t] -> Cos[t] + Sin[t]}}
For referential simplicity, set =

In[12]:=3D
f2[t_] :=3D Evaluate[ y[t]/.First[Flatten[%]] ]

(2) Look at the picture of the graph. There's only a small number of
zeroes in the interval of interest, so one can get a list of estimates
of their location by roughly sampling the interval and looking for
sign-changes:

In[29]:=3D
t1 =3D Table[ {i, f2[i]}, {i, 0, 20, 0.5} ];
In[37]:=3D
zcL =3D (Sign[First[#]] Sign[Last[#]])& /@ Partition[
Last[Transpose[t1]], 2, 1];
In[41]:=3D
pL =3D Flatten[Position[zcL, -1]]
Out[41]=3D
{5, 11, 18, 24, 30, 37}

pL is the list of the positions of sign changes in the sample list t1.
Now find the t-coordinates of the points _just before_ the sign changes.
Those will be the starting estimates for FindRoot[].

In[42]:=3D
svL =3D First[Transpose[t1]][[#]]& /@ pL
Out[42]=3D
{2., 5., 8.5, 11.5, 14.5, 18.}

(3) Apply FindRoot[] to all initial guesses:

In[45]:=3D
FindRoot[ f2[t] =3D=3D 0, {t, #} ]& /@ svL
Out[45]=3D
{{t -> 2.35619}, {t -> 5.49779}, {t -> 8.63938}, {t -> 11.781}, =

{t -> 14.9226}, {t -> 18.0642}}
In[46]:=3D
zeroes =3D (t/.#& /@ Flatten[%])
Out[46]=3D
{2.35619, 5.49779, 8.63938, 11.781, 14.9226, 18.0642}

If one is concerned about duplicate roots, one can run Union[zeroes].

Check the results with f2[#]& /@ zeroes//Chop (nned to chop!) or

Plot[ f2[t], {t, 0, 20}, Epilog -> {
GrayLevel[0.5], PointSize[0.02], Point[{#,0}]& /@ zeroes
}
];

This is a bit of a roundabout approach, so let's see who can do it more
elegantly ...

-- =

______________________________________________________________________
Harald Berndt, Ph.D. Research Specialist,
=

Consultant =

Phone: 510-652-5974 FAX: 510-215-4299
______________________________________________________________________
"I am what I am".................................. .Popeye the Sailor

(KRYTEN:.............Are you sure? I always thought it was Descartes!)
(LISTER:.So did I, man! It's so easy to get those two dudes mixed up!)

Date Subject Author
10/7/96 N Kinoshita
10/14/96 Harald Berndt