Reactogon/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