]> Git — Sourcephile - tmp/julm/arpeggigon.git/blob - RCMA/Unknown/AvgIvl.hs
Runs normally but problem with boardSF due to "overswitching".
[tmp/julm/arpeggigon.git] / RCMA / Unknown / AvgIvl.hs
1 {-# LANGUAGE Arrows #-}
2
3 module AvgIvl ( avgIvl
4 ) where
5
6 import FRP.Yampa
7
8 import Debug.Trace
9
10 ivlNum :: Int
11 ivlNum = 3
12
13 maxTime :: DTime
14 maxTime = 5
15
16 infinity :: (Fractional a) => a
17 infinity = 1/0
18
19 -- Outputs the average time between ivlNum of the last events. Goes to
20 -- infinity if less than ivlNum events have occured or if no event has
21 -- occured in maxTime.
22 avgIvl :: SF (Event a) DTime
23 avgIvl = switch (constant infinity &&& constant (Event [])) avgIvl'
24 where
25 avgIvl' l = switch avgIvl'' (avgIvl')
26 where avgIvl'' :: SF (Event a) (DTime, Event [DTime])
27 avgIvl'' = proc e -> do
28 e' <- notYet -< e
29 t <- localTime -< ()
30 tooLate <- after maxTime [] -< ()
31 let timeList = (e' `tag` (appDTime ivlNum t l)) `lMerge` tooLate
32 returnA -< (avgS ivlNum l, timeList)
33
34 appDTime :: Int -> Time -> [DTime] -> [DTime]
35 appDTime _ _ [] = [0]
36 appDTime n t l = t:(take (n-1) l)
37
38 avgS :: (Fractional a) => Int -> [a] -> a
39 avgS n l
40 | length l /= n = infinity
41 | otherwise = foldl (+) 0 l / fromIntegral n