[Haskell-cafe] Help to create a function to calculate a n element
moving average ??
S. Doaitse Swierstra
doaitse at swierstra.net
Wed Sep 29 16:44:53 EDT 2010
On 29 sep 2010, at 00:58, ok at cs.otago.ac.nz wrote:
>> Avoiding repeated additions:
>>
>> movingAverage :: Int -> [Float] -> [Float]
>> movingAverage n l = runSums (sum . take n $l) l (drop n l)
>> where n' = fromIntegral n
>> runSums sum (h:hs) (t:ts) = sum / n' : runSums (sum-h+t) hs ts
>> runSums _ _ [] = []
>>
>> Doaitse
>
> I very very carefully avoided doing any such thing in my example code.
> For each output result, my code does two additions and one division.
> Yours does one addition, one subtraction, and one division, for the
> required case n = 3. The way I formulated it, each calculation is
> independent. The way you've formulated it, the error in one
> calculation accumulates into the next. NOT a good idea.
If this an issue then:
module MovingAverage where
movingAverage :: [Float] -> [Float]
movingAverage (x:y:l) = movingAverage' x y l
where movingAverage' x y (z:zs) = (x+y+z)/3:movingAverage' y z zs
movingAverage' _ _ _ = []
movingAverage _ = []
has far fewer pattern matches,
Doaitse
>
>
More information about the Haskell-Cafe
mailing list