Iterated Moving Average
Wolfram - 236

Pretty clunky right now, but at least it works.

f[x_,w_,c_]:=Module[{l=Length,d=Sqrt@CentralMoment[#,2]&amp;,n,a,b,t,r},n=Length@x;a=Normalize/@LowerTriangularize@Array[Boole[Abs[#1-#2]&lt;w]&amp;,{n,n}]^2;{b,t,r}=If[d@x&gt;c,{a,d@#&gt;c&amp;,l@#-1&amp;},{Inverse@a,d@#&lt;c&amp;,-l@#+2&amp;}];r@NestWhileList[b.#&amp;,x,t]]