reactive-banana throttling events

Question

I would like to implement a certain type of throttling of events in reactive-banana. It should work such that an event is not let through if arrives at less then delta seconds from the last event that passed through. If it is not let through then it is stored and is fired after delta seconds from the last fired event.

Below is a program that implements this for lists of time stamped numbers. Would it be possible to translate this to reactive-banana ?

Also, in reactive-banana how do I fire an event x seconds after some other event comes in ?

module Main where

import Data.List

-- 1 second throtling
-- logic is to never output a value before 1 second has passed since last value was outputed.

main :: IO()
main = print $ test [ (0.0, 1.0), (1.1, 2.0), (1.5,3.0), (1.7,4.0),  (2.2, 5.0)  ]
--should output  [ (0.0, 1.0), (1.1, 2.0), (2.1,4.0), (3.1, 5.0) ]

test :: [(Double,Double)] -> [(Double,Double)]
test list = g v (concat xs)
       where
               (v, xs) = mapAccumL f (-50,Nothing) list
               g (t, Just x) ys = ys ++ [ (t+1,x) ]
               g _ ys  = ys
               f (lasttime, Just holdvalue) (t,x) = if t > (lasttime+1) then
                               if t > (lasttime + 2) then
                                       ( (t, Nothing), [ (lasttime+1,holdvalue), (t,x)] )
                               else ( (lasttime+1, Just x) , [ (lasttime+1,holdvalue) ] )
                       else        
                               ( (lasttime, Just x), [] )
               f (lasttime, Nothing) (t,x) = if t > (lasttime+1) then
                        ( (t,Nothing) , [ (t, x ) ] ) 
                        else ( (lasttime, Just x), [] )

Answer 1

Ok, I managed to implement what I described in my question. I'm not so happy that IO is needed to control the timer via reactimate. I wonder if it would be possible to have a throttle with signature throttle::Event t a -> Int -> Event t a ...

ps: I'm very novice in Haskell so the code could probably a lot more compact or elegant.

{-----------------------------------------------------------------------------

------------------------------------------------------------------------------}
{-# LANGUAGE ScopedTypeVariables #-} -- allows "forall t. NetworkDescription t"

import Graphics.UI.WX hiding (Event)
import Reactive.Banana
import Reactive.Banana.WX
import Data.Time

{-----------------------------------------------------------------------------
    Main
------------------------------------------------------------------------------}

data ThrottledValue a = FireStoredValue a | FireNowAndStartTimer a| HoldIt a | Stopped deriving Show
data ThrottledEvent a = TimerEvent | RealEvent a deriving Show

main = start $ do
    f   <- frame [text := "Countercesss"]
    sl1  <- hslider f False 0 100 []
    sl2  <- hslider f False 0 100 []
    set f [ layout := column 0 [widget sl1, widget sl2] ]
    t <- timer f []
    set t [ enabled := False ] 
    let networkDescription :: forall t. NetworkDescription t ()
        networkDescription = do
        slEv <- event0 sl1 command
        tick <- event0 t command 
        slB <- behavior sl1 selection
        let (throttledEv, reactimates) = throttle (slB <@ slEv) tick t 100
        reactimates
        reactimate $ fmap (\x ->  set sl2 [selection := x]) throttledEv       
    net <- compile networkDescription
    actuate net            

throttle::Event t a -> Event t () -> Timer -> Int -> (Event t a, NetworkDescription t () )    
throttle ev tick timer dt = (throttledEv, reactimates)
        where   
                all = union (fmap (\x-> RealEvent x) ev) (fmap (\x -> TimerEvent) tick)
                result = accumE Stopped $ fmap h all
                        where
                        h (RealEvent x) Stopped = FireNowAndStartTimer x
                        h TimerEvent Stopped = Stopped
                        h (RealEvent x) (FireNowAndStartTimer _) = HoldIt x
                        h TimerEvent (FireNowAndStartTimer _) = Stopped
                        h (RealEvent x) (HoldIt _) = HoldIt x
                        h (TimerEvent) (HoldIt y) = FireStoredValue y
                        h (RealEvent x) (FireStoredValue _) = HoldIt x
                        h (TimerEvent) (FireStoredValue _) = Stopped          
                start (FireStoredValue a) = Just $ resetTimer timer dt
                start (FireNowAndStartTimer a) = Just $ resetTimer timer dt
                start _ = Nothing  
                stop Stopped = Just $ stopTimer timer
                stop _ = Nothing  
                reactimates = do
                        reactimate $ filterJust $ fmap stop result   
                        reactimate $ filterJust $ fmap start result
                filterFired (FireStoredValue a) = Just a
                filterFired (FireNowAndStartTimer a) = Just a
                filterFired _ = Nothing
                throttledEv = filterJust $ fmap filterFired result                 

startTimer t dt = set t [ enabled := True, interval := dt ]
stopTimer t = set t [ enabled := False ]
resetTimer t dt = stopTimer t >> startTimer t dt

Answer 2

As of reactive-banana-0.6, it is definitely possible to implement the functionality you desire, but it is a little involved.

Basically, you have use an external framework like wxHaskell to create a timer, which you can then use to schedule events. The Wave.hs example demonstrates how to do that.

At the moment, I have opted to not include a notion of time in the reactive-banana library itself. The reason is simply that different external framework have timers of different resolution or quality, there is no one-size that fits it all.

I do intend to add common helper functions that deal with time and timers to the library itself, but I still need to find a good way to make it generic over different timers and figure out which guarantees I can provide.