yampa-test-0.14.12: tests/Test/FRP/Yampa/EventS.hs
{-# LANGUAGE Arrows #-}
{-# LANGUAGE CPP #-}
-- |
-- Description : Test cases for signal functions working with events
-- Copyright : (c) Antony Courtney and Henrik Nilsson, Yale University, 2003-2004
-- Authors : Antony Courtney, Henrik Nilsson
-- Notes pertaining to regression tests:
-- - Add test cases for Yampa. There should be at least one test case for each
-- "non-trivial" entity exported from Yampa.
--
-- - Make tests cases for after and repeatedly more robust. Must not
-- fail due to small discrepancies in floating point implementation.
--
-- 01-May-2002: evsrc_t7 currently fails in hugs.
module Test.FRP.Yampa.EventS
( tests
)
where
#if __GLASGOW_HASKELL__ < 710
import Control.Applicative ((<*>))
import Data.Functor ((<$>))
#endif
import Test.QuickCheck hiding (once, sample)
import Test.Tasty (TestTree, testGroup)
import Test.Tasty.QuickCheck (testProperty)
import FRP.Yampa as Yampa
import FRP.Yampa.Stream
import FRP.Yampa.QuickCheck
import FRP.Yampa.LTLFuture
import TestsCommon
tests :: TestTree
tests = testGroup "Regression tests for FRP.Yampa.EventS"
[ testProperty "never (0, fixed)" (property $ evsrc_t0 ~= evsrc_t0r)
, testProperty "Events > No event" prop_event_noevent
, testProperty "eventS (1, fixed)" (property $ evsrc_t1 ~= evsrc_t1r)
, testProperty "Events > Now" prop_event_now
, testProperty "eventS (2, fixed)" (property $ evsrc_t2 ~= evsrc_t2r)
, testProperty "Events > After 0.0" prop_event_after_0
, testProperty "eventS (3, fixed)" (property $ evsrc_t3 ~= evsrc_t3r)
, testProperty "eventS (4, fixed)" (property $ evsrc_t4 ~= evsrc_t4r)
, testProperty "eventS (5, fixed)" (property $ evsrc_t5 ~= evsrc_t5r)
, testProperty "eventS (6, fixed)" (property $ evsrc_t6 ~= evsrc_t6r)
, testProperty "eventS (7, fixed)" (property $ evsrc_t7 ~= evsrc_t7r)
, testProperty "eventS (8, fixed)" (property $ evsrc_t8 ~= evsrc_t8r)
, testProperty "eventS (9, fixed)" (property $ evsrc_t9 ~= evsrc_t9r)
, testProperty "eventS (10, fixed)" (property $ evsrc_t10 ~= evsrc_t10r)
, testProperty "eventS (11, fixed)" (property $ evsrc_t11 ~= evsrc_t11r)
, testProperty "eventS (28, fixed)" (property $ evsrc_t28 ~= evsrc_t28r)
, testProperty "delayEvent (0, fixed)" (property $ evsrc_t30 ~= evsrc_t30r)
, testProperty "delayEvent (1, qc)" propDelayEvent
, testProperty "delayEventCat (0, fixed)" (property $ evsrc_t29 ~= evsrc_t29r)
, testProperty "eventS (12, fixed)" (property $ evsrc_t12 ~= evsrc_t12r)
, testProperty "eventS (13, fixed)" (property $ evsrc_t13 ~= evsrc_t13r)
, testProperty "iEdge (0, qc)" propIEdge
, testProperty "edgeTag (0, qc)" propEdgeTag
, testProperty "edgeJust (0, qc)" propEdgeJust
, testProperty "eventS (14, fixed)" (property $ evsrc_t14 ~= evsrc_t14r)
, testProperty "eventS (15, fixed)" (property $ evsrc_t15 ~= evsrc_t15r)
, testProperty "eventS (16, fixed)" (property $ evsrc_t16 ~= evsrc_t16r)
, testProperty "notYet (0, qc)" propNotYet
, testProperty "eventS (17, fixed)" (property $ evsrc_t17 ~= evsrc_t17r)
, testProperty "eventS (18, fixed)" (property $ evsrc_t18 ~= evsrc_t18r)
, testProperty "eventS (19, fixed)" (property $ evsrc_t19 ~= evsrc_t19r)
, testProperty "eventS (20, fixed)" (property $ evsrc_t20 ~= evsrc_t20r)
, testProperty "eventS (21, fixed)" (property $ evsrc_t21 ~= evsrc_t21r)
, testProperty "eventS (22, fixed)" (property $ evsrc_t22 ~= evsrc_t22r)
, testProperty "eventS (23, fixed)" (property $ evsrc_t23 ~= evsrc_t23r)
, testProperty "eventS (24, fixed)" (property $ evsrc_t24 ~= evsrc_t24r)
, testProperty "eventS (25, fixed)" (property $ evsrc_t25 ~= evsrc_t25r)
, testProperty "eventS (26, fixed)" (property $ evsrc_t26 ~= evsrc_t26r)
, testProperty "eventS (27, fixed)" (property $ evsrc_t27 ~= evsrc_t27r)
, testProperty "snap (fixed)" (property $ utils_t10 ~= utils_t10r)
, testProperty "snapAfter (fixed)" (property $ utils_t11 ~= utils_t11r)
, testProperty "sample (fixed)" (property $ utils_t12 ~= utils_t12r)
, testProperty "sampleWindow (0, fixed)" (property $ utils_t15 ~= utils_t15r)
, testProperty "sampleWindow (1, fixed)" (property $ utils_t16 ~= utils_t16r)
, testProperty "after (0, fixed)" (property $ utils_t13 ~= utils_t13r)
, testProperty "after (1, fixed)" (property $ utils_t14 ~= utils_t14r)
]
-- * Basic event sources
evsrc_t0 :: [Event ()]
evsrc_t0 = testSF1 never
evsrc_t0r =
[ NoEvent, NoEvent, NoEvent, NoEvent -- 0.0 s
, NoEvent, NoEvent, NoEvent, NoEvent -- 1.0 s
, NoEvent, NoEvent, NoEvent, NoEvent -- 2.0 s
, NoEvent, NoEvent, NoEvent, NoEvent -- 3.0 s
, NoEvent, NoEvent, NoEvent, NoEvent -- 4.0 s
, NoEvent, NoEvent, NoEvent, NoEvent -- 5.0 s
, NoEvent
]
prop_event_noevent =
forAll myStream $ evalT $ Always $ prop (sfNever, const (== noEvent))
where
myStream :: Gen (SignalSampleStream Float)
myStream = uniDistStream
sfNever :: SF Float (Event Float)
sfNever = never
evsrc_t1 :: [Event Int]
evsrc_t1 = testSF1 (now 42)
evsrc_t1r :: [Event Int]
evsrc_t1r =
[ Event 42, NoEvent, NoEvent, NoEvent -- 0.0 s
, NoEvent, NoEvent, NoEvent, NoEvent -- 1.0 s
, NoEvent, NoEvent, NoEvent, NoEvent -- 2.0 s
, NoEvent, NoEvent, NoEvent, NoEvent -- 3.0 s
, NoEvent, NoEvent, NoEvent, NoEvent -- 4.0 s
, NoEvent, NoEvent, NoEvent, NoEvent -- 5.0 s
, NoEvent
]
prop_event_now =
forAll myStream $ evalT $
-- (sf, p0) /\ O [] (sf, pn)
And (prop (sf, p0)) -- Initially
(Next $ Always $ prop (sf, pn)) -- After first sample
where
sf = Yampa.now 42.0
p0 x y = y == Event 42.0
pn x y = y == noEvent
myStream :: Gen (SignalSampleStream Float)
myStream = uniDistStream
evsrc_t2 :: [Event Int]
evsrc_t2 = testSF1 (after 0.0 42)
evsrc_t2r :: [Event Int]
evsrc_t2r =
[ Event 42, NoEvent, NoEvent, NoEvent -- 0.0 s
, NoEvent, NoEvent, NoEvent, NoEvent -- 1.0 s
, NoEvent, NoEvent, NoEvent, NoEvent -- 2.0 s
, NoEvent, NoEvent, NoEvent, NoEvent -- 3.0 s
, NoEvent, NoEvent, NoEvent, NoEvent -- 4.0 s
, NoEvent, NoEvent, NoEvent, NoEvent -- 5.0 s
, NoEvent
]
prop_event_after_0 =
forAll myStream $ evalT $
-- (sf, p0) /\ O [] (sf, pn)
And (prop (sf, p0)) -- Initially
(Next $ Always $ prop (sf, pn)) -- After first sample
where
sf = after 0.0 42.0
p0 x y = y == Event 42.0
pn x y = y == noEvent
myStream :: Gen (SignalSampleStream Float)
myStream = uniDistStream
evsrc_t3 :: [Event Int]
evsrc_t3 = testSF1 (after 3.0 42)
evsrc_t3r :: [Event Int]
evsrc_t3r =
[ NoEvent, NoEvent, NoEvent, NoEvent -- 0.0 s
, NoEvent, NoEvent, NoEvent, NoEvent -- 1.0 s
, NoEvent, NoEvent, NoEvent, NoEvent -- 2.0 s
, Event 42, NoEvent, NoEvent, NoEvent -- 3.0 s
, NoEvent, NoEvent, NoEvent, NoEvent -- 4.0 s
, NoEvent, NoEvent, NoEvent, NoEvent -- 5.0 s
, NoEvent
]
evsrc_t4 :: [Event Int]
evsrc_t4 = testSF1 (after 3.01 42)
evsrc_t4r :: [Event Int]
evsrc_t4r =
[ NoEvent, NoEvent, NoEvent, NoEvent -- 0.0 s
, NoEvent, NoEvent, NoEvent, NoEvent -- 1.0 s
, NoEvent, NoEvent, NoEvent, NoEvent -- 2.0 s
, NoEvent, Event 42, NoEvent, NoEvent -- 3.0 s
, NoEvent, NoEvent, NoEvent, NoEvent -- 4.0 s
, NoEvent, NoEvent, NoEvent, NoEvent -- 5.0 s
, NoEvent
]
evsrc_t5 :: [Event Int]
evsrc_t5 = testSF1 (repeatedly 0.795 42)
evsrc_t5r :: [Event Int]
evsrc_t5r =
[ NoEvent, NoEvent, NoEvent, NoEvent -- 0.0 s
, Event 42, NoEvent, NoEvent, Event 42 -- 1.0 s
, NoEvent, NoEvent, Event 42, NoEvent -- 2.0 s
, NoEvent, Event 42, NoEvent, NoEvent -- 3.0 s
, Event 42, NoEvent, NoEvent, NoEvent -- 4.0 s
, Event 42, NoEvent, NoEvent, Event 42 -- 5.0 s
, NoEvent
]
evsrc_t6 :: [Event Int]
evsrc_t6 = testSF1 (repeatedly 0.29999 42)
evsrc_t6r :: [Event Int]
evsrc_t6r =
[ NoEvent, NoEvent, Event 42, Event 42 -- 0.0 s
, Event 42, Event 42, Event 42, NoEvent -- 1.0 s
, Event 42, Event 42, Event 42, Event 42 -- 2.0 s
, Event 42, NoEvent, Event 42, Event 42 -- 3.0 s
, Event 42, Event 42, Event 42, NoEvent -- 4.0 s
, Event 42, Event 42, Event 42, Event 42 -- 5.0 s
, Event 42
]
evsrc_t7 :: [Event Int]
evsrc_t7 = testSF1 (repeatedly 0.24 42)
evsrc_t7r :: [Event Int]
evsrc_t7r =
[ NoEvent, Event 42, Event 42, Event 42 -- 0.0 s
, Event 42, Event 42, Event 42, Event 42 -- 1.0 s
, Event 42, Event 42, Event 42, Event 42 -- 2.0 s
, Event 42, Event 42, Event 42, Event 42 -- 3.0 s
, Event 42, Event 42, Event 42, Event 42 -- 4.0 s
, Event 42, Event 42, Event 42, Event 42 -- 5.0 s
, Event 42
]
evsrc_t8 :: [Event Int]
evsrc_t8 = testSF1 (afterEach [ (0.00, 1), (0.00, 2), (0.01, 3), (0.23, 4)
, (0.02, 5), (0.75, 6), (0.10, 7), (0.10, 8)
, (0.10, 9), (2.00, 10)
]
)
evsrc_t8r :: [Event Int]
evsrc_t8r =
[ Event 1, Event 3, Event 5, NoEvent -- 0.0 s
, NoEvent, Event 6, Event 9, NoEvent -- 1.0 s
, NoEvent, NoEvent, NoEvent, NoEvent -- 2.0 s
, NoEvent, NoEvent, Event 10, NoEvent -- 3.0 s
, NoEvent, NoEvent, NoEvent, NoEvent -- 4.0 s
, NoEvent, NoEvent, NoEvent, NoEvent -- 5.0 s
, NoEvent
]
evsrc_t9 :: [Event Int]
evsrc_t9 = testSF1 (afterEach [ (2.03, 0)
, (0.00, 1), (0.00, 2), (0.01, 3), (0.23, 4)
, (0.02, 5), (0.75, 6), (0.10, 7), (0.10, 8)
, (0.10, 9), (2.00, 10), (0.00, 11), (0.00, 12)
]
)
evsrc_t9r :: [Event Int]
evsrc_t9r =
[ NoEvent, NoEvent, NoEvent, NoEvent -- 0.0 s
, NoEvent, NoEvent, NoEvent, NoEvent -- 1.0 s
, NoEvent, Event 0, Event 4, NoEvent -- 2.0 s
, NoEvent, Event 6, Event 9, NoEvent -- 3.0 s
, NoEvent, NoEvent, NoEvent, NoEvent -- 4.0 s
, NoEvent, NoEvent, Event 10, NoEvent -- 5.0 s
, NoEvent
]
evsrc_t10 :: [Event [Int]]
evsrc_t10 = testSF1 (afterEachCat [ (0.00, 1), (0.00, 2), (0.01, 3), (0.23, 4)
, (0.02, 5), (0.75, 6), (0.10, 7), (0.10, 8)
, (0.10, 9), (2.00, 10)
]
)
evsrc_t10r :: [Event [Int]]
evsrc_t10r =
[ Event [1,2], Event [3,4], Event [5], NoEvent -- 0.0 s
, NoEvent, Event [6,7,8], Event [9], NoEvent -- 1.0 s
, NoEvent, NoEvent, NoEvent, NoEvent -- 2.0 s
, NoEvent, NoEvent, Event [10], NoEvent -- 3.0 s
, NoEvent, NoEvent, NoEvent, NoEvent -- 4.0 s
, NoEvent, NoEvent, NoEvent, NoEvent -- 5.0 s
, NoEvent
]
evsrc_t11 :: [Event [Int]]
evsrc_t11 = testSF1 (afterEachCat [ (2.03, 0)
, (0.00, 1), (0.00, 2), (0.01, 3), (0.23, 4)
, (0.02, 5), (0.75, 6), (0.10, 7), (0.10, 8)
, (0.10, 9), (2.00, 10)
]
)
evsrc_t11r :: [Event [Int]]
evsrc_t11r =
[ NoEvent, NoEvent, NoEvent, NoEvent -- 0.0 s
, NoEvent, NoEvent, NoEvent, NoEvent -- 1.0 s
, NoEvent, Event [0,1,2,3], Event [4,5], NoEvent -- 2.0 s
, NoEvent, Event [6,7,8], Event [9], NoEvent -- 3.0 s
, NoEvent, NoEvent, NoEvent, NoEvent -- 4.0 s
, NoEvent, NoEvent, Event [10], NoEvent -- 5.0 s
, NoEvent
]
propDelayEvent :: Property
propDelayEvent =
forAll delayFactorG $ \delayFactor ->
forAll myStream $ evalT $
Always $ SP $ (==) <$> originalSF delayFactor
<*> sfModelDelayEvent delayFactor
where
-- SF under test
originalSF :: Int -> SF () (Event ())
originalSF factor =
time
>>> arr cos
>>> arr (< 0)
>>> edge
>>> delayEvent (fromIntegral factor * delay)
-- Model SF that applies the delay internally
sfModelDelayEvent :: Int -> SF () (Event ())
sfModelDelayEvent factor =
time
>>> arr (\x -> x - (fromIntegral factor * delay))
>>> arr cos
>>> arr (< 0)
>>> edge
-- Generator: Factor by which the signal is delayed
delayFactorG :: Gen Int
delayFactorG = getPositive <$> arbitrary
-- Generator: Random input stream. Delays and values are fixed but the
-- length is not.
myStream :: Gen (SignalSampleStream ())
myStream = fixedDelayStream delay
-- Constant: Max delay
delay :: DTime
delay = 0.01
evsrc_t28 :: [(Event Int, Event Int)]
evsrc_t28 = embed (repeatedly 0.5 ()
>>> accumBy (\n _ -> n + 1) 0
>>> identity &&& delayEvent 2.0)
(deltaEncode 0.125 (replicate 50 ()))
evsrc_t28r =
[ (NoEvent,NoEvent), (NoEvent,NoEvent) -- 0.0 s
, (NoEvent,NoEvent), (NoEvent,NoEvent)
, (Event 1,NoEvent), (NoEvent,NoEvent) -- 0.5 s
, (NoEvent,NoEvent), (NoEvent,NoEvent)
, (Event 2,NoEvent), (NoEvent,NoEvent) -- 1.0 s
, (NoEvent,NoEvent), (NoEvent,NoEvent)
, (Event 3,NoEvent), (NoEvent,NoEvent) -- 1.5 s
, (NoEvent,NoEvent), (NoEvent,NoEvent)
, (Event 4,NoEvent), (NoEvent,NoEvent) -- 2.0 s
, (NoEvent,NoEvent), (NoEvent,NoEvent)
, (Event 5,Event 1), (NoEvent,NoEvent) -- 2.5 s
, (NoEvent,NoEvent), (NoEvent,NoEvent)
, (Event 6,Event 2), (NoEvent,NoEvent) -- 3.0 s
, (NoEvent,NoEvent), (NoEvent,NoEvent)
, (Event 7,Event 3), (NoEvent,NoEvent) -- 3.5 s
, (NoEvent,NoEvent), (NoEvent,NoEvent)
, (Event 8,Event 4), (NoEvent,NoEvent) -- 4.0 s
, (NoEvent,NoEvent), (NoEvent,NoEvent)
, (Event 9,Event 5), (NoEvent,NoEvent) -- 4.5 s
, (NoEvent,NoEvent), (NoEvent,NoEvent)
, (Event 10,Event 6), (NoEvent,NoEvent) -- 5.0 s
, (NoEvent,NoEvent), (NoEvent,NoEvent)
, (Event 11,Event 7), (NoEvent,NoEvent) -- 5.5 s
, (NoEvent,NoEvent), (NoEvent,NoEvent)
, (Event 12,Event 8), (NoEvent,NoEvent) -- 6.0 s
]
-- "delayEvent" in a feedback loop. Should work like "repeatedly".
evsrc_t30 :: [(Event ())]
evsrc_t30 = embed (now ()
>>> (loop $
arr (uncurry lMerge)
>>> delayEvent 1.0
>>> arr dup))
(deltaEncode 0.125 (replicate 50 ()))
evsrc_t30r :: [(Event ())]
evsrc_t30r =
[ NoEvent, NoEvent, NoEvent, NoEvent -- 0.0 s
, NoEvent, NoEvent, NoEvent, NoEvent -- 0.5 s
, Event (), NoEvent, NoEvent, NoEvent -- 1.0 s
, NoEvent, NoEvent, NoEvent, NoEvent -- 1.5 s
, Event (), NoEvent, NoEvent, NoEvent -- 2.0 s
, NoEvent, NoEvent, NoEvent, NoEvent -- 2.5 s
, Event (), NoEvent, NoEvent, NoEvent -- 3.0 s
, NoEvent, NoEvent, NoEvent, NoEvent -- 3.5 s
, Event (), NoEvent, NoEvent, NoEvent -- 4.0 s
, NoEvent, NoEvent, NoEvent, NoEvent -- 4.5 s
, Event (), NoEvent, NoEvent, NoEvent -- 5.0 s
, NoEvent, NoEvent, NoEvent, NoEvent -- 5.5 s
, Event (), NoEvent -- 6.0 s
]
evsrc_t29 :: [Event [Double]]
evsrc_t29 = embed (time &&& repeatedly 0.5001 ()
>>> arr (\(t,e) -> e `tag` t)
>>> delayEventCat 3.0)
input
where
dts = replicate 40 0.1 ++ [2.0] ++ replicate 40 0.1
input = ((), [(dt, Just ()) | dt <- dts])
{- Resulting input to the delay for reference:
[ NoEvent, NoEvent, NoEvent, NoEvent, NoEvent -- 0.0 s
, NoEvent, Event 0.6, NoEvent, NoEvent, NoEvent -- 0.5 s
, NoEvent, Event 1.1, NoEvent, NoEvent, NoEvent -- 1.0 s
, NoEvent, Event 1.6, NoEvent, NoEvent, NoEvent -- 1.5 s
, NoEvent, Event 2.1, NoEvent, NoEvent, NoEvent -- 2.0 s
, NoEvent, Event 2.6, NoEvent, NoEvent, NoEvent -- 2.5 s
, NoEvent, Event 3.1, NoEvent, NoEvent, NoEvent -- 3.0 s
, NoEvent, Event 3.6, NoEvent, NoEvent, NoEvent -- 3.5 s
, NoEvent -- 4.0 s
, Event 6.0, Event 6.1, NoEvent, NoEvent, NoEvent -- 6.0 s
, NoEvent, Event 6.6, NoEvent, NoEvent, NoEvent -- 6.5 s
, NoEvent, Event 7.1, NoEvent, NoEvent, NoEvent -- 7.0 s
, NoEvent, Event 7.6, NoEvent, NoEvent, NoEvent -- 7.5 s
, NoEvent, Event 8.1, NoEvent, NoEvent, NoEvent -- 8.0 s
, NoEvent, Event 8.6, NoEvent, NoEvent, NoEvent -- 8.5 s
, NoEvent, Event 9.1, NoEvent, NoEvent, NoEvent -- 9.0 s
, NoEvent, Event 9.6, NoEvent, NoEvent, NoEvent -- 9.5 s
, NoEvent -- 10.0 s
]
-}
evsrc_t29r =
[ NoEvent, NoEvent, NoEvent, NoEvent, NoEvent -- 0.0 s
, NoEvent, NoEvent, NoEvent, NoEvent, NoEvent -- 0.5 s
, NoEvent, NoEvent, NoEvent, NoEvent, NoEvent -- 1.0 s
, NoEvent, NoEvent, NoEvent, NoEvent, NoEvent -- 1.5 s
, NoEvent, NoEvent, NoEvent, NoEvent, NoEvent -- 2.0 s
, NoEvent, NoEvent, NoEvent, NoEvent, NoEvent -- 2.5 s
, NoEvent, NoEvent, NoEvent, NoEvent, NoEvent -- 3.0 s
, NoEvent, Event [0.6], NoEvent, NoEvent, NoEvent -- 3.5 s
, NoEvent -- 4.0 s
, Event [1.1, 1.6, 2.1, 2.6] -- 6.0 s
, NoEvent, Event [3.1], NoEvent, NoEvent
, NoEvent, NoEvent, Event [3.6], NoEvent, NoEvent -- 6.5 s
, NoEvent, NoEvent, NoEvent, NoEvent, NoEvent -- 7.0 s
, NoEvent, NoEvent, NoEvent, NoEvent, NoEvent -- 7.5 s
, NoEvent, NoEvent, NoEvent, NoEvent, NoEvent -- 8.0 s
, NoEvent, NoEvent, NoEvent, NoEvent, NoEvent -- 8.5 s
, NoEvent, Event [6.0], Event [6.1], NoEvent, NoEvent -- 9.0 s
, NoEvent, NoEvent, Event [6.6], NoEvent, NoEvent -- 9.5 s
, NoEvent -- 10.0 s
]
evsrc_t12 :: [Event ()]
evsrc_t12 = testSF1 (localTime >>> arr (>=0) >>> edge)
evsrc_t12r =
[ NoEvent, NoEvent, NoEvent, NoEvent -- 0.0 s
, NoEvent, NoEvent, NoEvent, NoEvent -- 1.0 s
, NoEvent, NoEvent, NoEvent, NoEvent -- 2.0 s
, NoEvent, NoEvent, NoEvent, NoEvent -- 3.0 s
, NoEvent, NoEvent, NoEvent, NoEvent -- 4.0 s
, NoEvent, NoEvent, NoEvent, NoEvent -- 5.0 s
, NoEvent
]
evsrc_t13 :: [Event ()]
evsrc_t13 = testSF1 (localTime >>> arr (>=4.26) >>> edge)
evsrc_t13r =
[ NoEvent, NoEvent, NoEvent, NoEvent -- 0.0 s
, NoEvent, NoEvent, NoEvent, NoEvent -- 1.0 s
, NoEvent, NoEvent, NoEvent, NoEvent -- 2.0 s
, NoEvent, NoEvent, NoEvent, NoEvent -- 3.0 s
, NoEvent, NoEvent, Event (), NoEvent -- 4.0 s
, NoEvent, NoEvent, NoEvent, NoEvent -- 5.0 s
, NoEvent
]
propIEdge :: Property
propIEdge =
forAll initialValG $ \initialVal ->
forAll myStream $ evalT $
Always $ SP $ (==) <$> originalSF initialVal <*> modelSF initialVal
where
-- SF under test
originalSF :: Bool -> SF Bool (Event ())
originalSF = iEdge
-- Model SF that behaves like edge except for the initial sample
modelSF :: Bool -> SF Bool (Event ())
modelSF k = proc (x) -> do
t <- time -< ()
e <- edge -< x
let result | t == 0 && not k && x = Event ()
| t == 0 && k = NoEvent
| otherwise = e
returnA -< result
-- Generator: Initialization value for iEdge
initialValG :: Gen Bool
initialValG = arbitrary
-- Generator: Random input stream.
myStream :: Gen (SignalSampleStream Bool)
myStream = uniDistStream
propEdgeTag :: Property
propEdgeTag =
forAll paramValG $ \paramVal ->
forAll myStream $ evalT $
Always $ SP $ (==) <$> originalSF paramVal <*> modelSF paramVal
where
-- SF under test
originalSF :: Int -> SF Bool (Event Int)
originalSF = edgeTag
-- Model SF that tags the value in the event, after applying edge
modelSF :: Int -> SF Bool (Event Int)
modelSF k = edge >>^ arr (tagWith k)
-- Generator: Tagging value
paramValG :: Gen Int
paramValG = arbitrary
-- Generator: Random input stream.
myStream :: Gen (SignalSampleStream Bool)
myStream = uniDistStream
propEdgeJust :: Property
propEdgeJust =
forAll myStream $ evalT $
Always $ SP $ (==) <$> originalSF <*> modelSF
where
-- SF under test
originalSF :: SF (Maybe Int) (Event Int)
originalSF = edgeJust
-- Model SF
modelSF :: SF (Maybe Int) (Event Int)
modelSF = loopPre (Just 0) $ arr $ \v@(n, _) ->
case v of
(Just x, Nothing) -> (Event x, n)
_ -> (NoEvent, n)
-- Generator: Random input stream.
myStream :: Gen (SignalSampleStream (Maybe Int))
myStream = uniDistStream
-- Raising edge detector.
evsrc_isEdge False False = Nothing
evsrc_isEdge False True = Just ()
evsrc_isEdge True True = Nothing
evsrc_isEdge True False = Nothing
evsrc_t14 :: [Event ()]
evsrc_t14 = testSF1 (localTime >>> arr (>=0) >>> edgeBy evsrc_isEdge False)
evsrc_t14r =
[ Event (), NoEvent, NoEvent, NoEvent -- 0.0 s
, NoEvent, NoEvent, NoEvent, NoEvent -- 1.0 s
, NoEvent, NoEvent, NoEvent, NoEvent -- 2.0 s
, NoEvent, NoEvent, NoEvent, NoEvent -- 3.0 s
, NoEvent, NoEvent, NoEvent, NoEvent -- 4.0 s
, NoEvent, NoEvent, NoEvent, NoEvent -- 5.0 s
, NoEvent
]
evsrc_t15 :: [Event ()]
evsrc_t15 = testSF1 (localTime >>> arr (>=4.26) >>> edgeBy evsrc_isEdge False)
evsrc_t15r =
[ NoEvent, NoEvent, NoEvent, NoEvent -- 0.0 s
, NoEvent, NoEvent, NoEvent, NoEvent -- 1.0 s
, NoEvent, NoEvent, NoEvent, NoEvent -- 2.0 s
, NoEvent, NoEvent, NoEvent, NoEvent -- 3.0 s
, NoEvent, NoEvent, Event (), NoEvent -- 4.0 s
, NoEvent, NoEvent, NoEvent, NoEvent -- 5.0 s
, NoEvent
]
-- Raising and falling edge detector.
evsrc_isEdge2 False False = Nothing
evsrc_isEdge2 False True = Just True
evsrc_isEdge2 True True = Nothing
evsrc_isEdge2 True False = Just False
evsrc_t16 :: [Event Bool]
evsrc_t16 = testSF1 (localTime
>>> arr (\t -> t >=2.01 && t <= 4.51)
>>> edgeBy evsrc_isEdge2 True)
evsrc_t16r =
[ Event False, NoEvent, NoEvent, NoEvent -- 0.0 s
, NoEvent, NoEvent, NoEvent, NoEvent -- 1.0 s
, NoEvent, Event True, NoEvent, NoEvent -- 2.0 s
, NoEvent, NoEvent, NoEvent, NoEvent -- 3.0 s
, NoEvent, NoEvent, NoEvent, Event False -- 4.0 s
, NoEvent, NoEvent, NoEvent, NoEvent -- 5.0 s
, NoEvent
]
-- * Stateful event suppression
propNotYet :: Property
propNotYet =
forAll myStream $ evalT $
Always $ SP $ (==) <$> originalSF
<*> modelSF
where
-- SF under test
originalSF :: SF (Event Int) (Event Int)
originalSF = notYet
-- Model SF that sets the initial value of an Event signal to noEvent
modelSF :: SF (Event Int) (Event Int)
modelSF = const noEvent -=> identity
-- Generator: Random input stream.
myStream :: Gen (SignalSampleStream (Event Int))
myStream = uniDistStream
evsrc_t17 :: [Event Int]
evsrc_t17 = testSF1 (now 17 &&& repeatedly 0.795 42
>>> arr (uncurry merge)
>>> notYet)
evsrc_t17r :: [Event Int]
evsrc_t17r =
[ NoEvent, NoEvent, NoEvent, NoEvent -- 0.0 s
, Event 42, NoEvent, NoEvent, Event 42 -- 1.0 s
, NoEvent, NoEvent, Event 42, NoEvent -- 2.0 s
, NoEvent, Event 42, NoEvent, NoEvent -- 3.0 s
, Event 42, NoEvent, NoEvent, NoEvent -- 4.0 s
, Event 42, NoEvent, NoEvent, Event 42 -- 5.0 s
, NoEvent
]
evsrc_t18 :: [Event Int]
evsrc_t18 = testSF1 (now 42 >>> once)
evsrc_t18r :: [Event Int]
evsrc_t18r =
[ Event 42, NoEvent, NoEvent, NoEvent -- 0.0 s
, NoEvent, NoEvent, NoEvent, NoEvent -- 1.0 s
, NoEvent, NoEvent, NoEvent, NoEvent -- 2.0 s
, NoEvent, NoEvent, NoEvent, NoEvent -- 3.0 s
, NoEvent, NoEvent, NoEvent, NoEvent -- 4.0 s
, NoEvent, NoEvent, NoEvent, NoEvent -- 5.0 s
, NoEvent
]
evsrc_t19 :: [Event Int]
evsrc_t19 = testSF1 (repeatedly 0.8 42 >>> once)
evsrc_t19r :: [Event Int]
evsrc_t19r =
[ NoEvent, NoEvent, NoEvent, NoEvent -- 0.0 s
, Event 42, NoEvent, NoEvent, NoEvent -- 1.0 s
, NoEvent, NoEvent, NoEvent, NoEvent -- 2.0 s
, NoEvent, NoEvent, NoEvent, NoEvent -- 3.0 s
, NoEvent, NoEvent, NoEvent, NoEvent -- 4.0 s
, NoEvent, NoEvent, NoEvent, NoEvent -- 5.0 s
, NoEvent
]
evsrc_t20 :: [Event Int]
evsrc_t20 = testSF1 (now 42 >>> takeEvents 0)
evsrc_t20r :: [Event Int]
evsrc_t20r =
[ NoEvent, NoEvent, NoEvent, NoEvent -- 0.0 s
, NoEvent, NoEvent, NoEvent, NoEvent -- 1.0 s
, NoEvent, NoEvent, NoEvent, NoEvent -- 2.0 s
, NoEvent, NoEvent, NoEvent, NoEvent -- 3.0 s
, NoEvent, NoEvent, NoEvent, NoEvent -- 4.0 s
, NoEvent, NoEvent, NoEvent, NoEvent -- 5.0 s
, NoEvent
]
evsrc_t21 :: [Event Int]
evsrc_t21 = testSF1 (now 42 >>> takeEvents 1)
evsrc_t21r :: [Event Int]
evsrc_t21r =
[ Event 42, NoEvent, NoEvent, NoEvent -- 0.0 s
, NoEvent, NoEvent, NoEvent, NoEvent -- 1.0 s
, NoEvent, NoEvent, NoEvent, NoEvent -- 2.0 s
, NoEvent, NoEvent, NoEvent, NoEvent -- 3.0 s
, NoEvent, NoEvent, NoEvent, NoEvent -- 4.0 s
, NoEvent, NoEvent, NoEvent, NoEvent -- 5.0 s
, NoEvent
]
evsrc_t22 :: [Event Int]
evsrc_t22 = testSF1 (repeatedly 0.8 42 >>> takeEvents 4)
evsrc_t22r :: [Event Int]
evsrc_t22r =
[ NoEvent, NoEvent, NoEvent, NoEvent -- 0.0 s
, Event 42, NoEvent, NoEvent, Event 42 -- 1.0 s
, NoEvent, NoEvent, Event 42, NoEvent -- 2.0 s
, NoEvent, Event 42, NoEvent, NoEvent -- 3.0 s
, NoEvent, NoEvent, NoEvent, NoEvent -- 4.0 s
, NoEvent, NoEvent, NoEvent, NoEvent -- 5.0 s
, NoEvent
]
evsrc_t23 :: [Event Int]
evsrc_t23 = testSF1 (repeatedly 0.2 42 >>> takeEvents 4)
evsrc_t23r :: [Event Int]
evsrc_t23r =
[ NoEvent, Event 42, Event 42, Event 42 -- 0.0 s
, Event 42, NoEvent, NoEvent, NoEvent -- 1.0 s
, NoEvent, NoEvent, NoEvent, NoEvent -- 2.0 s
, NoEvent, NoEvent, NoEvent, NoEvent -- 3.0 s
, NoEvent, NoEvent, NoEvent, NoEvent -- 4.0 s
, NoEvent, NoEvent, NoEvent, NoEvent -- 5.0 s
, NoEvent
]
evsrc_t24 :: [Event Int]
evsrc_t24 = testSF1 (now 42 >>> dropEvents 0)
evsrc_t24r :: [Event Int]
evsrc_t24r =
[ Event 42, NoEvent, NoEvent, NoEvent -- 0.0 s
, NoEvent, NoEvent, NoEvent, NoEvent -- 1.0 s
, NoEvent, NoEvent, NoEvent, NoEvent -- 2.0 s
, NoEvent, NoEvent, NoEvent, NoEvent -- 3.0 s
, NoEvent, NoEvent, NoEvent, NoEvent -- 4.0 s
, NoEvent, NoEvent, NoEvent, NoEvent -- 5.0 s
, NoEvent
]
evsrc_t25 :: [Event Int]
evsrc_t25 = testSF1 (now 42 >>> dropEvents 1)
evsrc_t25r :: [Event Int]
evsrc_t25r =
[ NoEvent, NoEvent, NoEvent, NoEvent -- 0.0 s
, NoEvent, NoEvent, NoEvent, NoEvent -- 1.0 s
, NoEvent, NoEvent, NoEvent, NoEvent -- 2.0 s
, NoEvent, NoEvent, NoEvent, NoEvent -- 3.0 s
, NoEvent, NoEvent, NoEvent, NoEvent -- 4.0 s
, NoEvent, NoEvent, NoEvent, NoEvent -- 5.0 s
, NoEvent
]
evsrc_t26 :: [Event Int]
-- Drop 5 events to get rid of the event at 4.0 s which may or may not happen
-- exactly there.
evsrc_t26 = testSF1 (repeatedly 0.8 42 >>> dropEvents 5)
evsrc_t26r :: [Event Int]
evsrc_t26r =
[ NoEvent, NoEvent, NoEvent, NoEvent -- 0.0 s
, NoEvent, NoEvent, NoEvent, NoEvent -- 1.0 s
, NoEvent, NoEvent, NoEvent, NoEvent -- 2.0 s
, NoEvent, NoEvent, NoEvent, NoEvent -- 3.0 s
, NoEvent, NoEvent, NoEvent, NoEvent -- 4.0 s
, Event 42, NoEvent, NoEvent, Event 42 -- 5.0 s
, NoEvent
]
evsrc_t27 :: [Event Int]
evsrc_t27 = testSF1 (repeatedly 0.2 42 >>> dropEvents 4)
evsrc_t27r :: [Event Int]
evsrc_t27r =
[ NoEvent, NoEvent, NoEvent, NoEvent -- 0.0 s
, NoEvent, Event 42, Event 42, Event 42 -- 1.0 s
, Event 42, Event 42, Event 42, Event 42 -- 2.0 s
, Event 42, Event 42, Event 42, Event 42 -- 3.0 s
, Event 42, Event 42, Event 42, Event 42 -- 4.0 s
, Event 42, Event 42, Event 42, Event 42 -- 5.0 s
, Event 42
]
-- ** Hybrid continuous-to-discrete SF combinators.
utils_t10 :: [Event Double]
utils_t10 = testSF1 snap
utils_t10r =
[ Event 0.0, NoEvent, NoEvent, NoEvent -- 0.0 s
, NoEvent, NoEvent, NoEvent, NoEvent -- 1.0 s
, NoEvent, NoEvent, NoEvent, NoEvent -- 2.0 s
, NoEvent, NoEvent, NoEvent, NoEvent -- 3.0 s
, NoEvent, NoEvent, NoEvent, NoEvent -- 4.0 s
, NoEvent, NoEvent, NoEvent, NoEvent -- 5.0 s
, NoEvent
]
utils_t11 :: [Event Double]
utils_t11 = testSF1 (snapAfter 2.6)
utils_t11r =
[ NoEvent, NoEvent, NoEvent, NoEvent -- 0.0 s
, NoEvent, NoEvent, NoEvent, NoEvent -- 1.0 s
, NoEvent, NoEvent, NoEvent, Event 11.0 -- 2.0 s
, NoEvent, NoEvent, NoEvent, NoEvent -- 3.0 s
, NoEvent, NoEvent, NoEvent, NoEvent -- 4.0 s
, NoEvent, NoEvent, NoEvent, NoEvent -- 5.0 s
, NoEvent
]
utils_t12 :: [Event Double]
utils_t12 = testSF1 (sample 0.99)
utils_t12r =
[ NoEvent, NoEvent, NoEvent, NoEvent -- 0.0 s
, Event 4.0, NoEvent, NoEvent, NoEvent -- 1.0 s
, Event 8.0, NoEvent, NoEvent, NoEvent -- 2.0 s
, Event 12.0, NoEvent, NoEvent, NoEvent -- 3.0 s
, Event 16.0, NoEvent, NoEvent, NoEvent -- 4.0 s
, Event 20.0, NoEvent, NoEvent, NoEvent -- 5.0 s
, Event 24.0
]
utils_t15 = take 50 (embed (time >>> sampleWindow 5 0.5)
(deltaEncode 0.125 (repeat ())))
utils_t15r =
[ NoEvent, NoEvent, NoEvent, NoEvent -- 0.0 s
, Event [0.5], NoEvent, NoEvent, NoEvent -- 0.5 s
, Event [0.5,1.0], NoEvent, NoEvent, NoEvent -- 1.0 s
, Event [0.5,1.0,1.5], NoEvent, NoEvent, NoEvent -- 1.5 s
, Event [0.5,1.0,1.5,2.0], NoEvent, NoEvent, NoEvent -- 2.0 s
, Event [0.5,1.0,1.5,2.0,2.5], NoEvent, NoEvent, NoEvent -- 2.5 s
, Event [1.0,1.5,2.0,2.5,3.0], NoEvent, NoEvent, NoEvent -- 3.0 s
, Event [1.5,2.0,2.5,3.0,3.5], NoEvent, NoEvent, NoEvent -- 3.5 s
, Event [2.0,2.5,3.0,3.5,4.0], NoEvent, NoEvent, NoEvent -- 4.0 s
, Event [2.5,3.0,3.5,4.0,4.5], NoEvent, NoEvent, NoEvent -- 4.5 s
, Event [3.0,3.5,4.0,4.5,5.0], NoEvent, NoEvent, NoEvent -- 5.0 s
, Event [3.5,4.0,4.5,5.0,5.5], NoEvent, NoEvent, NoEvent -- 5.5 s
, Event [4.0,4.5,5.0,5.5,6.0], NoEvent -- 6.0 s
]
{-
-- Not robust
utils_t16 = take 50 (embed (time >>> sampleWindow 5 0.5) input)
where
input = ((), [(dt, Just ()) | dt <- dts])
dts = replicate 15 0.1
++ [1.0, 1.0]
++ replicate 15 0.1
++ [2.0]
++ replicate 10 0.1
utils_t16r =
[ NoEvent, NoEvent, NoEvent, NoEvent, NoEvent -- 0.0
, NoEvent, Event [0.6], NoEvent, NoEvent, NoEvent -- 0.5
, NoEvent, Event [0.6, 1.1], NoEvent, NoEvent, NoEvent -- 1.0
, NoEvent -- 1.5
, Event [0.6,1.1,2.5,2.5,2.5] -- 2.5
, Event [2.5,2.5,2.5,3.5,3.5], NoEvent, NoEvent, NoEvent, NoEvent -- 3.5
, NoEvent, Event [2.5,2.5,3.5,3.5,4.1], NoEvent, NoEvent, NoEvent -- 4.0
, NoEvent, Event [2.5,3.5,3.5,4.1,4.6], NoEvent, NoEvent, NoEvent -- 4.5
, NoEvent -- 5.0
, Event [7.0,7.0,7.0,7.0,7.0], NoEvent, NoEvent, NoEvent, NoEvent -- 7.0
, NoEvent, Event [7.0,7.0,7.0,7.0,7.6], NoEvent, NoEvent, NoEvent -- 7.5
, NoEvent -- 8.0
]
-}
utils_t16 = take 50 (embed (time >>> sampleWindow 5 0.4999) input)
where
input = ((), [(dt, Just ()) | dt <- dts])
dts = replicate 15 0.1
++ [1.0, 1.0]
++ replicate 15 0.1
++ [2.0]
++ replicate 10 0.1
utils_t16r =
[ NoEvent, NoEvent, NoEvent, NoEvent, NoEvent -- 0.0
, Event [0.5], NoEvent, NoEvent, NoEvent, NoEvent -- 0.5
, Event [0.5, 1.0], NoEvent, NoEvent, NoEvent, NoEvent -- 1.0
, Event [0.5, 1.0, 1.5] -- 1.5
, Event [0.5, 1.0, 1.5, 2.5, 2.5] -- 2.5
, Event [1.5, 2.5, 2.5, 3.5, 3.5], NoEvent, NoEvent, NoEvent -- 3.5
, NoEvent
, Event [2.5, 2.5, 3.5, 3.5, 4.0], NoEvent, NoEvent, NoEvent -- 4.0
, NoEvent
, Event [2.5, 3.5, 3.5, 4.0, 4.5], NoEvent, NoEvent, NoEvent -- 4.5
, NoEvent
, Event [3.5, 3.5, 4.0, 4.5, 5.0] -- 5.0
, Event [5.0, 7.0, 7.0, 7.0, 7.0], NoEvent, NoEvent, NoEvent -- 7.0
, NoEvent
, Event [7.0, 7.0, 7.0, 7.0, 7.5], NoEvent, NoEvent, NoEvent -- 7.5
, NoEvent
, Event [7.0, 7.0, 7.0, 7.5, 8.0] -- 8.0
]
-- * Repetition and switching
utils_t13 :: [Event ()]
utils_t13 = testSF1 (recur (after 0.99 ()))
utils_t13r =
[ NoEvent, NoEvent, NoEvent, NoEvent -- 0.0 s
, Event (), NoEvent, NoEvent, NoEvent -- 1.0 s
, Event (), NoEvent, NoEvent, NoEvent -- 2.0 s
, Event (), NoEvent, NoEvent, NoEvent -- 3.0 s
, Event (), NoEvent, NoEvent, NoEvent -- 4.0 s
, Event (), NoEvent, NoEvent, NoEvent -- 5.0 s
, Event ()
]
utils_t14 :: [Event Int]
utils_t14 = testSF1 (after 1.0 1 `andThen` now 2 `andThen` after 2.0 3)
utils_t14r =
[ NoEvent, NoEvent, NoEvent, NoEvent -- 0.0 s
, Event 1, NoEvent, NoEvent, NoEvent -- 1.0 s
, NoEvent, NoEvent, NoEvent, NoEvent -- 2.0 s
, Event 3, NoEvent, NoEvent, NoEvent -- 3.0 s
, NoEvent, NoEvent, NoEvent, NoEvent -- 4.0 s
, NoEvent, NoEvent, NoEvent, NoEvent -- 5.0 s
, NoEvent
]
-- * Auxiliary
-- prop :: SF a b -> (a -> b ->
prop (a,b) = SP ((identity &&& a) >>^ uncurry b)
-- * Arbitrary value generation
instance Arbitrary a => Arbitrary (Event a) where
arbitrary = oneof [ return NoEvent
, do x <- arbitrary
return $ Event x
]