Impulsy z dławiącym reaktywnym bananem

Question

Chciałbym wprowadzić pewien rodzaj dławienia wydarzeń w reaktywnym bananie. Powinien działać tak, aby zdarzenie nie zostało przepuszczone, jeśli dotrze do mniej niż sekund opóźnienia od ostatniego zdarzenia, które przeszło. Jeśli nie jest przepuszczony, to jest przechowywany i jest uruchamiany po delcie sekund od ostatniego wystrzelonego zdarzenia.

Poniżej znajduje się program, który implementuje to w przypadku list numerów oznaczonych stemplem czasu. Czy można to przetłumaczyć na reaktywny banan?

Ponadto, w przypadku bananów reaktywnych, w jaki sposób mogę wystrzelić wydarzenie w ciągu x sekund po jakimś innym wydarzeniu?

 
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, udało mi się zaimplementować to, co opisałem w moim pytaniu. Nie jestem tak szczęśliwy, że IO jest potrzebne do kontrolowania timera poprzez reakcję. Zastanawiam się, czy byłoby możliwe otwarcie przepustnicy z sygnalizacją przepustnicy :: Event ta -> Int -> Event ta ...

ps: Jestem nowicjuszem w Haskell, więc kod mógł być o wiele bardziej zwarty lub elegancki.

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

------------------------------------------------------------------------------} 
{-# 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

Jeśli chodzi o reaktywne-banan-0.6, zdecydowanie możliwe jest zaimplementowanie pożądanej funkcjonalności, ale jest to trochę zaangażowane.

Zasadniczo, masz do dyspozycji zewnętrzny framework, taki jak wxHaskell, do utworzenia licznika czasu, który możesz następnie wykorzystać do planowania zdarzeń. Przykład Wave.hs pokazuje, jak to zrobić.

W tej chwili zdecydowałem się nie uwzględniać pojęcia czasu w samej bibliotece banków reaktywnych. Powodem jest to, że różne zewnętrzne ramy mają zegary o różnej rozdzielczości lub jakości, nie ma jednego rozmiaru, który pasowałby do wszystkich.

Zamierzam dodać do biblioteki wspólne funkcje pomocnicze, które dotyczą czasu i liczników czasu, ale nadal potrzebuję znaleźć dobry sposób, aby uczynić go ogólnym na różne zegary i ustalić, jakie gwarancje mogę zapewnić.