Re: Moving average / smoothing data
- To: mathgroup at smc.vnet.net
- Subject: [mg64065] Re: [mg64063] Moving average / smoothing data
- From: Daniel Lichtblau <danl at wolfram.com>
- Date: Tue, 31 Jan 2006 01:14:11 -0500 (EST)
- References: <200601300410.XAA29456@smc.vnet.net>
- Sender: owner-wri-mathgroup at wolfram.com
Lea Rebanks wrote:
> Hi All,
>
> Given the following function & subsequent plot.
>
> tt={1.5*Sin[x]+0.5*Sin[20*x],1.5*Sin[x]};
> pp=Plot[Evaluate[tt],{x,0,20}];
>
>
> I am trying to get the best smoothing / moving average function closest
> to the underlying 1.5*sin[x]
>
> Has anyone got any suggestions? Please show coding in reply so I can
> plot & see result.
>
> I have similar noise on exponential data, so hopefully
> the moving average you recommend will work on that too.
>
> Many thanks for your attention.
>
> Lea Rebanks...
>
> PS I am using version 5.1
>
Could try convolution or other means to take moving averages of a list
of values.
tt2 = Table[tt[[1]], {x, 0., 20., 1/256}];
smoother[n_] := Table[1,{n}]/n
tt3 = ListConvolve[smoother[159], tt2];
Now check
ListPlot[tt3]
You can use these to fit to a sinusoid. For this I'd recommend forming a
sum of squares and minimizing with DifferentialEvolution because local
methods often have trouble with oscillating functions.
diffs = Apply[Plus,
Table[(tt3[[j + 1]] - a*Sin[b*j/256])^2, {j, 0, Length[tt3] - 1}]];
In[107]:=
{min,params}=
NMinimize[{diffs,0<=a<=2,0<=b<=5},{a,b},
Method->DifferentialEvolution,MaxIterations->200]
Out[107]=
{127.851,{a->1.46755,b->1.02333}}
Can visually check result via
Plot[a*Sin[b*x] /. params, {x, 0, 20}]
I'm sure there are more sophisticated approaches but this one is simple
enough and does not actually require periodicity, hence should be
applicable to nonoscillatory data.
Daniel Lichtblau
Wolfram Research
- References:
- Moving average / smoothing data
- From: "Lea Rebanks" <lrebanks@netvigator.com>
- Moving average / smoothing data