]> Git — Sourcephile - tmp/julm/arpeggigon.git/blob - RCMA/Unknown/AvgInt.hs
Translation from high to low level progressing. Should be finished soon.
[tmp/julm/arpeggigon.git] / RCMA / Unknown / AvgInt.hs
1 {-# LANGUAGE Arrows #-}
2
3 module AvgInt ( avgInt
4 ) where
5
6 import FRP.Yampa
7
8 intNum :: Int
9 intNum = 3
10
11 maxTime :: DTime
12 maxTime = 10
13
14 infinity :: (Fractional a) => a
15 infinity = 1/0
16
17 -- Outputs the average time between intNum of the last events. Goes to
18 -- infinity if less than intNum events have occured or if no event has
19 -- occured in maxTime.
20 avgInt :: SF (Event a) DTime
21 avgInt = avgInt' [] `switch` ((>>^ fst) . avgInt')
22 where avgInt' :: [DTime] -> SF (Event a) (DTime, Event [DTime])
23 avgInt' l = proc e -> do
24 t <- localTime -< ()
25 tooLate <- after maxTime [] -< ()
26 let timeList = (e `tag` (appDTime intNum t l)) `lMerge` tooLate
27 returnA -< (avgS intNum l, timeList)
28
29 appDTime :: Int -> Time -> [DTime] -> [DTime]
30 appDTime _ _ [] = [0]
31 appDTime n t l = (t - head l):(take (n-1) l)
32
33 avgS :: (Fractional a) => Int -> [a] -> a
34 avgS n l
35 | length l /= n = infinity
36 | otherwise = foldl (+) 0 l / fromIntegral n