diff --git a/yampa-test/CHANGELOG b/yampa-test/CHANGELOG index 028f2ac8..196426d7 100644 --- a/yampa-test/CHANGELOG +++ b/yampa-test/CHANGELOG @@ -1,3 +1,12 @@ +2023-02-07 Ivan Perez + * Yampa.cabal: Version bump (0.14.1) (#251). + * tests/: add tests for module FRP.Yampa.Hybrid (#243), add tests for + module FRP.Yampa.Arrow (#244), complete unit tests for FRP.Yampa.Test + (#245), complete unit tests for FRP.Yampa.Simulation (#246), complete + unit tests for FRP.Yampa.EventS (#247), complete unit tests for + FRP.Yampa.Random (#248), complete unit tests for FRP.Yampa.Switches + (#250). + 2022-12-07 Ivan Perez * yampa-test.cabal: Version bump (0.14) (#242), add tests for module FRP.Yampa.Event (#237). diff --git a/yampa-test/tests/Main.hs b/yampa-test/tests/Main.hs index 88a440e3..ccc0257f 100644 --- a/yampa-test/tests/Main.hs +++ b/yampa-test/tests/Main.hs @@ -14,6 +14,7 @@ module Main where import Test.Tasty (TestTree, defaultMain, testGroup) +import qualified Test.FRP.Yampa.Arrow as Arrow import qualified Test.FRP.Yampa.Basic as Basic import qualified Test.FRP.Yampa.Conditional as Conditional import qualified Test.FRP.Yampa.Delays as Delays @@ -23,6 +24,7 @@ import qualified Test.FRP.Yampa.Hybrid as Hybrid import qualified Test.FRP.Yampa.Integration as Integration import qualified Test.FRP.Yampa.InternalCore as InternalCore import qualified Test.FRP.Yampa.Loop as Loop +import qualified Test.FRP.Yampa.Random as Random import qualified Test.FRP.Yampa.Scan as Scan import qualified Test.FRP.Yampa.Simulation as Simulation import qualified Test.FRP.Yampa.Switches as Switches @@ -34,7 +36,8 @@ main = defaultMain tests tests :: TestTree tests = testGroup "Yampa QC properties" - [ Basic.tests + [ Arrow.tests + , Basic.tests , Conditional.tests , Delays.tests , Event.tests @@ -43,6 +46,7 @@ tests = testGroup "Yampa QC properties" , Integration.tests , InternalCore.tests , Loop.tests + , Random.tests , Scan.tests , Simulation.tests , Switches.tests diff --git a/yampa-test/tests/Test/FRP/Yampa/Arrow.hs b/yampa-test/tests/Test/FRP/Yampa/Arrow.hs new file mode 100644 index 00000000..ab7119ff --- /dev/null +++ b/yampa-test/tests/Test/FRP/Yampa/Arrow.hs @@ -0,0 +1,92 @@ +-- | +-- Description : Test cases for arrow helper functions. +-- Copyright : (c) Ivan Perez, 2022 +-- Authors : Ivan Perez +module Test.FRP.Yampa.Arrow + ( tests + ) + where + +-- External modules +import Test.QuickCheck (Gen, Property, arbitrary, forAll, forAllBlind) +import Test.Tasty (TestTree, testGroup) +import Test.Tasty.QuickCheck (testProperty) + +-- External modules: Yampa +import FRP.Yampa as Yampa +import FRP.Yampa.Arrow as Yampa + +tests :: TestTree +tests = testGroup "Regression tests for FRP.Yampa.Arrow" + [ testProperty "dup (qc)" testDup + , testProperty "arr2 (qc)" testArr2 + , testProperty "arr3 (qc)" testArr3 + , testProperty "arr4 (qc)" testArr4 + , testProperty "arr5 (qc)" testArr5 + ] + +-- * Arrow plumbing aids + +testDup :: Property +testDup = + forAll input $ \x -> + (fst (dup x) == x) && (snd (dup x) == x) + where + input :: Gen Integer + input = arbitrary + +-- * Liftings + +testArr2 :: Property +testArr2 = + forAll input $ \x@(x1, x2) -> + forAllBlind inputF $ \f -> + arr2 f x == f x1 x2 + where + input :: Gen (Integer, Integer) + input = arbitrary + + inputF :: Gen (Integer -> Integer -> Integer) + inputF = arbitrary + +testArr3 :: Property +testArr3 = + forAll input $ \x@(x1, x2, x3) -> + forAllBlind inputF $ \f -> + arr3 f x == f x1 x2 x3 + where + input :: Gen (Integer, Integer, Integer) + input = arbitrary + + inputF :: Gen (Integer -> Integer -> Integer -> Integer) + inputF = arbitrary + +testArr4 :: Property +testArr4 = + forAll input $ \x@(x1, x2, x3, x4) -> + forAllBlind inputF $ \f -> + arr4 f x == f x1 x2 x3 x4 + where + input :: Gen (Integer, Integer, Integer, Integer) + input = arbitrary + + inputF :: Gen (Integer -> Integer -> Integer -> Integer -> Integer) + inputF = arbitrary + +testArr5 :: Property +testArr5 = + forAll input $ \x@(x1, x2, x3, x4, x5) -> + forAllBlind inputF $ \f -> + arr5 f x == f x1 x2 x3 x4 x5 + where + input :: Gen (Integer, Integer, Integer, Integer, Integer) + input = arbitrary + + inputF :: Gen ( Integer + -> Integer + -> Integer + -> Integer + -> Integer + -> Integer + ) + inputF = arbitrary diff --git a/yampa-test/tests/Test/FRP/Yampa/EventS.hs b/yampa-test/tests/Test/FRP/Yampa/EventS.hs index ddc410f0..7ee56417 100644 --- a/yampa-test/tests/Test/FRP/Yampa/EventS.hs +++ b/yampa-test/tests/Test/FRP/Yampa/EventS.hs @@ -1,3 +1,5 @@ +{-# LANGUAGE Arrows #-} +{-# LANGUAGE CPP #-} -- | -- Description : Test cases for signal functions working with events -- Copyright : (c) Antony Courtney and Henrik Nilsson, Yale University, 2003-2004 @@ -16,6 +18,10 @@ module Test.FRP.Yampa.EventS ) 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) @@ -30,47 +36,52 @@ 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 "eventS (30, fixed)" (property $ evsrc_t30 ~= evsrc_t30r) - , testProperty "eventS (29, 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 "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 "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) + [ 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 @@ -295,6 +306,44 @@ evsrc_t11r = , 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 @@ -434,6 +483,78 @@ evsrc_t13r = , 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 () @@ -489,6 +610,24 @@ evsrc_t16r = -- * 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) @@ -797,3 +936,11 @@ utils_t14r = -- 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 + ] diff --git a/yampa-test/tests/Test/FRP/Yampa/Hybrid.hs b/yampa-test/tests/Test/FRP/Yampa/Hybrid.hs index 67240e91..903657a9 100644 --- a/yampa-test/tests/Test/FRP/Yampa/Hybrid.hs +++ b/yampa-test/tests/Test/FRP/Yampa/Hybrid.hs @@ -8,14 +8,20 @@ module Test.FRP.Yampa.Hybrid where import Data.Maybe (fromJust) +import Data.Tuple (swap) import Test.QuickCheck +import Test.QuickCheck.Function import Test.Tasty (TestTree, testGroup) import Test.Tasty.QuickCheck (testProperty) import FRP.Yampa as Yampa import FRP.Yampa.Hybrid as Yampa +import FRP.Yampa.LTLFuture (evalT, TPred (Next, Always, SP)) +import FRP.Yampa.QuickCheck (uniDistStream, uniDistStreamMaxDT) +import FRP.Yampa.Stream + import TestsCommon tests :: TestTree @@ -46,6 +52,10 @@ tests = testGroup "Regression tests for FRP.Yampa.Hybrid" , testProperty "accum (15, fixed)" (property $ accum_t15 == accum_t15r) , testProperty "accum (16, fixed)" (property $ accum_t16 == accum_t16r) , testProperty "accum (17, fixed)" (property $ accum_t17 == accum_t17r) + , testProperty "accumHold (0, qc)" testAccumHold1 + , testProperty "accumHold (1, qc)" testAccumHold2 + , testProperty "dAccumHold (0, qc)" testDAccumHold1 + , testProperty "dAccumHold (1, qc)" testDAccumHold2 ] -- * Wave-form generation @@ -470,3 +480,99 @@ accum_t17 = take 40 $ embed (repeatedly 1.0 1 accum_t17r :: [Int] accum_t17r = accum_t16 -- Should agree! + +testAccumHold1 :: Property +testAccumHold1 = + forAll arbitrary $ \x -> + forAll myStream $ + evalT $ + Always $ prop ((sf x &&& sfByHand x), const close) + + where + myStream :: Gen (SignalSampleStream ()) + myStream = uniDistStream + + sf :: Double -> SF () Double + sf x = never >>> accumHold x + + sfByHand :: Double -> SF () Double + sfByHand x = constant x + + close (x, y) = abs (x - y) < 0.05 + +testAccumHold2 :: Property +testAccumHold2 = + forAll myStream $ evalT $ + Always $ prop ((sf &&& sfByHand), const close) + + where + myStream :: Gen (SignalSampleStream ()) + myStream = uniDistStreamMaxDT maxSamplingDelay + + sf :: SF () Double + sf = repeatedly eventUpdateDelay (+1) >>> accumHold 0 + + sfByHand :: SF () Double + sfByHand = time >>> arr floorDouble + + floorDouble :: Double -> Double + floorDouble x = fromIntegral ((floor x) :: Integer) + + -- Important that this number be smaller than eventUpdateDelay below. + maxSamplingDelay :: DTime + maxSamplingDelay = 0.9 + + -- Important that this delay be greater than maxSamplingDelay above. + eventUpdateDelay :: DTime + eventUpdateDelay = 1.0 + + close (x, y) = abs (x - y) < 0.05 + +-- Test that dAccumHold is like constant for the first sample +testDAccumHold1 :: Property +testDAccumHold1 = + forAll arbitrary $ \x -> + forAll myStream $ + evalT $ + prop (arr (fmap apply) >>> (sf x &&& sfByHand x), const close) + + where + myStream :: Gen (SignalSampleStream (Event (Fun Double Double))) + myStream = uniDistStream + + sf :: Double -> SF (Event (Double -> Double)) Double + sf x = dAccumHold x + + sfByHand :: Double -> SF (Event (Double -> Double)) Double + sfByHand x = constant x + + close (x, y) = abs (x - y) < 0.05 + +-- Test that dAccumHold is like accumHold delayed +testDAccumHold2 :: Property +testDAccumHold2 = + forAll arbitrary $ \x -> + forAll myStream $ + evalT $ + Next $ Always $ + prop (arr (fmap apply) >>> (sf x &&& sfByHand x), const close) + + where + myStream :: Gen (SignalSampleStream (Event (Fun Double Double))) + myStream = uniDistStream + + sf :: Double -> SF (Event (Double -> Double)) Double + sf x = dAccumHold x + + sfByHand :: Double -> SF (Event (Double -> Double)) Double + sfByHand x = accumHold x >>> loopPre x (arr swap) + + close (x, y) = abs (x - y) < 0.05 + +-- * Auxiliary +-- prop :: SF a b -> (a -> b -> +prop (a,b) = SP ((identity &&& a) >>^ uncurry b) + +-- ** Arbitrary value generation +instance Arbitrary x => Arbitrary (Event x) where + arbitrary = oneof [ return NoEvent, fmap Event $ arbitrary ] diff --git a/yampa-test/tests/Test/FRP/Yampa/Random.hs b/yampa-test/tests/Test/FRP/Yampa/Random.hs new file mode 100644 index 00000000..f4ce02cb --- /dev/null +++ b/yampa-test/tests/Test/FRP/Yampa/Random.hs @@ -0,0 +1,230 @@ +{-# LANGUAGE CPP #-} +{-# LANGUAGE ForeignFunctionInterface #-} +-- | +-- Description : Test cases for signal functions working with random values. +-- Copyright : (c) Ivan Perez, 2023 +-- Authors : Ivan Perez + +module Test.FRP.Yampa.Random + ( tests + ) + where + +#if __GLASGOW_HASKELL__ < 708 +import Data.Bits (bitSize) +#endif +#if __GLASGOW_HASKELL__ >= 708 +import Data.Bits (bitSizeMaybe) +#endif + +import Data.Bits (Bits, popCount) +import Data.Maybe (fromMaybe) +import Data.Word (Word32, Word64) +import Foreign.C (CFloat(..)) +import System.Random (mkStdGen) +import Test.QuickCheck hiding (once, sample) +import Test.Tasty (TestTree, testGroup) +import Test.Tasty.QuickCheck (testProperty) + +import FRP.Yampa (DTime, Event (..), embed, isEvent, noise, noiseR, + occasionally, second) +import FRP.Yampa.QuickCheck (Distribution (DistRandom), generateStream) +import FRP.Yampa.Stream (SignalSampleStream) + +tests :: TestTree +tests = testGroup "Regression tests for FRP.Yampa.Random" + [ testProperty "noise (0, qc)" propNoise + , testProperty "noiseR (0, qc)" propNoiseR + , testProperty "occasionally (0, qc)" propOccasionally + ] + +-- * Noise (i.e. random signal generators) and stochastic processes + +propNoise :: Property +propNoise = + forAll genSeed $ \seed -> + forAll myStream $ \stream -> + isRandom (embed (noise (mkStdGen seed)) (structure stream) :: [Word32]) + where + -- Generator: Input stream. + -- + -- We provide a number of samples; otherwise, deviations might not indicate + -- lack of randomness for the signal function. + myStream :: Gen (SignalSampleStream ()) + myStream = + generateStream DistRandom (Nothing, Nothing) (Just (Left numSamples)) + + -- Generator: Random generator seed + genSeed :: Gen Int + genSeed = arbitrary + + -- Constant: Number of samples in the stream used for testing. + -- + -- This number has to be high; numbers 100 or below will likely not work. + numSamples :: Int + numSamples = 400 + +propNoiseR :: Property +propNoiseR = + forAll genSeed $ \seed -> + forAll myStream $ \stream -> + -- True if the noise signal is within the given bounds, and it is random + -- when constrained to that range. + let output = embed (noiseR bounds (mkStdGen seed)) (structure stream) + in all (`isInRange` bounds) output && isRandom (constrainTypes output) + + where + + -- Generator: Input stream. + -- + -- We provide a number of samples; otherwise, deviations might not indicate + -- lack of randomness for the signal function. + myStream :: Gen (SignalSampleStream ()) + myStream = + generateStream DistRandom (Nothing, Nothing) (Just (Left numSamples)) + + -- Generator: Random generator seed + genSeed :: Gen Int + genSeed = arbitrary + + -- Constant: Bounds used for the test. + -- + -- We bound the numbers generated to the 32-bit range, but express it + -- using the type of Word64. + bounds :: (Word64, Word64) + bounds = (min32, max32) + where + min32 = fromIntegral (minBound :: Word32) + max32 = fromIntegral (maxBound :: Word32) + + -- Constant: Number of samples in the stream used for testing. + -- + -- This number has to be high; numbers 100 or below will likely not work. + numSamples :: Int + numSamples = 400 + + -- Constrain the types of the argument list to the output type. + -- + -- For this test to work, this type must be consistent with the bounds + -- chosen in the constant 'bounds'. + constrainTypes :: [Word64] -> [Word32] + constrainTypes = map fromIntegral + + -- | True if the argument is within the given range, false otherwise. + isInRange :: Ord a => a -> (a, a) -> Bool + isInRange x (minB, maxB) = minB <= x && x <= maxB + +propOccasionally :: Property +propOccasionally = + forAll genDt $ \avgDt -> + forAll genOutput $ \b -> + forAll genSeed $ \seed -> + + -- We pass avgDt / 10 as max time delta to myStream to ensure that the + -- stream produces frequent samples. + forAll (myStream (avgDt / 10)) $ \stream -> + + -- True if all events in the output contain the value 'b', + -- the number of events produced is roughtly as expected. + let output = + embed (occasionally (mkStdGen seed) avgDt b) (structure stream) + + -- Difference between the number of samples produced and expected + diffNumSamples = abs (actualOcurrences - expectedOccurrences) + actualOcurrences = length $ filter isEvent output + expectedOccurrences = round (streamTime / avgDt) + streamTime = sum $ map fst $ snd stream + + in all (== Event b) (filter isEvent output) && diffNumSamples < margin + + where + + -- Generator: Input stream. + -- + -- We provide a number of samples; otherwise, deviations might not indicate + -- lack of randomness for the signal function. + -- + -- We also provide the max dt and ensure that samples are + myStream :: DTime -> Gen (SignalSampleStream ()) + myStream maxDT = + generateStream + DistRandom + (Nothing, (Just maxDT)) + (Just (Left numSamples)) + + -- Generator: Random generator seed + genDt :: Gen Double + genDt = fmap getPositive arbitrary + + -- Generator: Random generator seed + genSeed :: Gen Int + genSeed = arbitrary + + -- Generator: Random value generator + genOutput :: Gen Int + genOutput = arbitrary + + -- Constant: Number of samples in the stream used for testing. + -- + -- This number has to be high; numbers 100 or below will likely not work. + numSamples :: Int + numSamples = 400 + + -- Constant: Max difference accepted between actual occurrences and + -- expected occurrences + margin :: Int + margin = round (fromIntegral numSamples * 0.05) + +-- * Auxiliary definitions + +-- | Check whether a list of values exhibits randomness. +-- +-- This function implements the Frequence (Monobit) Test, as described in +-- Section 2.1 of "A Statistical Test Suite for Random and Pseudorandom Number +-- Generators for Cryptographic Applications", by Rukhin et al. +isRandom :: Bits a => [a] -> Bool +isRandom ls = pValue >= 0.01 + where + pValue = erfc (sObs / sqrt 2) + sObs = abs sn / sqrt n + n = fromIntegral $ elemSize * length ls + sn = sum $ map numConv ls + + -- Number of bits per element + elemSize :: Int + elemSize = + -- bitSize' ignores the argument, so it's ok if the list is empty + bitSize' $ head ls + + -- Substitute each digit e in the binary representation of the input value + -- by 2e – 1, and add the results. + numConv :: Bits a => a -> Float + numConv x = fromIntegral $ numOnes - numZeroes + where + numOnes = popCount x + numZeroes = elemSize - popCount x + + -- Number of bits per element + elemSize = bitSize' x + +-- | Complementary Error Function, compliant with the definition of erfcf in +-- ANSI C. +erfc :: Float -> Float +erfc = realToFrac . erfcf . realToFrac + +-- | ANSI C function erfcf defined in math.h +foreign import ccall "erfcf" erfcf :: CFloat -> CFloat + +-- | Transform SignalSampleStreams into streams of differences. +structure :: (a, [(b, a)]) -> (a, [(b, Maybe a)]) +structure (x, xs) = (x, map (second Just) xs) + +-- | Implementation of bitSize that uses bitSize/bitSizeMaybe depending on the +-- version of base available. +bitSize' :: Bits a => a -> Int +bitSize' = +#if __GLASGOW_HASKELL__ < 708 + bitSize +#else + fromMaybe 0 . bitSizeMaybe +#endif diff --git a/yampa-test/tests/Test/FRP/Yampa/Simulation.hs b/yampa-test/tests/Test/FRP/Yampa/Simulation.hs index 6056f1a8..2fa0bb45 100644 --- a/yampa-test/tests/Test/FRP/Yampa/Simulation.hs +++ b/yampa-test/tests/Test/FRP/Yampa/Simulation.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE CPP #-} -- | -- Description : Test cases for FRP.Yampa.Simulation -- Copyright : (c) Antony Courtney and Henrik Nilsson, Yale University, 2003-2004 @@ -7,21 +8,39 @@ module Test.FRP.Yampa.Simulation ) where +#if __GLASGOW_HASKELL__ < 710 +import Control.Applicative ((<*>)) +import Data.Functor ((<$>)) +#endif + +import Data.Maybe (fromMaybe) +import Data.Traversable (mapAccumL) + import Test.QuickCheck import Test.Tasty (TestTree, testGroup) import Test.Tasty.QuickCheck (testProperty) import System.IO.Unsafe (unsafePerformIO) -import Data.IORef (newIORef, writeIORef, readIORef) +import Data.IORef (modifyIORef, newIORef, readIORef, writeIORef) import FRP.Yampa as Yampa +import FRP.Yampa.QuickCheck (uniDistStream) +import FRP.Yampa.Stream (FutureSampleStream, SignalSampleStream) + import TestsCommon tests :: TestTree tests = testGroup "Regression tests for FRP.Yampa.Simulation" - [ testProperty "react (fixed)" (property $ react_t0 ~= react_t0r) - , testProperty "embed (0, fixed)" (property $ embed_t0 ~= embed_t0r) - , testProperty "embed (1, fixed)" (property $ embed_t1 ~= embed_t1r) + [ testProperty "reactimate (fixed)" (property $ react_t0 ~= react_t0r) + , testProperty "react, reactInit (qc)" testReact + , testProperty "embed (0, qc)" testEmbed + , testProperty "embedSynch (0, fixed)" (property $ embed_t0 ~= embed_t0r) + , testProperty "embedSynch (1, fixed)" (property $ embed_t1 ~= embed_t1r) + , testProperty "deltaEncode (0, qc)" testDeltaEncode + , testProperty "deltaEncodeBy (0, qc)" testDeltaEncodeBy + , testProperty "evalAtZero (0, qc)" testEvalAtZero + , testProperty "evalAt (0, qc)" testEvalAt + , testProperty "evalFuture (0, qc)" testEvalFuture ] -- * Reactimation @@ -66,8 +85,92 @@ react_t0r = , (2.0,1.50), (2.0,1.70), (2.0,1.90), (2.0,2.10), (2.0,2.30) ] +-- ** Low-level reactimation interface + +testReact :: Property +testReact = + forAll myStream $ \s -> + forAllBlind randomSF $ \sf -> + ioProperty $ do + outs <- reactEmbed sf s + let outsE = embed sf (structure s) + return $ outs == outsE + + where + + myStream :: Gen (SignalSampleStream Integer) + myStream = uniDistStream + + reactEmbed :: SF a b -> SignalSampleStream a -> IO [b] + reactEmbed sf s@(s0, ss) = do + outsRef <- newIORef [] + + let init = return s0 + + actuate _ _ b = modifyIORef outsRef (++ [b]) >> return False + + -- For each sample, add a Just to the value of the sample make the + -- input compatible with what 'react' expects, and use 'react' to + -- run one step of the simulation. + reactEmbed' :: ReactHandle a b -> FutureSampleStream a -> IO () + reactEmbed' rh = mapM_ (react rh . second Just) + + reactHandle <- reactInit init actuate sf + reactEmbed' reactHandle ss + readIORef outsRef + + structure :: (a, [(b, a)]) -> (a, [(b, Maybe a)]) + structure (x, xs) = (x, map (second Just) xs) + -- * Embedding +testEmbed :: Property +testEmbed = testEmbedPointwise + .&&. testEmbedSum + + where + + testEmbedPointwise :: Property + testEmbedPointwise = + forAllBlind function $ \f -> + forAll myStream $ \stream -> + property $ + embed (arr f) (structure stream) == fmap f (plain stream) + + testEmbedSum :: Property + testEmbedSum = + forAll myStream $ \stream -> + property $ + let left :: [Integer] + left = embed sf (structure stream) + + sf :: SF Integer Integer + sf = loopPre 0 (arr (dup . uncurry (+))) + + right :: [Integer] + right = summation (plain stream) + + in left == right + + myStream :: Gen (SignalSampleStream Integer) + myStream = uniDistStream + + function :: Gen (Integer -> Integer) + function = arbitrary + + -- Make each element the sum of all elements up to that point. + summation :: [Integer] -> [Integer] + summation = + -- We add the accumulator to the current value (+), and make that the new + -- value AND the new accumulator (dup). + snd . mapAccumL ((dup .) . (+)) 0 + + plain :: SignalSampleStream a -> [a] + plain (x, xs) = x : fmap snd xs + + structure :: (a, [(b, a)]) -> (a, [(b, Maybe a)]) + structure (x, xs) = (x, map (second Just) xs) + embed_ratio :: SF a Double embed_ratio = switch (constant 1.0 &&& after 5.0 ()) $ \_ -> switch (constant 0.0 &&& after 5.0 ()) $ \_ -> @@ -99,3 +202,217 @@ embed_t1r = , 22.75, 47.50, 81.25, 101.50, 101.50 , 101.50, 101.50, 101.50, 101.50, 101.50 ] + +testDeltaEncode :: Property +testDeltaEncode = testDeltaEncodeSamples + .&&. testDeltaEncodeTimes + + where + + -- True if the samples produced by deltaEncode are not altered + testDeltaEncodeSamples :: Property + testDeltaEncodeSamples = + forAll randomTime $ \t -> + forAll randomSamples $ \s -> + property $ s == streamSamples (deltaEncode t s) + + -- True if the times produced by deltaEncode are not altered + testDeltaEncodeTimes :: Property + testDeltaEncodeTimes = + forAll randomTime $ \t -> + forAll randomSamples $ \s -> + property $ all (== t) $ streamTimes (deltaEncode t s) + +testDeltaEncodeBy :: Property +testDeltaEncodeBy = testDeltaEncodeBySamples + .&&. testDeltaEncodeByTimes + + where + + -- True if the samples produced by deltaEncodeBy are not altered + testDeltaEncodeBySamples :: Property + testDeltaEncodeBySamples = + forAll randomTime $ \t -> + forAll randomSamples $ \s -> + forAllBlind randomPredicate $ \f -> + -- Compare all samples, pair-wise, between the list encoded (s) and + -- the resulting signal samples, using the predicate (f). + property $ simplifyBy f s == streamSamples (deltaEncodeBy f t s) + + where + + -- Simplify a stream by using an equality predicate function. + -- + -- The function simplifyBy models the behavior of deltaEncodeBy, which + -- uses the equality function to compare values. Note that + -- deltaEncodeBy carries the last value forward even if the equality + -- was successful (i.e., even if the output for that step is Nothing). + -- Consequently, when the current value is compared with the last value + -- to determine if the output must be a Nothing or a Just, the current + -- value is not compared to the last value for which the equality test + -- failed, but rather, to the very last value. + -- + -- The behavior of deltaEncodeBy may appear unsual when the equality + -- predicate function provided is not transitive. + simplifyBy :: (a -> a -> Bool) -> [a] -> [a] + simplifyBy f [] = [] + simplifyBy f (x:xs) = x : simplifyBy' f x x xs + where + simplifyBy' :: (a -> a -> Bool) -> a -> a -> [a] -> [a] + simplifyBy' f _acc _cmp [] = [] + simplifyBy' f acc cmp (x:xs) + | f x cmp = acc : simplifyBy' f acc x xs + | otherwise = x : simplifyBy' f x x xs + + -- True if the times produced by deltaEncodeBy are not altered + testDeltaEncodeByTimes :: Property + testDeltaEncodeByTimes = + forAll randomTime $ \t -> + forAll randomSamples $ \s -> + forAllBlind randomPredicate $ \f -> + property $ all (== t) $ streamTimes (deltaEncodeBy f t s) + + -- Predicate on two integer arguments + randomPredicate :: Gen (Integer -> Integer -> Bool) + randomPredicate = arbitrary + +-- * Debugging / Step by step simulation + +testEvalAtZero :: Property +testEvalAtZero = testEvalAtZero1 + .&&. testEvalAtZero2 + + where + + testEvalAtZero1 :: Property + testEvalAtZero1 = + forAllBlind randomSF $ \sf -> + forAll arbitrary $ \x -> + fst (evalAtZero sf x) == head (embed sf (x, [])) + + testEvalAtZero2 :: Property + testEvalAtZero2 = + forAllBlind randomSF2 $ \sf -> + forAll arbitrary $ \x -> + fst (evalAtZero sf x) == head (embed sf (x, [])) + +testEvalAt :: Property +testEvalAt = testEvalAt1 + .&&. testEvalAt2 + + where + + testEvalAt1 :: Property + testEvalAt1 = + forAllBlind randomSF $ \sf -> + forAll arbitrary $ \x1 -> + forAll arbitrary $ \x2 -> + forAll randomTime $ \t -> + let + -- Value (fst) of simulation after one step with evalAtZero, and + -- another step with evalAt + eval1Val = fst $ evalAt (snd (evalAtZero sf x1)) t x2 + + -- Second sample (!!1) of result of embedding with stream with two + -- samples + embed1Val = (embed sf (x1, [(t, Just x2)])) !! 1 + + in eval1Val == embed1Val + + testEvalAt2 :: Property + testEvalAt2 = + forAllBlind randomSF2 $ \sf -> + forAll arbitrary $ \x1 -> + forAll arbitrary $ \x2 -> + forAll randomTime $ \t -> + let + -- Value (fst) of simulation after one step with evalAtZero, and + -- another step with evalAt + eval1Val = fst $ evalAt (snd (evalAtZero sf x1)) t x2 + + -- Second sample (!!1) of result of embedding with stream with two + -- samples + embed1Val = (embed sf (x1, [(t, Just x2)])) !! 1 + + in eval1Val == embed1Val + +testEvalFuture :: Property +testEvalFuture = testEvalFuture1 + .&&. testEvalFuture2 + + where + + testEvalFuture1 :: Property + testEvalFuture1 = + forAllBlind randomSF $ \sf -> + forAll myStream1 $ \s -> + unroll sf s == embed sf (structure s) + where + myStream1 :: Gen (SignalSampleStream Integer) + myStream1 = uniDistStream + + testEvalFuture2 :: Property + testEvalFuture2 = + forAllBlind randomSF2 $ \sf -> + forAll myStream2 $ \s -> + unroll sf s == embed sf (structure s) + where + myStream2 :: Gen (SignalSampleStream (Integer, Integer)) + myStream2 = uniDistStream + + -- Apply an SF to a stream of inputs manually, using evalAtZero and + -- evalFuture, and collect the outputs + unroll :: SF a b -> (a, [(DTime, a)]) -> [b] + unroll sf (s1, []) = [ fst $ evalAtZero sf s1 ] + unroll sf (s1, (dt, s2):ss) = o1 : unroll sf' (s2, ss) + where + (o1, sf') = evalFuture sf s1 dt + + structure :: (a, [(b, a)]) -> (a, [(b, Maybe a)]) + structure (x, xs) = (x, map (second Just) xs) + +-- * Auxiliary + +-- | Generate a random positive time delta. +randomTime :: Gen Double +randomTime = getPositive <$> arbitrary + +-- | Generate multiple random integer samples. +randomSamples :: Gen [Integer] +randomSamples = getNonEmpty <$> arbitrary + +-- | Generator of random signal functions on integers. +randomSF :: Gen (SF Integer Integer) +randomSF = oneof [ return identity + , pointwiseSF + , loopPre <$> arbitrary <*> randomSF2 + ] + +-- | Generator of random signal functions on integer pairs. +randomSF2 :: Gen (SF (Integer, Integer) (Integer, Integer)) +randomSF2 = oneof [ return identity + , pointwiseSF2 + ] + +-- | Generator of random pointwise signal functions on integers. +pointwiseSF :: Gen (SF Integer Integer) +pointwiseSF = arr <$> arbitrary + +-- | Generator of random pointwise signal functions on integer pairs. +pointwiseSF2 :: Gen (SF (Integer, Integer) (Integer, Integer)) +pointwiseSF2 = arr <$> arbitrary + +-- | Extract the samples from an "optimized" stream. +streamSamples :: (a, [(DTime, Maybe a)]) -> [a] +streamSamples (a, as) = a : streamSamples' a (fmap snd as) + where + streamSamples' :: a -> [Maybe a] -> [a] + streamSamples' acc = + -- We pick one between the accumulator to the current value + -- if available (fromMaybe), and make that the new value AND the + -- new accumulator (dup). + snd . mapAccumL ((dup .) . fromMaybe) acc + +-- | Extract the times from an "optimized" stream. +streamTimes :: (a, [(DTime, Maybe a)]) -> [DTime] +streamTimes = map fst . snd diff --git a/yampa-test/tests/Test/FRP/Yampa/Switches.hs b/yampa-test/tests/Test/FRP/Yampa/Switches.hs index f10b6503..1045d01c 100644 --- a/yampa-test/tests/Test/FRP/Yampa/Switches.hs +++ b/yampa-test/tests/Test/FRP/Yampa/Switches.hs @@ -1,4 +1,5 @@ {-# LANGUAGE Arrows #-} +{-# LANGUAGE CPP #-} -- | -- Description : Test cases for FRP.Yampa.Switches -- Copyright : (c) Ivan Perez, 2014-2022 @@ -12,6 +13,11 @@ module Test.FRP.Yampa.Switches ) where +#if __GLASGOW_HASKELL__ < 710 +import Control.Applicative (pure, (<*>)) +import Data.Functor ((<$>)) +#endif + import Data.Fixed import Data.List (findIndex) import Data.Maybe (fromJust) @@ -21,7 +27,8 @@ import Test.Tasty (TestTree, testGroup) import Test.Tasty.QuickCheck (testProperty) import FRP.Yampa as Yampa -import FRP.Yampa.Switches (rpSwitchZ) +import FRP.Yampa.Switches (dpSwitchZ, drpSwitchZ, pSwitchZ, parC, parZ, + rpSwitchZ) import FRP.Yampa.EventS (snap) import FRP.Yampa.Stream import FRP.Yampa.QuickCheck @@ -60,7 +67,17 @@ tests = testGroup "Regression tests for FRP.Yampa.Switches" , testProperty "rpswitch (1, fixed)" (property $ rpswitch_t1 ~= rpswitch_t1r) , testProperty "rpswitch (3, fixed)" (property $ rpswitch_t3 ~= rpswitch_t3r) , testProperty "rpswitch (4, fixed)" (property $ rpswitch_t4 ~= rpswitch_t4r) + , testProperty "par (0, qc)" propPar + , testProperty "pSwitch (0, qc)" propPSwitch + , testProperty "dpSwitch (0, qc)" propDPSwitch + , testProperty "rpSwitch (0, qc)" propRPSwitch + , testProperty "drpSwitch (0, qc)" propDRPSwitch + , testProperty "parZ (0, qc)" propParZ + , testProperty "pSwitchZ (0, qc)" propPSwitchZ + , testProperty "dpSwitchZ (0, qc)" propDPSwitchZ , testProperty "rpSwitchZ (0, fixed)" (property $ utils_t6 ~= utils_t6r) + , testProperty "drpSwitchZ (0, qc)" propDRPSwitchZ + , testProperty "parC (0, qc)" propParC ] -- * Basic switching @@ -966,10 +983,935 @@ rpswitch_t4r = , [2.8, 0.8, 1.8] ] +-- ** With helper routing function + +propPar :: Property +propPar = + forAllBlind genSFs $ \sfs -> + forAll (genPos (length sfs)) $ \n -> + forAll myStream $ evalT $ + Always $ SP $ (originalSF sfs n &&& modelSF sfs n) >>^ uncurry (==) + + where + + -- SF under test: Apply par and look at one specific value only. + originalSF :: [SF Int Int] -> Int -> SF Int Int + originalSF sfs n = par broad sfs >>^ (!! n) + + -- Model SF: Pick an SF from a given list and apply only that SF to the + -- corresponding input using the routing function. + modelSF :: [SF Int Int] -> Int -> SF Int Int + modelSF sfs n = (fst . (!! n) . (`broad` sfs)) ^>> sfs !! n + + -- Generator: Random non-empty list of SFs. + genSFs :: Gen [SF Int Int] + genSFs = listOf1 randomSF + + -- Generator: Random position in a list of the given length. + genPos :: Int -> Gen Int + genPos n = chooseInt (0, n - 1) + + -- Generator: Random input stream generator. + myStream :: Gen (SignalSampleStream Int) + myStream = uniDistStream + + -- Pair list with element. + broad :: a -> [b] -> [(a, b)] + broad a = map (\x -> (a, x)) + +propPSwitch :: Property +propPSwitch = propPSwitchNoSwitch + .&&. propPSwitchSwitch0 + .&&. propPSwitchSwitchN + + where + + propPSwitchNoSwitch :: Property + propPSwitchNoSwitch = + forAllBlind genSFs $ \sfs -> + forAll (genPos (length sfs)) $ \n -> + forAll myStream $ evalT $ + Always $ SP $ (originalSF sfs n &&& modelSF sfs n) >>^ uncurry (==) + + where + + -- SF under test: Apply pSwitch with a broadcasting and modification + -- function but never switch and look at one specific value only. + originalSF :: [SF Int Int] -> Int -> SF Int Int + originalSF sfs n = pSwitch broad sfs never undefined >>^ (!! n) + + -- Model SF: Pick an SF from a given list and apply only that SF to the + -- corresponding input using the routing function. + modelSF :: [SF Int Int] -> Int -> SF Int Int + modelSF sfs n = (fst . (!! n) . (`broad` sfs)) ^>> sfs !! n + + -- Generator: Random non-empty list of SFs. + genSFs :: Gen [SF Int Int] + genSFs = listOf1 randomSF + + -- Generator: Random position in a list of the given length. + genPos :: Int -> Gen Int + genPos n = chooseInt (0, n - 1) + + -- Generator: Random input stream generator. + myStream :: Gen (SignalSampleStream Int) + myStream = uniDistStream + + -- Pair list with element, modifying the element to make each input + -- unique. + broad :: Int -> [b] -> [(Int, b)] + broad a sfs = map (\(i, x) -> (a + i, x)) $ zip [0..] sfs + + propPSwitchSwitch0 :: Property + propPSwitchSwitch0 = + forAllBlind genSFs $ \sfs -> + forAllBlind genCont $ \cont -> + forAll myStream $ evalT $ + Always $ SP $ + (originalSF sfs cont &&& modelSF sfs cont) >>^ uncurry (==) + + where + + -- SF under test: Apply pSwitch with a broadcasting and modification + -- function but switch immediately and look at one specific value only. + originalSF :: [SF Int Int] + -> ([SF Int Int] -> () -> SF Int [Int]) + -> SF Int [Int] + originalSF sfs cont = pSwitch broad sfs (now ()) cont + + -- Model SF: The behavior with pSwitch if we switch immediately is that + -- produced using the continuation function to select the new SFs. + modelSF :: [SF Int Int] + -> ([SF Int Int] -> () -> SF Int [Int]) + -> SF Int [Int] + modelSF sfs cont = cont sfs () + + -- Generator: Random non-empty list of SFs. + genSFs :: Gen [SF Int Int] + genSFs = listOf1 randomSF + + -- Generator: Random continuations. + genCont :: Gen ([SF Int Int] -> () -> SF Int [Int]) + genCont = oneof + [ -- Run same SFs in parallel + pure (\sfs _ -> parB sfs) + + , -- Pick one SF from the input list, and replicate it as many + -- times as SFs were given, and run it in parallel. + arbitrary >>= \n -> + let pick :: [SF Int Int] -> Int -> SF Int Int + pick sfs i = sfs !! (i `mod` length sfs) + in pure (\sfs _ -> parB (replicate (length sfs) (pick sfs n))) + + , -- Generate SF randomly, replicate it as many times as SFs were + -- given, and run that in parallel. + randomSF >>= \sf -> + pure (\sfs _ -> parB (replicate (length sfs) sf)) + + , -- Generate random list of SFs with the same length as the given + -- list of SFs, and run in parallel. + listOf1 randomSF >>= \sfs' -> + let replic l sfs = take l $ concat $ repeat sfs + in pure (\sfs _ -> parB (replic (length sfs) sfs')) + ] + + -- Generator: Random input stream generator. + myStream :: Gen (SignalSampleStream Int) + myStream = uniDistStream + + -- Pair list with element. + broad :: a -> [b] -> [(a, b)] + broad a = map (\x -> (a, x)) + + propPSwitchSwitchN :: Property + propPSwitchSwitchN = + forAllBlind genSFs $ \sfs -> + forAllBlind genEventS $ \eventSwitch -> + forAllBlind genCont $ \cont -> + forAll myStream $ evalT $ + Always $ SP $ + (originalSF sfs eventSwitch cont &&& modelSF sfs eventSwitch cont) + >>^ uncurry (==) + + where + + -- SF under test: Apply pSwitch with a broadcasting, and switch at a + -- random time. + originalSF :: [SF Int Int] + -> SF (Int, [Int]) (Event ()) + -> ([SF Int Int] -> () -> SF Int [Int]) + -> SF Int [Int] + originalSF sfs eventSwitch cont = pSwitch broad sfs eventSwitch cont + + -- Model SF: Run several SFs in parallel indefinitely. This works + -- because the continuation function generated below in 'genCont' will + -- keep running the same continuations in parallel. + modelSF :: [SF Int Int] + -> SF (Int, [Int]) (Event ()) + -> ([SF Int Int] -> () -> SF Int [Int]) + -> SF Int [Int] + modelSF sfs _eventSwitch _cont = parB sfs + + -- Generator: Random non-empty list of SFs. + genSFs :: Gen [SF Int Int] + genSFs = listOf1 randomSF + + -- Generator: Random continuations. + genCont :: Gen ([SF Int Int] -> () -> SF Int [Int]) + genCont = pure (\sfs _ -> parB sfs) + + -- Generator: SF that will fire an event at a random time. + genEventS :: Gen (SF (Int, [Int]) (Event ())) + genEventS = randomTime >>= \dt -> + pure (after dt ()) + + -- Generator: Random input stream generator. + myStream :: Gen (SignalSampleStream Int) + myStream = uniDistStream + + -- Pair list with element. + broad :: a -> [b] -> [(a, b)] + broad a = map (\x -> (a, x)) + +propDPSwitch :: Property +propDPSwitch = propDPSwitchNoSwitch + .&&. propDPSwitchSwitch0 + .&&. propDPSwitchSwitchN + + where + + propDPSwitchNoSwitch :: Property + propDPSwitchNoSwitch = + forAllBlind genSFs $ \sfs -> + forAll (genPos (length sfs)) $ \n -> + forAll myStream $ evalT $ + Always $ SP $ (originalSF sfs n &&& modelSF sfs n) >>^ uncurry (==) + + where + + -- SF under test: Apply dpSwitch with a broadcasting and modification + -- function but never switch and look at one specific value only. + originalSF :: [SF Int Int] -> Int -> SF Int Int + originalSF sfs n = dpSwitch broad sfs never undefined >>^ (!! n) + + -- Model SF: Pick an SF from a given list and apply only that SF to the + -- corresponding input using the routing function. + modelSF :: [SF Int Int] -> Int -> SF Int Int + modelSF sfs n = (fst . (!! n) . (`broad` sfs)) ^>> sfs !! n + + -- Generator: Random non-empty list of SFs. + genSFs :: Gen [SF Int Int] + genSFs = listOf1 randomSF + + -- Generator: Random position in a list of the given length. + genPos :: Int -> Gen Int + genPos n = chooseInt (0, n - 1) + + -- Generator: Random input stream generator. + myStream :: Gen (SignalSampleStream Int) + myStream = uniDistStream + + -- Pair list with element. + broad :: Int -> [b] -> [(Int, b)] + broad a sfs = map (\(i, x) -> (a + i, x)) $ zip [0..] sfs + + propDPSwitchSwitch0 :: Property + propDPSwitchSwitch0 = + forAllBlind genSFs $ \sfs -> + forAllBlind genCont $ \cont -> + forAll myStream $ evalT $ + And (SP $ + (originalSF sfs cont &&& modelSF0 sfs cont) >>^ uncurry (==) + ) + (Next $ Always $ SP $ + (originalSF sfs cont &&& modelSFN sfs cont) >>^ uncurry (==) + ) + + where + + -- SF under test: Apply dpSwitch with a broadcasting and modification + -- function but never switch and look at one specific value only. + originalSF :: [SF Int Int] + -> ([SF Int Int] -> () -> SF Int [Int]) + -> SF Int [Int] + originalSF sfs cont = dpSwitch broad sfs (now ()) cont + + -- Model SF: At time 0, the behavior of dpSwitch is the same as picking + -- an SF from the argument list and applying only that SF to the + -- corresponding input of the final SF. + modelSF0 :: [SF Int Int] + -> ([SF Int Int] -> () -> SF Int [Int]) + -> SF Int [Int] + modelSF0 sfs _cont = parB sfs + + -- Model SF: The behavior of dpSwitch if we switch immediately, after + -- time 0, is that produced using the continuation function to select + -- the new SFs. + modelSFN :: [SF Int Int] + -> ([SF Int Int] -> () -> SF Int [Int]) + -> SF Int [Int] + modelSFN sfs cont = cont sfs () + + -- Generator: Random non-empty list of SFs. + genSFs :: Gen [SF Int Int] + genSFs = listOf1 randomSF + + -- Generator: Random continuations. + genCont :: Gen ([SF Int Int] -> () -> SF Int [Int]) + genCont = oneof + [ -- Run same SFs in parallel. + pure (\sfs _ -> parB sfs) + + , -- Pick one SF from the input list, replicate it as many + -- times as SFs were given, and run it in parallel. + arbitrary >>= \n -> + let pick :: [SF Int Int] -> Int -> SF Int Int + pick sfs i = sfs !! (i `mod` length sfs) + in pure (\sfs _ -> parB (replicate (length sfs) (pick sfs n))) + + , -- Generate SF randomly and run that in parallel. + randomSF >>= \sf -> + pure (\sfs _ -> parB (replicate (length sfs) sf)) + + , -- Generate random list of SFs with the same length as the given + -- list of SFs, and run in parallel. + listOf1 randomSF >>= \sfs' -> + let replic l sfs = take l $ concat $ repeat sfs + in pure (\sfs _ -> parB (replic (length sfs) sfs')) + ] + + -- Generator: Random input stream generator. + myStream :: Gen (SignalSampleStream Int) + myStream = uniDistStream + + -- Pair list with element. + broad :: a -> [b] -> [(a, b)] + broad a = map (\x -> (a, x)) + + propDPSwitchSwitchN :: Property + propDPSwitchSwitchN = + forAllBlind genSFs $ \sfs -> + forAllBlind genEventS $ \eventSwitch -> + forAllBlind genCont $ \cont -> + forAll myStream $ evalT $ + Always $ SP $ + (originalSF sfs eventSwitch cont &&& modelSF sfs eventSwitch cont) + >>^ uncurry (==) + + where + + -- SF under test: Apply dpSwitch with a broadcasting, and switch at a + -- random time. + originalSF :: [SF Int Int] + -> SF (Int, [Int]) (Event ()) + -> ([SF Int Int] -> () -> SF Int [Int]) + -> SF Int [Int] + originalSF = dpSwitch broad + + -- Model SF: Run several SFs in parallel indefinitely. This works + -- because the continuation function generated below in 'genCont' will + -- keep running the same continuations in parallel. + modelSF :: [SF Int Int] + -> SF (Int, [Int]) (Event ()) + -> ([SF Int Int] -> () -> SF Int [Int]) + -> SF Int [Int] + modelSF sfs _eventSwitch _cont = parB sfs + + -- Generator: Random non-empty list of SFs. + genSFs :: Gen [SF Int Int] + genSFs = listOf1 randomSF + + -- Generator: Random continuations. + genCont :: Gen ([SF Int Int] -> () -> SF Int [Int]) + genCont = pure (\sfs _ -> parB sfs) + + -- Generator: SF that will fire an event at a random time. + genEventS :: Gen (SF (Int, [Int]) (Event ())) + genEventS = randomTime >>= \dt -> + pure (after dt ()) + + -- Generator: Random input stream generator. + myStream :: Gen (SignalSampleStream Int) + myStream = uniDistStream + + -- Pair list with element. + broad :: a -> [b] -> [(a, b)] + broad a = map (\x -> (a, x)) + +propRPSwitch :: Property +propRPSwitch = propRPSwitchNoSwitch + .&&. propRPSwitchSwitch0 + .&&. propRPSwitchSwitchNId + + where + + propRPSwitchNoSwitch :: Property + propRPSwitchNoSwitch = + forAllBlind genSFs $ \sfs -> + forAll myStream $ evalT $ + Always $ SP $ (originalSF sfs &&& modelSF sfs) >>^ uncurry (==) + + where + + -- SF under test: rpSwitch but never switch. + originalSF :: [SF Int Int] -> SF Int [Int] + originalSF sfs = (identity &&& never) >>> rpSwitch broad sfs + + -- Model SF: With no switching, rpSwitch behaves like parB. + modelSF :: [SF Int Int] -> SF Int [Int] + modelSF = parB + + -- Generator: Random non-empty list of SFs. + genSFs :: Gen [SF Int Int] + genSFs = listOf1 randomSF + + -- Generator: Random input stream generator. + myStream :: Gen (SignalSampleStream Int) + myStream = uniDistStream + + -- Pair list with element. + broad :: a -> [b] -> [(a, b)] + broad a = map (\x -> (a, x)) + + propRPSwitchSwitch0 :: Property + propRPSwitchSwitch0 = + forAllBlind genSFs $ \sfs -> + forAll myStream $ evalT $ + Always $ SP $ (originalSF sfs &&& modelSF sfs) >>^ uncurry (==) + + where + + -- SF under test: rpSwitch that switches immediately. + originalSF :: [SF Int Int] -> SF Int [Int] + originalSF sfs = (identity &&& now reverse) >>> rpSwitch broad sfs + + -- Model SF: With immediate switching, rpSwitch behaves like (parB . + -- reverse). + modelSF :: [SF Int Int] -> SF Int [Int] + modelSF = parB . reverse + + -- Generator: Random non-empty list of SFs. + genSFs :: Gen [SF Int Int] + genSFs = listOf1 randomSF + + -- Generator: Random input stream generator. + myStream :: Gen (SignalSampleStream Int) + myStream = uniDistStream + + -- Pair list with element. + broad :: a -> [b] -> [(a, b)] + broad a = map (\x -> (a, x)) + + propRPSwitchSwitchNId :: Property + propRPSwitchSwitchNId = + forAllBlind genSFs $ \sfs -> + forAll myStream $ evalT $ + Always $ SP $ + (originalSF sfs &&& modelSF sfs) >>^ uncurry (==) + + where + + -- SF under test: rpSwitch that switches at some random time but + -- leaves the list of SFs unchanged. + originalSF :: [SF Int Int] + -> SF (Int, Event ()) [Int] + originalSF sfs = (identity *** arr (tagWith id)) >>> rpSwitch broad sfs + + -- Model SF: If you switch to the input sfs, it's like never switching. + modelSF :: [SF Int Int] + -> SF (Int, Event ()) [Int] + modelSF sfs = fst ^>> parB sfs + + -- Generator: Random non-empty list of SFs. + genSFs :: Gen [SF Int Int] + genSFs = listOf1 randomSF + + -- Generator: Random input stream generator. + myStream :: Gen (SignalSampleStream (Int, Event ())) + myStream = uniDistStream + + -- Pair list with element. + broad :: a -> [b] -> [(a, b)] + broad a = map (\x -> (a, x)) + +propDRPSwitch :: Property +propDRPSwitch = propDRPSwitchNoSwitch + .&&. propDRPSwitchSwitch0 + .&&. propDRPSwitchSwitchNId + + where + + propDRPSwitchNoSwitch :: Property + propDRPSwitchNoSwitch = + forAllBlind genSFs $ \sfs -> + forAll myStream $ evalT $ + Always $ SP $ (originalSF sfs &&& modelSF sfs) >>^ uncurry (==) + + where + + -- SF under test: drpSwitch but never switch. + originalSF :: [SF Int Int] -> SF Int [Int] + originalSF sfs = (identity &&& never) >>> drpSwitch broad sfs + + -- Model SF: With no switching, drpSwitch behaves like parB. + modelSF :: [SF Int Int] -> SF Int [Int] + modelSF = parB + + -- Generator: Random non-empty list of SFs. + genSFs :: Gen [SF Int Int] + genSFs = listOf1 randomSF + + -- Generator: Random input stream generator. + myStream :: Gen (SignalSampleStream Int) + myStream = uniDistStream + + -- Pair list with element. + broad :: a -> [b] -> [(a, b)] + broad a = map (\x -> (a, x)) + + propDRPSwitchSwitch0 :: Property + propDRPSwitchSwitch0 = + forAllBlind genSFs $ \sfs -> + forAll myStream $ evalT $ + And (SP $ + (originalSF sfs &&& modelSF0 sfs) >>^ uncurry (==) + ) + (Next $ Always $ SP $ + (originalSF sfs &&& modelSFN sfs) >>^ uncurry (==) + ) + + where + + -- SF under test: drpSwitch that switches immediately. + originalSF :: [SF Int Int] -> SF Int [Int] + originalSF sfs = (identity &&& now reverse) >>> drpSwitch broad sfs + + -- Model SF: With immediate switching, drpSwitch behaves like parB + -- at time 0. + modelSF0 :: [SF Int Int] -> SF Int [Int] + modelSF0 = parB + + -- Model SF: With immediate switching, drpSwitch behaves like (parB . + -- reverse) at times greater than 0. + modelSFN :: [SF Int Int] -> SF Int [Int] + modelSFN = parB . reverse + + -- Generator: Random non-empty list of SFs. + genSFs :: Gen [SF Int Int] + genSFs = listOf1 randomSF + + -- Generator: Random input stream generator. + myStream :: Gen (SignalSampleStream Int) + myStream = uniDistStream + + -- Pair list with element. + broad :: a -> [b] -> [(a, b)] + broad a = map (\x -> (a, x)) + + propDRPSwitchSwitchNId :: Property + propDRPSwitchSwitchNId = + forAllBlind genSFs $ \sfs -> + forAll myStream $ evalT $ + Always $ SP $ + (originalSF sfs &&& modelSF sfs) >>^ uncurry (==) + + where + + -- SF under test: drpSwitch that switches at some random time but + -- leaves the list of SFs unchanged. + originalSF :: [SF Int Int] + -> SF (Int, Event ()) [Int] + originalSF sfs = (identity *** arr (tagWith id)) >>> drpSwitch broad sfs + + -- Model SF: If you switch to the input sfs, it's like never switching. + modelSF :: [SF Int Int] + -> SF (Int, Event ()) [Int] + modelSF sfs = fst ^>> parB sfs + + -- Generator: Random non-empty list of SFs. + genSFs :: Gen [SF Int Int] + genSFs = listOf1 randomSF + + -- Generator: Random input stream generator. + myStream :: Gen (SignalSampleStream (Int, Event ())) + myStream = uniDistStream + + -- Pair list with element. + broad :: a -> [b] -> [(a, b)] + broad a = map (\x -> (a, x)) + -- * Parallel composition\/switching (lists) -- -- ** With "zip" routing +propParZ :: Property +propParZ = + forAllBlind genSFs $ \sfs -> + forAll (genPos (length sfs)) $ \n -> + forAll (myStream (length sfs)) $ evalT $ + Always $ SP $ (originalSF sfs n &&& modelSF sfs n) >>^ uncurry (==) + + where + + -- SF under test: Apply parZ and look at one specific value only. + originalSF :: [SF Int Int] -> Int -> SF [Int] Int + originalSF sfs n = parZ sfs >>^ (!! n) + + -- Model SF: Pick an SF from a given list and apply only that SF to the + -- corresponding input of the final SF. + modelSF :: [SF Int Int] -> Int -> SF [Int] Int + modelSF sfs n = (!! n) ^>> (sfs !! n) + + -- Generator: Random non-empty list of SFs. + genSFs :: Gen [SF Int Int] + genSFs = listOf1 randomSF + + -- Generator: Random position in a list of the given length. + genPos :: Int -> Gen Int + genPos n = chooseInt (0, n - 1) + + -- Generator: Random input stream generator where the lists generated + -- have the given length. + myStream :: Int -> Gen (SignalSampleStream [Int]) + myStream n = + -- This is uniDistStream with a custom value generator. + generateStreamWith valueGenerator DistRandom (Nothing, Nothing) Nothing + where + -- Ensure that the values generated (lists) have the expected + -- length. + valueGenerator :: Int -> DTime -> Gen [Int] + valueGenerator _ _ = vectorOf n arbitrary + +propPSwitchZ :: Property +propPSwitchZ = propPSwitchZNoSwitch + .&&. propPSwitchZSwitch0 + .&&. propPSwitchZSwitchN + + where + + propPSwitchZNoSwitch :: Property + propPSwitchZNoSwitch = + forAllBlind genSFs $ \sfs -> + forAll (myStream (length sfs)) $ evalT $ + Always $ SP $ (originalSF sfs &&& modelSF sfs) >>^ uncurry (==) + + where + + -- SF under test: pSwitchZ but never switch. + originalSF :: [SF Int Int] -> SF [Int] [Int] + originalSF sfs = + -- We pass undefined in the third argument on purpose, so that there + -- is an exception if pSwitchZ tries to switch and the test fails. + pSwitchZ sfs never undefined + + -- Model SF: With no switching, pSwitchZ behaves like parZ. + modelSF :: [SF Int Int] -> SF [Int] [Int] + modelSF = parZ + + -- Generator: Random non-empty list of SFs. + genSFs :: Gen [SF Int Int] + genSFs = listOf1 randomSF + + -- Generator: Random input stream generator where the lists generated + -- have the given length. + myStream :: Int -> Gen (SignalSampleStream [Int]) + myStream n = + -- This is uniDistStream with a custom value generator. + generateStreamWith + valueGenerator DistRandom (Nothing, Nothing) Nothing + where + -- Ensure that the values generated (lists) have the expected + -- length. + valueGenerator :: Int -> DTime -> Gen [Int] + valueGenerator _ _ = vectorOf n arbitrary + + propPSwitchZSwitch0 :: Property + propPSwitchZSwitch0 = + forAllBlind genSFs $ \sfs -> + forAllBlind genCont $ \cont -> + forAll (myStream (length sfs)) $ evalT $ + Always $ SP $ + (originalSF sfs cont &&& modelSF sfs cont) >>^ uncurry (==) + + where + + -- SF under test: pSwitchZ that switches immediately. + originalSF :: [SF Int Int] + -> ([SF Int Int] -> () -> SF [Int] [Int]) + -> SF [Int] [Int] + originalSF sfs cont = pSwitchZ sfs (now ()) cont + + -- Model SF: The behavior with pSwitchZ if we switch immediately is + -- that produced using the continuation function to select the new SFs. + modelSF :: [SF Int Int] + -> ([SF Int Int] -> () -> SF [Int] [Int]) + -> SF [Int] [Int] + modelSF sfs cont = cont sfs () + + -- Generator: Random non-empty list of SFs. + genSFs :: Gen [SF Int Int] + genSFs = listOf1 randomSF + + -- Generator: Random continuations. + genCont :: Gen ([SF Int Int] -> () -> SF [Int] [Int]) + genCont = oneof + [ -- Run same SFs in parallel. + pure (\sfs _ -> parZ sfs) + + , -- Pick one SF from the input list, and run that in parallel. + arbitrary >>= \n -> + let pick :: [SF Int Int] -> Int -> SF Int Int + pick sfs i = sfs !! (i `mod` length sfs) + in pure (\sfs _ -> parC (pick sfs n)) + + , -- Generate SF randomly and run that in parallel. + randomSF >>= \sf -> pure (\_ _ -> parC sf) + + , -- Generate random list of SFs with the same length as the given + -- list of SFs, and run in parallel. + listOf1 randomSF >>= \sfs' -> + let replic l sfs = take l $ concat $ repeat sfs + in pure (\sfs _ -> parZ (replic (length sfs) sfs')) + ] + + -- Generator: Random input stream generator where the lists generated + -- have the given length. + myStream :: Int -> Gen (SignalSampleStream [Int]) + myStream n = + -- This is uniDistStream with a custom value generator. + generateStreamWith + valueGenerator DistRandom (Nothing, Nothing) Nothing + where + -- Ensure that the values generated (lists) have the expected + -- length. + valueGenerator :: Int -> DTime -> Gen [Int] + valueGenerator _ _ = vectorOf n arbitrary + + propPSwitchZSwitchN :: Property + propPSwitchZSwitchN = + forAllBlind genSFs $ \sfs -> + forAllBlind genEventS $ \eventSwitch -> + forAllBlind genCont $ \cont -> + forAll (myStream (length sfs)) $ evalT $ + Always $ SP $ + (originalSF sfs eventSwitch cont &&& modelSF sfs eventSwitch cont) + >>^ uncurry (==) + + where + + -- SF under test: pSwitchZ that switches at some random time. + originalSF :: [SF Int Int] + -> (SF ([Int], [Int]) (Event ())) + -> ([SF Int Int] -> () -> SF [Int] [Int]) + -> SF [Int] [Int] + originalSF = pSwitchZ + + -- Model SF: If you switch to the input sfs, it's like never switching. + -- + -- This equality only holds because of how genCont is being generated. + modelSF :: [SF Int Int] + -> (SF ([Int], [Int]) (Event ())) + -> ([SF Int Int] -> () -> SF [Int] [Int]) + -> SF [Int] [Int] + modelSF sfs _eventSwitch _cont = parZ sfs + + -- Generator: Random non-empty list of SFs. + genSFs :: Gen [SF Int Int] + genSFs = listOf1 randomSF + + -- Generator: Continuation that switches to the same input streams. + genCont :: Gen ([SF Int Int] -> () -> SF [Int] [Int]) + genCont = pure (\sfs _ -> parZ sfs) + + -- Generator: SF that will fire an event at a random time. + genEventS :: Gen (SF ([Int], [Int]) (Event ())) + genEventS = randomTime >>= \dt -> + pure (after dt ()) + + -- Generator: Random input stream generator where the lists generated + -- have the given length. + myStream :: Int -> Gen (SignalSampleStream [Int]) + myStream n = + -- This is uniDistStream with a custom value generator. + generateStreamWith + valueGenerator DistRandom (Nothing, Nothing) Nothing + where + -- Ensure that the values generated (lists) have the expected + -- length. + valueGenerator :: Int -> DTime -> Gen [Int] + valueGenerator _ _ = vectorOf n arbitrary + +propDPSwitchZ :: Property +propDPSwitchZ = propDPSwitchZNoSwitch + .&&. propDPSwitchZSwitch0 + .&&. propDPSwitchZSwitchN + + where + + propDPSwitchZNoSwitch :: Property + propDPSwitchZNoSwitch = + forAllBlind genSFs $ \sfs -> + forAll (myStream (length sfs)) $ evalT $ + Always $ SP $ (originalSF sfs &&& modelSF sfs) >>^ uncurry (==) + + where + + -- SF under test: dpSwitchZ but never switch. + originalSF :: [SF Int Int] -> SF [Int] [Int] + originalSF sfs = + -- We pass undefined in the third argument on purpose, so that there + -- is an exception if dpSwitchZ tries to switch and the test fails. + dpSwitchZ sfs never undefined + + -- Model SF: With no switching, dpSwitchZ behaves like parZ. + modelSF :: [SF Int Int] -> SF [Int] [Int] + modelSF = parZ + + -- Generator: Random non-empty list of SFs. + genSFs :: Gen [SF Int Int] + genSFs = listOf1 randomSF + + -- Generator: Random input stream generator where the lists generated + -- have the given length. + myStream :: Int -> Gen (SignalSampleStream [Int]) + myStream n = + -- This is uniDistStream with a custom value generator. + generateStreamWith + valueGenerator DistRandom (Nothing, Nothing) Nothing + where + -- Ensure that the values generated (lists) have the expected + -- length. + valueGenerator :: Int -> DTime -> Gen [Int] + valueGenerator _ _ = vectorOf n arbitrary + + propDPSwitchZSwitch0 :: Property + propDPSwitchZSwitch0 = + forAllBlind genSFs $ \sfs -> + forAllBlind genCont $ \cont -> + forAll (myStream (length sfs)) $ evalT $ + And (SP $ + (originalSF sfs cont &&& modelSF0 sfs cont) >>^ uncurry (==) + ) + (Next $ Always $ SP $ + (originalSF sfs cont &&& modelSFN sfs cont) >>^ uncurry (==) + ) + + where + + -- SF under test: dpSwitchZ that switches immediately. + originalSF :: [SF Int Int] + -> ([SF Int Int] -> () -> SF [Int] [Int]) + -> SF [Int] [Int] + originalSF sfs cont = dpSwitchZ sfs (now ()) cont + + -- Model SF: With immediate switching, dpSwitchZ behaves like parZ at + -- time 0. + modelSF0 :: [SF Int Int] + -> ([SF Int Int] -> () -> SF [Int] [Int]) + -> SF [Int] [Int] + modelSF0 sfs _cont = parZ sfs + + -- Model SF: The behavior of dpSwitchZ if we switch immediately, after + -- time 0, is that produced using the continuation function to select + -- the new SFs. + modelSFN :: [SF Int Int] + -> ([SF Int Int] -> () -> SF [Int] [Int]) + -> SF [Int] [Int] + modelSFN sfs cont = cont sfs () + + -- Generator: Random non-empty list of SFs. + genSFs :: Gen [SF Int Int] + genSFs = listOf1 randomSF + + -- Generator: Random continuations. + genCont :: Gen ([SF Int Int] -> () -> SF [Int] [Int]) + genCont = oneof + [ -- Run same SFs in parallel. + pure (\sfs _ -> parZ sfs) + + , -- Pick one SF from the input list, and run that in parallel + arbitrary >>= \n -> + let pick :: [SF Int Int] -> Int -> SF Int Int + pick sfs i = sfs !! (i `mod` length sfs) + in pure (\sfs _ -> parC (pick sfs n)) + + , -- Generate SF randomly and run that in parallel + randomSF >>= \sf -> pure (\_ _ -> parC sf) + + , -- Generate random list of SFs with the same length as the given + -- list of SFs, and run in parallel. + listOf1 randomSF >>= \sfs' -> + let replic l sfs = take l $ concat $ repeat sfs + in pure (\sfs _ -> parZ (replic (length sfs) sfs')) + ] + + -- Generator: Random input stream generator where the lists generated + -- have the given length. + myStream :: Int -> Gen (SignalSampleStream [Int]) + myStream n = + -- This is uniDistStream with a custom value generator. + generateStreamWith + valueGenerator DistRandom (Nothing, Nothing) Nothing + where + -- Ensure that the values generated (lists) have the expected + -- length. + valueGenerator :: Int -> DTime -> Gen [Int] + valueGenerator _ _ = vectorOf n arbitrary + + propDPSwitchZSwitchN :: Property + propDPSwitchZSwitchN = + forAllBlind genSFs $ \sfs -> + forAllBlind genEventS $ \eventSwitch -> + forAllBlind genCont $ \cont -> + forAll (myStream (length sfs)) $ evalT $ + Always $ SP $ + (originalSF sfs eventSwitch cont &&& modelSF sfs eventSwitch cont) + >>^ uncurry (==) + + where + + -- SF under test: dpSwitchZ that switches at some random time. + originalSF :: [SF Int Int] + -> (SF ([Int], [Int]) (Event ())) + -> ([SF Int Int] -> () -> SF [Int] [Int]) + -> SF [Int] [Int] + originalSF = dpSwitchZ + + -- Model SF: If you switch to the input sfs, it's like never switching. + -- + -- This equality only holds because of how genCont is being generated. + modelSF :: [SF Int Int] + -> (SF ([Int], [Int]) (Event ())) + -> ([SF Int Int] -> () -> SF [Int] [Int]) + -> SF [Int] [Int] + modelSF sfs _eventSwitch _cont = parZ sfs + + -- Generator: Random non-empty list of SFs. + genSFs :: Gen [SF Int Int] + genSFs = listOf1 randomSF + + -- Generator: Continuation that switches to the same input streams. + genCont :: Gen ([SF Int Int] -> () -> SF [Int] [Int]) + genCont = pure (\sfs _ -> parZ sfs) + + -- Generator: SF that will fire an event at a random time. + genEventS :: Gen (SF ([Int], [Int]) (Event ())) + genEventS = randomTime >>= \dt -> + pure (after dt ()) + + -- Generator: Random input stream generator where the lists generated + -- have the given length. + myStream :: Int -> Gen (SignalSampleStream [Int]) + myStream n = + -- This is uniDistStream with a custom value generator. + generateStreamWith + valueGenerator DistRandom (Nothing, Nothing) Nothing + where + -- Ensure that the values generated (lists) have the expected + -- length. + valueGenerator :: Int -> DTime -> Gen [Int] + valueGenerator _ _ = vectorOf n arbitrary + dynDelayLine :: a -> SF (a, Event Bool) a dynDelayLine a0 = second (arr (fmap (\p -> if p then addDelay else delDelay))) @@ -1002,7 +1944,202 @@ utils_t6r = , 169,170,171,171,172,174 ] +propDRPSwitchZ :: Property +propDRPSwitchZ = propDRPSwitchZNoSwitch + .&&. propDRPSwitchZSwitch0 + .&&. propDRPSwitchZSwitchNId + + where + + propDRPSwitchZNoSwitch :: Property + propDRPSwitchZNoSwitch = + forAllBlind genSFs $ \sfs -> + forAll (myStream (length sfs)) $ evalT $ + Always $ SP $ (originalSF sfs &&& modelSF sfs) >>^ uncurry (==) + + where + + -- SF under test: drpSwitchZ but never switch. + originalSF :: [SF Int Int] -> SF [Int] [Int] + originalSF sfs = + (identity &&& never) >>> drpSwitchZ sfs + + -- Model SF: With no switching, drpSwitchZ behaves like parZ. + modelSF :: [SF Int Int] -> SF [Int] [Int] + modelSF = parZ + + -- Generator: Random non-empty list of SFs. + genSFs :: Gen [SF Int Int] + genSFs = listOf1 randomSF + + -- Generator: Random input stream generator where the lists generated + -- have the given length. + myStream :: Int -> Gen (SignalSampleStream [Int]) + myStream n = + -- This is uniDistStream with a custom value generator. + generateStreamWith + valueGenerator DistRandom (Nothing, Nothing) Nothing + where + -- Ensure that the values generated (lists) have the expected + -- length. + valueGenerator :: Int -> DTime -> Gen [Int] + valueGenerator _ _ = vectorOf n arbitrary + + propDRPSwitchZSwitch0 :: Property + propDRPSwitchZSwitch0 = + forAllBlind genSFs $ \sfs -> + forAll (myStream (length sfs)) $ evalT $ + And (SP $ + (originalSF sfs &&& modelSF0 sfs) >>^ uncurry (==) + ) + (Next $ Always $ SP $ + (originalSF sfs &&& modelSFN sfs) >>^ uncurry (==) + ) + + where + + -- SF under test: drpSwitchZ that switches immediately. + originalSF :: [SF Int Int] -> SF [Int] [Int] + originalSF sfs = + (identity &&& now reverse) >>> drpSwitchZ sfs + + -- Model SF: With immediate switching, drpSwitchZ behaves like parZ at + -- time 0. + modelSF0 :: [SF Int Int] -> SF [Int] [Int] + modelSF0 = parZ + + -- Model SF: With immediate switching, drpSwitchZ behaves like (parZ . + -- reverse) after time 0. + modelSFN :: [SF Int Int] -> SF [Int] [Int] + modelSFN = parZ . reverse + + -- Generator: Random non-empty list of SFs. + genSFs :: Gen [SF Int Int] + genSFs = listOf1 randomSF + + -- Generator: Random input stream generator where the lists generated + -- have the given length. + myStream :: Int -> Gen (SignalSampleStream [Int]) + myStream n = + -- This is uniDistStream with a custom value generator. + generateStreamWith + valueGenerator DistRandom (Nothing, Nothing) Nothing + where + -- Ensure that the values generated (lists) have the expected + -- length. + valueGenerator :: Int -> DTime -> Gen [Int] + valueGenerator _ _ = vectorOf n arbitrary + + propDRPSwitchZSwitchNId :: Property + propDRPSwitchZSwitchNId = + forAllBlind genSFs $ \sfs -> + forAll (myStream (length sfs)) $ evalT $ + Always $ SP $ + (originalSF sfs &&& modelSF sfs) >>^ uncurry (==) + + where + + -- SF under test: drpSwitchZ that switches at some random time but + -- leaves the list of SFs unchanged. + originalSF :: [SF Int Int] + -> SF ([Int], Event ()) [Int] + originalSF sfs = (identity *** arr (tagWith id)) >>> drpSwitchZ sfs + + -- Model SF: If you switch to the input sfs, it's like never switching. + modelSF :: [SF Int Int] + -> SF ([Int], Event ()) [Int] + modelSF sfs = fst ^>> parZ sfs + + -- Generator: Random non-empty list of SFs. + genSFs :: Gen [SF Int Int] + genSFs = listOf1 randomSF + + -- Generator: Random input stream generator where the lists generated + -- have the given length. + myStream :: Int -> Gen (SignalSampleStream ([Int], Event ())) + myStream n = + -- This is uniDistStream with a custom value generator. + generateStreamWith + valueGenerator DistRandom (Nothing, Nothing) Nothing + where + -- Ensure that the values generated (lists) have the expected + -- length. + valueGenerator :: Int -> DTime -> Gen ([Int], Event ()) + valueGenerator _ _ = (,) <$> vectorOf n arbitrary <*> arbitrary + +-- ** With replication + +propParC :: Property +propParC = + forAllBlind randomSF $ \sf -> + forAll genLength $ \m -> + forAll (genPos m) $ \n -> + forAll (myStream m) $ evalT $ + Always $ SP $ (originalSF sf n &&& modelSF sf n) >>^ uncurry (==) + + where + + -- SF under test: Apply parC and look at one specific value only. + originalSF :: SF Int Int -> Int -> SF [Int] Int + originalSF sf n = parC sf >>^ (!! n) + + -- Model SF: Pick a value from an input list and apply the given SF only to + -- that value. + modelSF :: SF Int Int -> Int -> SF [Int] Int + modelSF sf n = (!! n) ^>> sf + + -- Generator: Random list length. + genLength :: Gen Int + genLength = getPositive <$> arbitrary + + -- Generator: Random position in a list of the given length. + genPos :: Int -> Gen Int + genPos n = chooseInt (0, n - 1) + + -- Generator: Random input stream generator where the lists generated + -- have the given length. + myStream :: Int -> Gen (SignalSampleStream [Int]) + myStream n = + -- This is uniDistStream with a custom value generator. + generateStreamWith valueGenerator DistRandom (Nothing, Nothing) Nothing + where + -- Ensure that the values generated (lists) have the expected + -- length. + valueGenerator :: Int -> DTime -> Gen [Int] + valueGenerator _ _ = vectorOf n arbitrary + -- * Auxiliary -- prop :: SF a b -> (a -> b -> prop (a,b) = SP ((identity &&& a) >>^ uncurry b) + +-- * Auxiliary + +-- | Generate a random positive time delta. +randomTime :: Gen Double +randomTime = getPositive <$> arbitrary + +-- | Generator of random signal functions on Ints. +randomSF :: Gen (SF Int Int) +randomSF = oneof [ return identity + , pointwiseSF + , loopPre <$> arbitrary <*> randomSF2 + ] + +-- | Generator of random signal functions on Int pairs. +randomSF2 :: Gen (SF (Int, Int) (Int, Int)) +randomSF2 = oneof [ return identity + , pointwiseSF2 + ] + +-- | Generator of random pointwise signal functions on Ints. +pointwiseSF :: Gen (SF Int Int) +pointwiseSF = arr <$> arbitrary + +-- | Generator of random pointwise signal functions on Int pairs. +pointwiseSF2 :: Gen (SF (Int, Int) (Int, Int)) +pointwiseSF2 = arr <$> arbitrary + +-- | Arbitrary instance for Event with a high chance of not producing an event. +instance Arbitrary a => Arbitrary (Event a) where + arbitrary = frequency [(9, pure noEvent), (1, fmap Event arbitrary)] diff --git a/yampa-test/tests/Test/FRP/Yampa/Task.hs b/yampa-test/tests/Test/FRP/Yampa/Task.hs index b8a805a2..3a1fc58f 100644 --- a/yampa-test/tests/Test/FRP/Yampa/Task.hs +++ b/yampa-test/tests/Test/FRP/Yampa/Task.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE CPP #-} -- | -- Description : Test cases for tasks (Task) -- Copyright : (c) Antony Courtney and Henrik Nilsson, Yale University, 2003-2004 @@ -8,6 +9,9 @@ module Test.FRP.Yampa.Task ( tests ) where +#if __GLASGOW_HASKELL__ < 710 +import Data.Functor ((<$>)) +#endif import Control.Monad (when, forever) import Test.QuickCheck @@ -17,6 +21,10 @@ import Test.Tasty.QuickCheck (testProperty) import FRP.Yampa as Yampa import FRP.Yampa.Task +import FRP.Yampa.LTLFuture (TPred (Always, SP), evalT) +import FRP.Yampa.QuickCheck (uniDistStream) +import FRP.Yampa.Stream (SignalSampleStream) + import TestsCommon tests :: TestTree @@ -30,6 +38,9 @@ tests = testGroup "Regression tests for FRP.Yampa.Task" , testProperty "tasks (fixed)" (property $ task_t6 ~= task_t6r) , testProperty "tasks (fixed)" (property $ task_t7 ~= task_t7r) , testProperty "tasks (fixed)" (property $ task_t8 ~= task_t8r) + , testProperty "runTask_ (qc)" testRunTask_ + , testProperty "taskToSF (qc)" testTaskToSF + , testProperty "constT (qc)" testConstT ] -- * The Task type @@ -210,6 +221,80 @@ task_t8r = , Right (Left 24.0,24.0) ] +testRunTask_ :: Property +testRunTask_ = + forAll arbitrary $ \i -> + forAll myStream $ + evalT $ Always $ prop (sf i &&& sfModel i, pred) + where + myStream :: Gen (SignalSampleStream Float) + myStream = uniDistStream + + sf :: Double -> SF Float Double + sf x = runTask_ $ constT x + + sfModel :: Double -> SF Float Double + sfModel x = constant x + + -- Both the SF under test and the model should behave the same way, + -- that is, output the same result. + pred _ = uncurry (==) + +testTaskToSF :: Property +testTaskToSF = + forAll positive $ \t -> + forAll arbitrary $ \i -> + forAll arbitrary $ \j -> + forAll myStream $ + evalT (Always $ prop (sf t i j &&& sfModel t i j, pred)) + where + myStream :: Gen (SignalSampleStream Float) + myStream = uniDistStream + + positive :: Gen Double + positive = getPositive <$> arbitrary + + -- Note that we use switch to abandon the Task after it terminates. Tasks + -- do not produce correct output once they finish, they just throw an + -- error. + sf :: Time -> Double -> Double -> SF Float Double + sf t x y = switch (taskToSF (sleepT t x)) (\_ -> constant y) + + -- Note that we use switch to abandon the Task after it terminates. Tasks + -- do not produce correct output once they finish, they just throw an + -- error. + sfModel :: Time -> Double -> Double -> SF Float Double + sfModel t x y = switch + -- Output x, and indicate when time t is exceeded for the first time + (constant x &&& (time >>> arr (>= t) >>> edge)) + (\_ -> constant y) + + -- Both the SF under test and the model should behave the same way, + -- that is, output the same result. + pred _ = uncurry (==) + +testConstT :: Property +testConstT = + forAll arbitrary $ \i -> + forAll myStream $ + evalT $ Always $ prop (sf i &&& sfModel i, pred) + where + myStream :: Gen (SignalSampleStream Float) + myStream = uniDistStream + + -- Task that constantly outputs a value. If it finishes (which it + -- shouldn't), then return the negated value. + sf :: Double -> SF Float (Either Double ()) + sf x = runTask (constT x) + + -- SF that constantly outputs a value on the Left side of an Either. + sfModel :: Double -> SF Float (Either Double ()) + sfModel x = constant $ Left x + + -- Both the SF under test and the model should behave the same way, + -- that is, output the same result. + pred _ = uncurry (==) + -- * Auxiliary -- | Repeat m until result satisfies the predicate p @@ -223,3 +308,6 @@ m `repeatUntil` p = m >>= \x -> if not (p x) then repeatUntil m p else return x -- >>> for 0 (+1) (>=10) ... for :: Monad m => a -> (a -> a) -> (a -> Bool) -> m b -> m () for i f p m = when (p i) $ m >> for (f i) f p m + +prop :: (SF a b, a -> b -> Bool) -> TPred a +prop (a, b) = SP ((identity &&& a) >>^ uncurry b) diff --git a/yampa-test/yampa-test.cabal b/yampa-test/yampa-test.cabal index 919aa59f..56a1093b 100644 --- a/yampa-test/yampa-test.cabal +++ b/yampa-test/yampa-test.cabal @@ -31,7 +31,7 @@ cabal-version: >= 1.10 build-type: Simple name: yampa-test -version: 0.14 +version: 0.14.1 author: Ivan Perez maintainer: ivan.perez@keera.co.uk homepage: http://github.com/ivanperez-keera/Yampa @@ -81,10 +81,10 @@ library FRP.Yampa.Stream build-depends: - base >= 4 && < 5 + base >= 4 && < 5 , normaldistribution , QuickCheck - , Yampa >= 0.14 && < 0.15 + , Yampa >= 0.14.1 && < 0.15 default-language: Haskell2010 @@ -101,6 +101,7 @@ test-suite yampa-quicheck Main.hs other-modules: + Test.FRP.Yampa.Arrow Test.FRP.Yampa.Basic Test.FRP.Yampa.Conditional Test.FRP.Yampa.Delays @@ -110,6 +111,7 @@ test-suite yampa-quicheck Test.FRP.Yampa.Integration Test.FRP.Yampa.InternalCore Test.FRP.Yampa.Loop + Test.FRP.Yampa.Random Test.FRP.Yampa.Scan Test.FRP.Yampa.Simulation Test.FRP.Yampa.Switches diff --git a/yampa/CHANGELOG b/yampa/CHANGELOG index 1239dd1e..429eaf62 100644 --- a/yampa/CHANGELOG +++ b/yampa/CHANGELOG @@ -1,3 +1,7 @@ +2023-02-07 Ivan Perez + * Yampa.cabal: Version bump (0.14.1) (#251). + * src/: Replace broken links (#253), fix typo (#252). + 2022-12-07 Ivan Perez * Yampa.cabal: Version bump (0.14) (#242), bump version bounds of dependency (#241). diff --git a/yampa/Yampa.cabal b/yampa/Yampa.cabal index 402e538e..fa13034b 100644 --- a/yampa/Yampa.cabal +++ b/yampa/Yampa.cabal @@ -30,7 +30,7 @@ cabal-version: >= 1.10 build-type: Simple name: Yampa -version: 0.14 +version: 0.14.1 author: Henrik Nilsson, Antony Courtney maintainer: Ivan Perez (ivan.perez@keera.co.uk) homepage: https://github.com/ivanperez-keera/Yampa/ @@ -72,6 +72,7 @@ flag examples default: False manual: True + library exposed-modules: FRP.Yampa diff --git a/yampa/src/FRP/Yampa/Switches.hs b/yampa/src/FRP/Yampa/Switches.hs index 93e522d3..64383a7b 100644 --- a/yampa/src/FRP/Yampa/Switches.hs +++ b/yampa/src/FRP/Yampa/Switches.hs @@ -13,7 +13,7 @@ -- -- Switches allow you to change the signal function being applied. -- --- The basic idea of switching is fromed by combining a subordinate signal +-- The basic idea of switching is formed by combining a subordinate signal -- function and a signal function continuation parameterised over some initial -- data. -- @@ -363,7 +363,7 @@ broadcast a = fmap (\sf -> (a, sf)) -- of outputs. See 'par'. -- -- For more information on how parallel composition works, check --- +-- parB :: Functor col => col (SF a b) -> SF a (col b) parB = par broadcast @@ -371,7 +371,7 @@ parB = par broadcast -- in parallel) with broadcasting. See 'pSwitch'. -- -- For more information on how parallel composition works, check --- +-- pSwitchB :: Functor col => col (SF a b) -> SF (a,col b) (Event c) -> (col (SF a b)->c-> SF a (col b)) -> SF a (col b) @@ -381,7 +381,7 @@ pSwitchB = pSwitch broadcast -- signal functions spatially composed in parallel). See 'dpSwitch'. -- -- For more information on how parallel composition works, check --- +-- dpSwitchB :: Functor col => col (SF a b) -> SF (a,col b) (Event c) -> (col (SF a b)->c->SF a (col b)) -> SF a (col b) @@ -400,7 +400,7 @@ dpSwitchB = dpSwitch broadcast -- See 'rpSwitch'. -- -- For more information on how parallel composition works, check --- +-- rpSwitchB :: Functor col => col (SF a b) -> SF (a, Event (col (SF a b) -> col (SF a b))) (col b) rpSwitchB = rpSwitch broadcast @@ -418,7 +418,7 @@ rpSwitchB = rpSwitch broadcast -- This is the decoupled version of 'rpSwitchB'. -- -- For more information on how parallel composition works, check --- +-- drpSwitchB :: Functor col => col (SF a b) -> SF (a, Event (col (SF a b) -> col (SF a b))) (col b) drpSwitchB = drpSwitch broadcast @@ -635,7 +635,7 @@ parZ = par (safeZip "parZ") -- in parallel). See 'pSwitch'. -- -- For more information on how parallel composition works, check --- +-- pSwitchZ :: [SF a b] -> SF ([a],[b]) (Event c) -> ([SF a b] -> c -> SF [a] [b]) -> SF [a] [b] pSwitchZ = pSwitch (safeZip "pSwitchZ") @@ -644,7 +644,7 @@ pSwitchZ = pSwitch (safeZip "pSwitchZ") -- signal functions spatially composed in parallel). See 'dpSwitch'. -- -- For more information on how parallel composition works, check --- +-- dpSwitchZ :: [SF a b] -> SF ([a],[b]) (Event c) -> ([SF a b] -> c ->SF [a] [b]) -> SF [a] [b] dpSwitchZ = dpSwitch (safeZip "dpSwitchZ") @@ -661,7 +661,7 @@ dpSwitchZ = dpSwitch (safeZip "dpSwitchZ") -- See 'rpSwitch'. -- -- For more information on how parallel composition works, check --- +-- rpSwitchZ :: [SF a b] -> SF ([a], Event ([SF a b] -> [SF a b])) [b] rpSwitchZ = rpSwitch (safeZip "rpSwitchZ") @@ -677,7 +677,7 @@ rpSwitchZ = rpSwitch (safeZip "rpSwitchZ") -- See 'rpSwitchZ' and 'drpSwitch'. -- -- For more information on how parallel composition works, check --- +-- drpSwitchZ :: [SF a b] -> SF ([a], Event ([SF a b] -> [SF a b])) [b] drpSwitchZ = drpSwitch (safeZip "drpSwitchZ")