Re: damped oscilations data fit
- To: mathgroup at smc.vnet.net
- Subject: [mg70581] Re: damped oscilations data fit
- From: "Ray Koopman" <koopman at sfu.ca>
- Date: Fri, 20 Oct 2006 05:21:47 -0400 (EDT)
- References: <eh4ntl$7sb$1@smc.vnet.net><eh7aqc$e8r$1@smc.vnet.net>
I forgot, in both what I did and what I posted, something that belongs
in step 2: along with pic[c,d], use ContourPlot[-f[c,d],{c,cmin,cmax},
{d,dmin,dmax}] to find approximately optimal values of c & d. (I like
working with -f rather than f, but that's a purely personal thing.)
Ray Koopman wrote:
> Miroslav Hý?a wrote:
>> hello,
>> I have one question about data manipulation in mathematica.
>> I've got set of experimental data. Data describe damped oscillation. My question is following:
>>
>> How can I fit these data?
>> I would like to get formula of function which will approximately describe my data and plot this function.
>>
>> my data list:
>> {{0, 54}, {120, 56.5}, {230, 56}, {305, 54}, {340, 53}, {360, 52.7}, {378, 52.5}, {405, 52.5}, {443, 53}, {480, 53.5}, {510, 54}, {540, 54.7}, {570, 54.4}, {602, 56}, {643,56.5}, {660, 56.5}, {685, 56.25}, {706, 56}, {727, 55.25}, {743, 55.5}, {756, 55.25}, {775, 55}, {787, 54.75}, {799, 54.5}, {814, 54.25}, {828, 54}, {845, 53.75}, {858, 53.5}, {877, 53.25}, {894, 53}, {923, 52}, {951, 53}, {983, 53.5}, {1014, 54}}
>>
>> Have anyone an idea?
>> I'm mathematica beginner therefore I'll be grateful for any suggestion.
>> Thanks
>> <<mira
>
> Steps to an answer:
>
> 1. ListPlot the data, then guess at the form of the function:
> y = a + b*Sin[t/c]*Exp[-t/d]
>
> 2. Repeatedly use pic[c,d] with trial values of c & d,
> until the fit looks good.
>
> pic[c_,d_] := Block[{x,y, mx,my, a,b},
> {x,y} = Transpose@data; x = N[Sin[x/c]*Exp[-x/d]];
> mx = Mean@x; my = Mean@y; x -= mx; y -= my;
> b = y.x/x.x; a = my - b*mx;
> Plot[a+b*Sin[t/c]*Exp[-t/d], {t,0,1014}, PlotRange->{51.5,57},
> Frame->True, Axes->None, Prolog->{PointSize[.015],Point/@data}];
> {a, b, c, d, Sqrt[#.#&[y-b*x]/(Length@data-4)]}]
>
> 3. Use NMinimize to polish the fit by minimizing f[c,d].
>
> f[c_?NumericQ, d_?NumericQ] := Block[{x,y,b},
> {x,y} = Transpose@data; x = N[Sin[x/c]*Exp[-x/d]];
> x -= Mean@x; y -= Mean@y; b = y.x/x.x; #.#&[y-b*x]]
>
> NMinimize[f[c,d],{{c,84,85},{d,2910,2920}}]
> {Sqrt[%[[1]]/(Length@data-4)], Block[{x,y, mx,my, b},
> {x,y} = Transpose@data; x = N[Sin[x/c/.%[[2]]]*Exp[-x/d/.%[[2]]]];
> mx = Mean@x; my = Mean@y; x -= mx; y -= my; b = y.x/x.x;
> {my - b*mx, b}]}
>
> {3.20787, {c -> 84.6961, d -> 2917.55}}
> {0.327, {54.4977, 2.22006}}