yampa-test 0.14 → 0.14.1

raw patch · 10 files changed

+3188/−1056 lines, 10 filesdep ~YampaPVP ok

version bump matches the API change (PVP)

Dependency ranges changed: Yampa

API changes (from Hackage documentation)

Files

• CHANGELOG +9/−0
• tests/Main.hs +5/−1
• tests/Test/FRP/Yampa/Arrow.hs +92/−0
• tests/Test/FRP/Yampa/EventS.hs +188/−41
• tests/Test/FRP/Yampa/Hybrid.hs +106/−0
• tests/Test/FRP/Yampa/Random.hs +230/−0
• tests/Test/FRP/Yampa/Simulation.hs +321/−4
• tests/Test/FRP/Yampa/Switches.hs +2144/−1007
• tests/Test/FRP/Yampa/Task.hs +88/−0
• yampa-test.cabal +5/−3

@@ -1,3 +1,12 @@+2023-02-07 Ivan Perez <ivan.perez@keera.co.uk>+        * 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 <ivan.perez@keera.co.uk>         * yampa-test.cabal: Version bump (0.14) (#242), add tests for module           FRP.Yampa.Event (#237).

@@ -14,6 +14,7 @@  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.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 @@  tests :: TestTree tests = testGroup "Yampa QC properties"-  [ Basic.tests+  [ Arrow.tests+  , Basic.tests   , Conditional.tests   , Delays.tests   , Event.tests@@ -43,6 +46,7 @@   , Integration.tests   , InternalCore.tests   , Loop.tests+  , Random.tests   , Scan.tests   , Simulation.tests   , Switches.tests

@@ -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

@@ -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 @@     )   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 @@  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 @@   , 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 @@   , 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 @@  -- * 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 @@  -- 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+                    ]

@@ -8,14 +8,20 @@   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 @@   , 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_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 ]

@@ -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

@@ -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 @@     )   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 @@   , (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 @@   ,  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

@@ -1,1008 +1,2145 @@ {-# LANGUAGE Arrows #-}--- |--- Description : Test cases for FRP.Yampa.Switches--- Copyright   : (c) Ivan Perez, 2014-2022---               (c) Antony Courtney and Henrik Nilsson, Yale University, 2003-2004--- Authors     : Antony Courtney, Henrik Nilsson, Ivan Perez---- - Restructure test cases for papallel composition and switches to reflect---   Yampa structure better. Separate test cases for the generic definitions?-module Test.FRP.Yampa.Switches-    ( tests-    )-  where--import Data.Fixed-import Data.List (findIndex)-import Data.Maybe (fromJust)--import Test.QuickCheck-import Test.Tasty (TestTree, testGroup)-import Test.Tasty.QuickCheck (testProperty)--import FRP.Yampa as Yampa-import FRP.Yampa.Switches (rpSwitchZ)-import FRP.Yampa.EventS (snap)-import FRP.Yampa.Stream-import FRP.Yampa.QuickCheck-import FRP.Yampa.LTLFuture--import TestsCommon--tests :: TestTree-tests = testGroup "Regression tests for FRP.Yampa.Switches"-  [ testProperty "switch (0, fixed)"    (property $ switch_t0 ~= switch_t0r)-  , testProperty "switch (1, fixed)"    (property $ switch_t1 ~= switch_t1r)-  , testProperty "switch (5, fixed)"    (property $ switch_t5 ~= switch_t5r)-  , testProperty "switch (2, fixed)"    (property $ switch_t2 ~= switch_t2r)-  , testProperty "switch (3, fixed)"    (property $ switch_t3 ~= switch_t3r)-  , testProperty "switch (4, fixed)"    (property $ switch_t4 ~= switch_t4r)-  , testProperty "rswitch (0, fixed)"   (property $ rswitch_t0 ~= rswitch_t0r)-  , testProperty "rswitch (1, fixed)"   (property $ rswitch_t1 ~= rswitch_t1r)-  , testProperty "rswitch (2, fixed)"   (property $ rswitch_t2 ~= rswitch_t2r)-  , testProperty "rswitch (3, fixed)"   (property $ rswitch_t3 ~= rswitch_t3r)-  , testProperty "rswitch (4, fixed)"   (property $ rswitch_t4 ~= rswitch_t4r)-  , testProperty "kswitch (0, fixed)"   (property $ kswitch_t0 ~= kswitch_t0r)-  , testProperty "kswitch (2, fixed)"   (property $ kswitch_t2 ~= kswitch_t2r)-  , testProperty "kswitch (1, fixed)"   (property $ kswitch_t1 ~= kswitch_t1r)-  , testProperty "kswitch (3, fixed)"   (property $ kswitch_t3 ~= kswitch_t3r)-  , testProperty "kswitch (4, fixed)"   (property $ kswitch_t4 ~= kswitch_t4r)-  , testProperty "parB (fixed)"         (property $ coc_t0 ~= coc_t0r)-  , testProperty "parB (qc)"            prop_broadcast-  , testProperty "pswitch (0, fixed)"   (property $ pswitch_t0 ~= pswitch_t0r)-  , testProperty "pswitch (2, fixed)"   (property $ pswitch_t2 ~= pswitch_t2r)-  , testProperty "pswitch (5, fixed)"   (property $ pswitch_t5 ~= pswitch_t5r)-  , testProperty "pswitch (1, fixed)"   (property $ pswitch_t1 ~= pswitch_t1r)-  , testProperty "pswitch (3, fixed)"   (property $ pswitch_t3 ~= pswitch_t3r)-  , testProperty "pswitch (4, fixed)"   (property $ pswitch_t4 ~= pswitch_t4r)-  , testProperty "rpswitch (0, fixed)"  (property $ rpswitch_t0 ~= rpswitch_t0r)-  , testProperty "rpswitch (2, fixed)"  (property $ rpswitch_t2 ~= rpswitch_t2r)-  , 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 "rpSwitchZ (0, fixed)" (property $ utils_t6 ~= utils_t6r)-  ]---- * Basic switching--switch_t0 = take 18 $-  embed (switch switch_t0a $ \x ->-         switch (switch_t0b x) $ \x ->-         switch (switch_t0c x) $ \x ->-         switch (switch_t0c x) $ \x ->-         switch (switch_t0d x) $ \x ->-         switch (switch_t0e x) $ \x ->-         switch (switch_t0e x) $-         switch_t0final)-        switch_inp1--switch_t0a :: SF Double (Double, Event Int)-switch_t0a = localTime-             >>> arr dup-             >>> second (arr (>= 3.0) >>> edge >>> arr (`tag` 17))--switch_t0b :: Int -> SF Double (Double, Event Int)-switch_t0b x = localTime-               >>> arr dup-               >>> second (arr (>= 3.0) >>> edge >>> arr (`tag` (23 + x)))---- This should raise an event IMMEDIATELY: no time should pass.-switch_t0c :: Num b => b -> SF a (a, Event b)-switch_t0c x = arr dup >>> second (now (x + 1))--switch_t0d x = (arr (+ (fromIntegral x))) &&& (arr (>= 7.0) >>> edge)---- This should raise an event IMMEDIATELY: no time should pass.-switch_t0e :: b -> SF a (a, Event a)-switch_t0e _ = arr dup >>> second snap--switch_t0final :: Double -> SF Double Double-switch_t0final x = arr (+x)--switch_t0r =-  [ 0.0,  1.0,  2.0                     -- switch_t0a-  , 0.0,  1.0,  2.0                     -- switch_t0b-  , 46.0, 46.0, 46.0, 47.0, 48.0, 48.0  -- switch_t0d-  , 14.0, 14.0, 14.0, 15.0, 16.0, 16.0  -- switch_t0final-  ]--switch_inp1 = deltaEncode 1.0 $-  [ 1.0, 1.0, 1.0-  , 2.0-  , 3.0, 3.0-  , 4.0, 4.0, 4.0-  , 5.0-  , 6.0, 6.0-  , 7.0, 7.0, 7.0-  , 8.0-  ]-   ++ repeat 9.0--switch_t1 = take 32 $ embed (switch_t1rec 42.0) switch_inp1---- Outputs current input, local time, and the value of the initializing--- argument until some time has passed (determined by integrating a constant),--- at which point an event occurs.-switch_t1a :: Double -> SF Double ((Double,Double,Double), Event ())-switch_t1a x = (arr dup >>> second localTime >>> arr (\(a,t) -> (a,t,x)))-               &&& (constant 0.5-                    >>> integral-                    >>> (arr (>= (2.0 :: Double)) -- Used to work with no sig.-                    >>> edge))---- This should raise an event IMMEDIATELY: no time should pass.-switch_t1b :: b -> SF a ((Double,Double,Double), Event a)-switch_t1b _ = constant (-999.0,-999.0,-999.0) &&& snap--switch_t1rec :: Double -> SF Double (Double,Double,Double)-switch_t1rec x =-  switch (switch_t1a x) $ \x ->-  switch (switch_t1b x) $ \x ->-  switch (switch_t1b x) $-  switch_t1rec--switch_t1r =-  [ (1.0,0.0,42.0), (1.0,1.0,42.0), (1.0,2.0,42.0), (2.0,3.0,42.0)-  , (3.0,0.0,3.0),  (3.0,1.0,3.0),  (4.0,2.0,3.0),  (4.0,3.0,3.0)-  , (4.0,0.0,4.0),  (5.0,1.0,4.0),  (6.0,2.0,4.0),  (6.0,3.0,4.0)-  , (7.0,0.0,7.0),  (7.0,1.0,7.0),  (7.0,2.0,7.0),  (8.0,3.0,7.0)-  , (9.0,0.0,9.0),  (9.0,1.0,9.0),  (9.0,2.0,9.0),  (9.0,3.0,9.0)-  , (9.0,0.0,9.0),  (9.0,1.0,9.0),  (9.0,2.0,9.0),  (9.0,3.0,9.0)-  , (9.0,0.0,9.0),  (9.0,1.0,9.0),  (9.0,2.0,9.0),  (9.0,3.0,9.0)-  , (9.0,0.0,9.0),  (9.0,1.0,9.0),  (9.0,2.0,9.0),  (9.0,3.0,9.0)-  ]--prop_switch_t1 =-    forAll myStream $ evalT $-      Always $ SP ((switch_t1rec 42.0 &&& switch_tr) >>> arr same)--  where myStream :: Gen (SignalSampleStream Double)-        myStream = fixedDelayStreamWith f 1.0-        f dt = l!!(floor dt)-        l = [ 1.0, 1.0, 1.0-            , 2.0-            , 3.0, 3.0-            , 4.0, 4.0, 4.0-            , 5.0-            , 6.0, 6.0-            , 7.0, 7.0, 7.0-            , 8.0-            ]-             ++ repeat 9.0--        same = (uncurry (==))--switch_tr :: SF Double (Double, Double, Double)-switch_tr = proc (a) -> do-  t <- localTime -< ()-  let mt = fromIntegral $ floor (mod' t 4.0)-      v  = case floor (t / 4.0) of-             0 -> 42.0-             1 -> 3.0-             2 -> 4.0-             3 -> 7.0-             _ -> 9.0-  returnA -< (a, mt, v)--impulseIntegral2 :: (Fractional s, VectorSpace a s) => SF (a, Event a) a-impulseIntegral2 =-   switch (first integral >>> arr (\(a, ea) -> (a, fmap (^+^ a) ea)))-          impulseIntegral2'- where-   impulseIntegral2' :: (Fractional s, VectorSpace a s)-                     => a -> SF (a, Event a) a-   impulseIntegral2' a =-     switch ((integral >>> arr (^+^ a)) *** notYet-             >>> arr (\(a, ea) -> (a, fmap (^+^ a) ea)))-            impulseIntegral2'--switch_t5 :: [Double]-switch_t5 = take 50 $ embed impulseIntegral2-                            (deltaEncode 0.1 (zip (repeat 1.0) evSeq))-  where-    evSeq = replicate 9 NoEvent ++ [Event 10.0]-            ++ replicate 9 NoEvent ++ [Event (-10.0)]-            ++ evSeq--switch_t5r =-  [  0.0,  0.1,  0.2,  0.3,  0.4,  0.5,  0.6,  0.7,  0.8, 10.9-  , 11.0, 11.1, 11.2, 11.3, 11.4, 11.5, 11.6, 11.7, 11.8,  1.9-  ,  2.0,  2.1,  2.2,  2.3,  2.4,  2.5,  2.6,  2.7,  2.8, 12.9-  , 13.0, 13.1, 13.2, 13.3, 13.4, 13.5, 13.6, 13.7, 13.8,  3.9-  ,  4.0,  4.1,  4.2,  4.3,  4.4,  4.5,  4.6,  4.7,  4.8, 14.9-  ]--switch_t2 = take 18 $-  embed (dSwitch switch_t0a $ \x ->-         dSwitch (switch_t0b x) $ \x ->-         dSwitch (switch_t0c x) $ \x ->-         dSwitch (switch_t0c x) $ \x ->-         dSwitch (switch_t0d x) $ \x ->-         dSwitch (switch_t0e x) $ \x ->-         dSwitch (switch_t0e x) $-         switch_t0final)-        switch_inp1--switch_t2r =-  [ 0.0,  1.0,  2.0                     -- switch_t0a-  , 3.0,  1.0,  2.0                     -- switch_t0b-  , 3.0,  46.0, 46.0, 47.0, 48.0, 48.0  -- switch_t0d-  , 49.0, 14.0, 14.0, 15.0, 16.0, 16.0  -- switch_t0final-  ]--switch_t3 = take 32 $ embed (switch_t3rec 42.0) switch_inp1--switch_t3rec :: Double -> SF Double (Double,Double,Double)-switch_t3rec x =-  dSwitch (switch_t1a x) $ \x ->-  dSwitch (switch_t1b x) $ \x ->-  dSwitch (switch_t1b x) $-  switch_t3rec--switch_t3r =-  [ (1.0,0.0,42.0), (1.0,1.0,42.0), (1.0,2.0,42.0), (2.0,3.0,42.0)-  , (3.0,4.0,42.0), (3.0,1.0,3.0),  (4.0,2.0,3.0),  (4.0,3.0,3.0)-  , (4.0,4.0,3.0),  (5.0,1.0,4.0),  (6.0,2.0,4.0),  (6.0,3.0,4.0)-  , (7.0,4.0,4.0),  (7.0,1.0,7.0),  (7.0,2.0,7.0),  (8.0,3.0,7.0)-  , (9.0,4.0,7.0),  (9.0,1.0,9.0),  (9.0,2.0,9.0),  (9.0,3.0,9.0)-  , (9.0,4.0,9.0),  (9.0,1.0,9.0),  (9.0,2.0,9.0),  (9.0,3.0,9.0)-  , (9.0,4.0,9.0),  (9.0,1.0,9.0),  (9.0,2.0,9.0),  (9.0,3.0,9.0)-  , (9.0,4.0,9.0),  (9.0,1.0,9.0),  (9.0,2.0,9.0),  (9.0,3.0,9.0)-  ]---- The correct strictness properties of dSwitch are crucial here.--- switch does not work.-switch_t4 = take 25 $-  embed (loop $-           dSwitch switch_t4a $ \_ ->-           dSwitch switch_t4a $ \_ ->-           dSwitch switch_t4a $ \_ ->-           switch_t4final-         )-        (deltaEncode 1.0 (repeat ()))--switch_t4a :: SF (a, Double) ((Double, Double), Event ())-switch_t4a = (constant 1.0 >>> integral >>> arr dup)-             &&& (arr (\ (_, x) -> x >= 5.0) >>> edge)--switch_t4final :: SF (a, Double) (Double, Double)-switch_t4final = constant 0.1 >>> integral >>> arr dup--switch_t4r =-  [ 0.0, 1.0, 2.0, 3.0, 4.0                           -- switch_t4a-  , 5.0, 1.0, 2.0, 3.0, 4.0                           -- switch_t4a-  , 5.0, 1.0, 2.0, 3.0, 4.0                           -- switch_t4a-  , 5.0, 0.1, 0.2, 0.3, 0.4, 0.5, 0.6, 0.7, 0.8, 0.9  -- switch_t4final-  ]--rswitch_inp1 = (fromJust (head delta_inp), zip (repeat 1.0) (tail delta_inp))-  where-    delta_inp =-      [ Just (1.0, NoEvent), Nothing, Nothing-      , Just (2.0, Event (arr (*3))), Just (3.0, NoEvent), Nothing-      , Just (4.0, NoEvent), Nothing, Nothing-      , Just (5.0, Event integral)-      , Just (6.0, NoEvent), Nothing-      , Just (7.0, NoEvent), Nothing, Nothing-      , Just (8.0, Event (arr (*7))), Just (9.0, NoEvent), Nothing-      ]-      ++ repeat Nothing---- This input contains exaples of "continuos switching", i.e. the same--- switching event ocurring during a a few contiguous time steps.--- It also starts with an immediate switch.-rswitch_inp2 = (fromJust (head delta_inp), zip (repeat 1.0) (tail delta_inp))-  where-    delta_inp =-      [ Just (1.0, Event integral)-      , Just (1.0, NoEvent), Nothing-      , Just (2.0, Event (arr (*2))), Nothing, Nothing-      , Just (3.0, Event integral), Nothing, Nothing-      , Just (4.0, NoEvent), Nothing, Nothing-      , Just (5.0, Event integral)-      , Just (5.0, NoEvent), Nothing-      , Just (6.0, Event (arr (*3))), Just (7.0, Event (arr (*4)))-      , Just (8.0, Event integral)-      , Just (9.0, NoEvent), Nothing-      ]-      ++ repeat Nothing--rswitch_t0 = take 20 $ embed (rSwitch (arr (+3))) rswitch_inp1---- Integration using rectangle rule assumed.-rswitch_t0r :: [Double]-rswitch_t0r =-  [ 4.0,  4.0,  4.0,  6.0,  9.0-  , 9.0,  12.0, 12.0, 12.0, 0.0-  , 5.0,  11.0, 17.0, 24.0, 31.0-  , 56.0, 63.0, 63.0, 63.0, 63.0-  ]--rswitch_t1 = take 20 $ embed (rSwitch integral) rswitch_inp1---- Integration using rectangle rule assumed.-rswitch_t1r :: [Double]-rswitch_t1r =-  [ 0.0,  1.0,  2.0,  6.0,  9.0-  , 9.0,  12.0, 12.0, 12.0, 0.0-  , 5.0,  11.0, 17.0, 24.0, 31.0-  , 56.0, 63.0, 63.0, 63.0, 63.0-  ]--rswitch_t2 = take 20 $ embed (rSwitch (arr (+100))) rswitch_inp2---- Integration using rectangle rule assumed.-rswitch_t2r :: [Double]-rswitch_t2r =-  [ 0.0,  1.0,  2.0, 4.0, 4.0-  , 4.0,  0.0,  0.0, 0.0, 3.0-  , 7.0,  11.0, 0.0, 5.0, 10.0-  , 18.0, 28.0, 0.0, 8.0, 17.0-  ]--rswitch_t3 = take 20 $ embed (drSwitch (arr (+100))) rswitch_inp2---- Integration using rectangle rule assumed.-rswitch_t3r :: [Double]-rswitch_t3r =-  [ 101.0, 1.0,  2.0,  3.0, 4.0-  , 4.0,   6.0,  3.0,  3.0, 3.0-  , 7.0,   11.0, 15.0, 5.0, 10.0-  , 15.0,  21.0, 32.0, 8.0, 17.0-  ]--rswitch_sawTooth :: SF a Double-rswitch_sawTooth =-    loop (second (arr (>=5.0)-                  >>> edge-                  >>> arr (`tag` ramp))-          >>> drSwitch ramp-          >>> arr dup)-  where-    ramp :: SF a Double-    ramp = constant 1.0 >>> integral--rswitch_inp3 = deltaEncode 0.5 (repeat 0.0)--rswitch_t4 = take 40 $ embed rswitch_sawTooth rswitch_inp3--rswitch_t4r =-  [ 0.0, 0.5, 1.0, 1.5, 2.0-  , 2.5, 3.0, 3.5, 4.0, 4.5-  , 5.0, 0.5, 1.0, 1.5, 2.0-  , 2.5, 3.0, 3.5, 4.0, 4.5-  , 5.0, 0.5, 1.0, 1.5, 2.0-  , 2.5, 3.0, 3.5, 4.0, 4.5-  , 5.0, 0.5, 1.0, 1.5, 2.0-  , 2.5, 3.0, 3.5, 4.0, 4.5-  ]--kswitch_inp1 = deltaEncode 0.1 [0.0, 0.5 ..]--whenSndGE :: Ord b => b -> c -> SF (a, b) (Event c)-whenSndGE b c = arr snd >>> arr (>= b) >>> edge >>> arr (`tag` c)--kswitch_t0 :: [Double]-kswitch_t0 = take 20 $ embed sf kswitch_inp1-  where-    sf =-      kSwitch integral (whenSndGE 0.2 (-1.0)) $ \sf1 x ->-      kSwitch (integral >>> arr (+x)) (whenSndGE 1.0 (1.0)) $ \_ _ ->-      sf1--kswitch_t0r =-  [  0.00,  0.00,  0.05, 0.15, -1.00-  , -0.80, -0.55, -0.25, 0.10,  0.50-  ,  0.95,  0.30,  0.85, 1.45,  2.10-  ,  2.80,  3.55,  4.35, 5.20,  6.10-  ]--kswitch_t2 :: [Double]-kswitch_t2 = take 20 $ embed sf kswitch_inp1-  where-    sf =-      kSwitch integral (now (-1.0)) $ \sf1 x ->-      kSwitch (integral >>> arr (+x)) (whenSndGE 1.0 (1.0)) $ \_ _ ->-      sf1--kswitch_t2r =-  [ -1.00, -1.00, -0.95, -0.85, -0.70-  , -0.50, -0.25,  0.05,  0.40,  0.80-  ,  0.00,  0.50,  1.05,  1.65,  2.30-  ,  3.00,  3.75,  4.55,  5.40,  6.30-  ]--kswitch_t1 :: [Double]-kswitch_t1 = take 20 $ embed sf kswitch_inp1-  where-    sf =-      dkSwitch integral (whenSndGE 0.2 (-1.0)) $ \sf1 x ->-      dkSwitch (integral >>> arr (+x)) (whenSndGE 1.0 (1.0)) $ \_ _ ->-      sf1--kswitch_t1r =-  [  0.00,  0.00,  0.05, 0.15, 0.30-  , -0.80, -0.55, -0.25, 0.10, 0.50-  ,  0.95,  1.45,  0.85, 1.45, 2.10-  ,  2.80,  3.55,  4.35, 5.20, 6.10-  ]--kswitch_t3 :: [Double]-kswitch_t3 = take 20 $ embed sf kswitch_inp1-  where-    sf =-      dkSwitch integral (now (-1.0)) $ \sf1 x ->-      dkSwitch (integral >>> arr (+x)) (whenSndGE 1.0 (1.0)) $ \_ _ ->-      sf1--kswitch_t3r =-  [  0.00, -1.00, -0.95, -0.85, -0.70-  , -0.50, -0.25,  0.05,  0.40,  0.80-  ,  1.25,  0.50,  1.05,  1.65,  2.30-  ,  3.00,  3.75,  4.55,  5.40,  6.30-  ]---- The correct strictness properties of dkSwitch are crucial here.--- kSwitch does not work.-kswitch_t4 = take 40 $-    embed (loop $-             dkSwitch sf (sfe 0.55 (-1.0))              $ \sf1 x ->-             dkSwitch (sf >>> arr2 (+x)) (sfe 0.05 8.0) $ \sf2 y ->-             dkSwitch sf1 (sfe 2.0 (-2.0))              $ \_   z ->-             sf2 >>> arr2 (+(y + z))-          )-          (deltaEncode 0.1 (repeat ()))-  where-    sf :: SF (a, Double) (Double, Double)-    sf = constant 1.0 >>> integral >>> arr dup--    sfe :: Double -> Double -> SF ((a, Double), b) (Event Double)-    sfe x e = arr fst >>> whenSndGE x e--    arr2 f = arr (\(x,y) -> (f x, f y))--kswitch_t4r =-  [  0.0,  0.1,  0.2,  0.3,  0.4-  ,  0.5,  0.6, -0.9, -0.8, -0.7-  , -0.6, -0.5, -0.4, -0.3, -0.2-  , -0.1,  0.0,  0.1,  0.7,  0.8-  ,  0.9,  1.0,  1.1,  1.2,  1.3-  ,  1.4,  1.5,  1.6,  1.7,  1.8-  ,  1.9,  2.0,  6.2,  6.3,  6.4-  ,  6.5,  6.6,  6.7,  6.8,  6.9-  ]---- * Parallel composition\/switching (collections)--- ** With broadcasting--coc_inp1 = deltaEncode 0.1 [0.0, 0.5 ..]--coc_t0 :: [[Double]]-coc_t0 = take 20 $ embed (parB [constant 1.0, identity, integral]) coc_inp1--coc_t0r =-  [ [1.0, 0.0, 0.00]-  , [1.0, 0.5, 0.00]-  , [1.0, 1.0, 0.05]-  , [1.0, 1.5, 0.15]-  , [1.0, 2.0, 0.30]-  , [1.0, 2.5, 0.50]-  , [1.0, 3.0, 0.75]-  , [1.0, 3.5, 1.05]-  , [1.0, 4.0, 1.40]-  , [1.0, 4.5, 1.80]-  , [1.0, 5.0, 2.25]-  , [1.0, 5.5, 2.75]-  , [1.0, 6.0, 3.30]-  , [1.0, 6.5, 3.90]-  , [1.0, 7.0, 4.55]-  , [1.0, 7.5, 5.25]-  , [1.0, 8.0, 6.00]-  , [1.0, 8.5, 6.80]-  , [1.0, 9.0, 7.65]-  , [1.0, 9.5, 8.55]-  ]---- Par with broadcast (collection-oriented combinators)--- TODO: Add integral to the list of SFs being tested-prop_broadcast =-    forAll myStream $ evalT $ Always $ prop (sf, pred)-  where myStream :: Gen (SignalSampleStream Float)-        myStream = uniDistStream--        sf   = parB [identity, (arr (+1))]-        pred = (\x [y,z] -> x == y && (x + 1) == z)--pswitch_inp1 = deltaEncode 0.1 [0.0, 0.5 ..]--whenFstGE :: Ord a => a -> c -> SF (a, b) (Event c)-whenFstGE a c = arr fst >>> arr (>= a) >>> edge >>> arr (`tag` c)--pswitch_t0 :: [[Double]]-pswitch_t0 = take 20 $ embed sf pswitch_inp1-  where-    sf =-      pSwitchB [] (whenFstGE 1.25 10.0) $ \sfs x ->-      pSwitchB (integral:sfs) (whenFstGE 3.75 10.0) $ \sfs x ->-      pSwitchB ((integral>>>arr(+x)):sfs)(whenFstGE 5.25 20.0) $ \sfs x->-      pSwitchB ((integral>>>arr(+x)):sfs)(whenFstGE 7.25 20.0) $ \sfs _->-      parB (take 2 sfs)--pswitch_t0r =-  [ []                    -- 0.0-  , []                    -- 0.5-  , []                    -- 1.0-  , [0.0]                 -- 1.5-  , [0.15]                -- 2.0-  , [0.35]                -- 2.5-  , [0.60]                -- 3.0-  , [0.90]                -- 3.5-  , [10.00, 1.25]         -- 4.0-  , [10.40, 1.65]         -- 4.5-  , [10.85, 2.10]         -- 5.0-  , [20.00, 11.35, 2.60]  -- 5.5-  , [20.55, 11.90, 3.15]  -- 6.0-  , [21.15, 12.50, 3.75]  -- 6.5-  , [21.80, 13.15, 4.40]  -- 7.0-  , [22.50, 13.85]        -- 7.5-  , [23.25, 14.60]        -- 8.0-  , [24.05, 15.40]        -- 8.5-  , [24.90, 16.25]        -- 9.0-  , [25.80, 17.15]        -- 9.5-  ]--pswitch_t2 :: [[Double]]-pswitch_t2 = take 20 $ embed sf pswitch_inp1-  where-    sf =-      pSwitchB [] (now 10.0) $ \sfs x ->-      pSwitchB (integral:sfs) (whenFstGE 3.75 10.0) $ \sfs x ->-      pSwitchB ((integral>>>arr(+x)):sfs)(whenFstGE 5.25 20.0) $ \sfs x->-      pSwitchB ((integral>>>arr(+x)):sfs)(now 20.0) $ \sfs _->-      parB (take 2 sfs)--pswitch_t2r =-  [ [0.00]          -- 0.0-  , [0.00]          -- 0.5-  , [0.05]          -- 1.0-  , [0.15]          -- 1.5-  , [0.30]          -- 2.0-  , [0.50]          -- 2.5-  , [0.75]          -- 3.0-  , [1.05]          -- 3.5-  , [10.00,  1.40]  -- 4.0-  , [10.40,  1.80]  -- 4.5-  , [10.85,  2.25]  -- 5.0-  , [20.00, 11.35]  -- 5.5-  , [20.55, 11.90]  -- 6.0-  , [21.15, 12.50]  -- 6.5-  , [21.80, 13.15]  -- 7.0-  , [22.50, 13.85]  -- 7.5-  , [23.25, 14.60]  -- 8.0-  , [24.05, 15.40]  -- 8.5-  , [24.90, 16.25]  -- 9.0-  , [25.80, 17.15]  -- 9.5-  ]---- Variation of the last dpSwitchB test below, with direct observation (not--- via loop) and immediate switch.---- We assume that only one signal function will reach the limit at a time.-pswitch_limit2 :: Double -> SF (a, [Double]) (Event Int)-pswitch_limit2 x = arr snd >>> arr (findIndex (>=x)) >>> edgeJust--pswitch_t5 :: [([Double], Double)]-pswitch_t5 = take 30 $ embed (loop sf) (deltaEncode 0.1 (repeat ()))-  where-    sf :: SF (a, [Double]) (([Double], Double), [Double])-    sf = ((pSwitchB [pswitch_ramp 0.0, pswitch_ramp 1.0, pswitch_ramp 2.0]-                    (pswitch_limit2 2.99)-                    pswitch_t5rec)-          &&& (arr snd >>> arr sum))-         >>> arr (\(xs, y) -> ((xs, y), xs))--pswitch_t5rec :: [SF (a, [Double]) Double]-                 -> Int-                 -> SF (a, [Double]) [Double]-pswitch_t5rec sfs n =-  pSwitchB (take n sfs ++ [pswitch_ramp 0.0] ++ drop (n+1) sfs)-           (pswitch_limit2 2.99)-           pswitch_t5rec--pswitch_t5r =-  [ ([0.0, 1.0, 2.0], 3.0)-  , ([0.2, 1.2, 2.2], 3.6)-  , ([0.4, 1.4, 2.4], 4.2)-  , ([0.6, 1.6, 2.6], 4.8)-  , ([0.8, 1.8, 2.8], 5.4)-  , ([1.0, 2.0, 0.0], 3.0)-  , ([1.2, 2.2, 0.2], 3.6)-  , ([1.4, 2.4, 0.4], 4.2)-  , ([1.6, 2.6, 0.6], 4.8)-  , ([1.8, 2.8, 0.8], 5.4)-  , ([2.0, 0.0, 1.0], 3.0)-  , ([2.2, 0.2, 1.2], 3.6)-  , ([2.4, 0.4, 1.4], 4.2)-  , ([2.6, 0.6, 1.6], 4.8)-  , ([2.8, 0.8, 1.8], 5.4)-  , ([0.0, 1.0, 2.0], 3.0)-  , ([0.2, 1.2, 2.2], 3.6)-  , ([0.4, 1.4, 2.4], 4.2)-  , ([0.6, 1.6, 2.6], 4.8)-  , ([0.8, 1.8, 2.8], 5.4)-  , ([1.0, 2.0, 0.0], 3.0)-  , ([1.2, 2.2, 0.2], 3.6)-  , ([1.4, 2.4, 0.4], 4.2)-  , ([1.6, 2.6, 0.6], 4.8)-  , ([1.8, 2.8, 0.8], 5.4)-  , ([2.0, 0.0, 1.0], 3.0)-  , ([2.2, 0.2, 1.2], 3.6)-  , ([2.4, 0.4, 1.4], 4.2)-  , ([2.6, 0.6, 1.6], 4.8)-  , ([2.8, 0.8, 1.8], 5.4)-  ]--pswitch_t1 :: [[Double]]-pswitch_t1 = take 20 $ embed sf pswitch_inp1-  where-    sf =-      dpSwitchB [] (whenFstGE 1.25 10.0) $ \sfs x ->-      dpSwitchB (integral:sfs) (whenFstGE 3.75 10.0) $ \sfs x ->-      dpSwitchB ((integral>>>arr(+x)):sfs)(whenFstGE 5.25 20.0)$ \sfs x->-      dpSwitchB ((integral>>>arr(+x)):sfs)(whenFstGE 7.25 20.0)$ \sfs _->-      parB (take 2 sfs)--pswitch_t1r =-  [ []                    -- 0.0-  , []                    -- 0.5-  , []                    -- 1.0-  , []                    -- 1.5-  , [0.15]                -- 2.0-  , [0.35]                -- 2.5-  , [0.60]                -- 3.0-  , [0.90]                -- 3.5-  , [1.25]                -- 4.0-  , [10.40, 1.65]         -- 4.5-  , [10.85, 2.10]         -- 5.0-  , [11.35, 2.60]         -- 5.5-  , [20.55, 11.90, 3.15]  -- 6.0-  , [21.15, 12.50, 3.75]  -- 6.5-  , [21.80, 13.15, 4.40]  -- 7.0-  , [22.50, 13.85, 5.10]  -- 7.5-  , [23.25, 14.60]        -- 8.0-  , [24.05, 15.40]        -- 8.5-  , [24.90, 16.25]        -- 9.0-  , [25.80, 17.15]        -- 9.5-  ]--pswitch_t3 :: [[Double]]-pswitch_t3 = take 20 $ embed sf pswitch_inp1-  where-    sf =-      dpSwitchB [] (now 10.0) $ \sfs x ->-      dpSwitchB (integral:sfs) (whenFstGE 3.75 10.0) $ \sfs x ->-      dpSwitchB ((integral>>>arr(+x)):sfs)(whenFstGE 5.25 20.0)$ \sfs x->-      dpSwitchB ((integral>>>arr(+x)):sfs) (now 20.0) $ \sfs _->-      parB (take 2 sfs)--pswitch_t3r =-  [ []                -- 0.0-  , [0.00]            -- 0.5-  , [0.05]            -- 1.0-  , [0.15]            -- 1.5-  , [0.30]            -- 2.0-  , [0.50]            -- 2.5-  , [0.75]            -- 3.0-  , [1.05]            -- 3.5-  , [1.40]            -- 4.0-  , [10.40,  1.80]    -- 4.5-  , [10.85,  2.25]    -- 5.0-  , [11.35,  2.75]    -- 5.5-  , [20.55, 11.90]    -- 6.0-  , [21.15, 12.50]    -- 6.5-  , [21.80, 13.15]    -- 7.0-  , [22.50, 13.85]    -- 7.5-  , [23.25, 14.60]    -- 8.0-  , [24.05, 15.40]    -- 8.5-  , [24.90, 16.25]    -- 9.0-  , [25.80, 17.15]    -- 9.5-  ]---- Starts three "ramps" with different phase. As soon as one exceeds a--- threshold, it's restarted, while the others are left alone. The--- observaton of the output is done via the loop (rather than the directly--- from the outputs of the signal functions in the collection), thus the--- use of a delayed switch is essential.--pswitch_ramp :: Double -> SF a Double-pswitch_ramp phase = constant 2.0 >>> integral >>> arr (+phase)---- We assume that only one signal function will reach the limit at a time.-pswitch_limit :: Double -> SF ((a, [Double]), b) (Event Int)-pswitch_limit x = arr (snd . fst) >>> arr (findIndex (>=x)) >>> edgeJust--pswitch_t4 :: [[Double]]-pswitch_t4 = take 30 $ embed (loop sf) (deltaEncode 0.1 (repeat ()))-  where-    sf :: SF (a, [Double]) ([Double],[Double])-    sf = dpSwitchB [pswitch_ramp 0.0, pswitch_ramp 1.0, pswitch_ramp 2.0]-                   (pswitch_limit 2.99)-                   pswitch_t4rec-         >>> arr dup--pswitch_t4rec :: [SF (a, [Double]) Double]-                 -> Int-                 -> SF (a, [Double]) [Double]-pswitch_t4rec sfs n =-  dpSwitchB (take n sfs ++ [pswitch_ramp 0.0] ++ drop (n+1) sfs)-            (pswitch_limit 2.99)-            pswitch_t4rec--pswitch_t4r =-  [ [0.0, 1.0, 2.0]-  , [0.2, 1.2, 2.2]-  , [0.4, 1.4, 2.4]-  , [0.6, 1.6, 2.6]-  , [0.8, 1.8, 2.8]-  , [1.0, 2.0, 3.0]-  , [1.2, 2.2, 0.2]-  , [1.4, 2.4, 0.4]-  , [1.6, 2.6, 0.6]-  , [1.8, 2.8, 0.8]-  , [2.0, 3.0, 1.0]-  , [2.2, 0.2, 1.2]-  , [2.4, 0.4, 1.4]-  , [2.6, 0.6, 1.6]-  , [2.8, 0.8, 1.8]-  , [3.0, 1.0, 2.0]-  , [0.2, 1.2, 2.2]-  , [0.4, 1.4, 2.4]-  , [0.6, 1.6, 2.6]-  , [0.8, 1.8, 2.8]-  , [1.0, 2.0, 3.0]-  , [1.2, 2.2, 0.2]-  , [1.4, 2.4, 0.4]-  , [1.6, 2.6, 0.6]-  , [1.8, 2.8, 0.8]-  , [2.0, 3.0, 1.0]-  , [2.2, 0.2, 1.2]-  , [2.4, 0.4, 1.4]-  , [2.6, 0.6, 1.6]-  , [2.8, 0.8, 1.8]-  ]--rpswitch_inp1 = (fromJust (head delta_inp), zip (repeat 1.0) (tail delta_inp))-  where-    delta_inp =-      [ Just (1.0, NoEvent), Nothing, Nothing-      , Just (2.0, Event (integral:)), Just (3.0, NoEvent), Nothing-      , Just (4.0, NoEvent), Nothing, Nothing-      , Just (5.0, Event ((integral >>> arr (+100.0)):))-      , Just (6.0, NoEvent), Nothing-      , Just (7.0, NoEvent), Nothing, Nothing-      , Just (8.0, Event tail), Just (9.0, NoEvent), Nothing-      ]-      ++ repeat Nothing---- This input contains exaples of "continuos switching", i.e. the same--- switching event ocurring during a a few contiguous time steps.--- It also starts with an immediate switch.-rpswitch_inp2 = (fromJust (head delta_inp), zip (repeat 1.0) (tail delta_inp))-  where-    delta_inp =-      [ Just (1.0, Event (integral:))-      , Just (1.0, NoEvent), Nothing-      , Just (2.0, Event ((integral >>> arr(+100.0)):)), Nothing, Nothing-      , Just (3.0, Event ((integral >>> arr(+200.0)):)), Nothing, Nothing-      , Just (4.0, NoEvent), Nothing, Nothing-      , Just (5.0, Event ((arr (*3)):))-      , Just (5.0, NoEvent), Nothing-      , Just (6.0, Event tail), Just (7.0, Event ((arr (*7)):))-      , Just (8.0, Event (take 2))-      , Just (9.0, NoEvent), Nothing-      ]-      ++ repeat Nothing--rpswitch_t0 :: [[Double]]-rpswitch_t0 = take 20 $ embed (rpSwitchB []) rpswitch_inp1--rpswitch_t0r =-  [ []             -- 0 s-  , []             -- 1 s-  , []             -- 2 s-  , [0.0]          -- 3 s-  , [2.0]          -- 4 s-  , [5.0]          -- 5 s-  , [8.0]          -- 6 s-  , [12.0]         -- 7 s-  , [16.0]         -- 8 s-  , [100.0, 20.0]  -- 9 s-  , [105.0, 25.0]  -- 10 s-  , [111.0, 31.0]  -- 11 s-  , [117.0, 37.0]  -- 12 s-  , [124.0, 44.0]  -- 13 s-  , [131.0, 51.0]  -- 14 s-  , [58.0]         -- 15 s-  , [66.0]         -- 16 s-  , [75.0]         -- 17 s-  , [84.0]         -- 18 s-  , [93.0]         -- 19 s-  ]--rpswitch_t2 :: [[Double]]-rpswitch_t2 = take 20 $ embed (rpSwitchB []) rpswitch_inp2--rpswitch_t2r =-  [ [0.0]                                                   -- 0 s-  , [1.0]                                                   -- 1 s-  , [2.0]                                                   -- 2 s-  , [100.0, 3.0]                                            -- 3 s-  , [100.0, 102.0, 5.0]                                     -- 4 s-  , [100.0, 102.0, 104.0, 7.0]                              -- 5 s-  , [200.0, 102.0, 104.0, 106.0, 9.0]                       -- 6 s-  , [200.0, 203.0, 105.0, 107.0, 109.0, 12.0]               -- 7 s-  , [200.0, 203.0, 206.0, 108.0, 110.0, 112.0, 15.0]        -- 8 s-  , [203.0, 206.0, 209.0, 111.0, 113.0, 115.0, 18.0]        -- 9 s-  , [207.0, 210.0, 213.0, 115.0, 117.0, 119.0, 22.0]        -- 10 s-  , [211.0, 214.0, 217.0, 119.0, 121.0, 123.0, 26.0]        -- 11 s-  , [15.0, 215.0, 218.0, 221.0, 123.0, 125.0, 127.0, 30.0]  -- 12 s-  , [15.0, 220.0, 223.0, 226.0, 128.0, 130.0, 132.0, 35.0]  -- 13 s-  , [15.0, 225.0, 228.0, 231.0, 133.0, 135.0, 137.0, 40.0]  -- 14 s-  , [230.0, 233.0, 236.0, 138.0, 140.0, 142.0, 45.0]        -- 15 s-  , [49.0, 236.0, 239.0, 242.0, 144.0, 146.0, 148.0, 51.0]  -- 16 s-  , [56.0, 243.0]                                           -- 17 s-  , [63.0, 251.0]                                           -- 18 s-  , [63.0, 260.0]                                           -- 19 s-  ]--rpswitch_t1 :: [[Double]]-rpswitch_t1 = take 20 $ embed (drpSwitchB []) rpswitch_inp1--rpswitch_t1r =-  [ []              -- 0 s-  , []              -- 1 s-  , []              -- 2 s-  , []              -- 3 s-  , [2.0]           -- 4 s-  , [5.0]           -- 5 s-  , [8.0]           -- 6 s-  , [12.0]          -- 7 s-  , [16.0]          -- 8 s-  , [20.0]          -- 9 s-  , [105.0, 25.0]   -- 10 s-  , [111.0, 31.0]   -- 11 s-  , [117.0, 37.0]   -- 12 s-  , [124.0, 44.0]   -- 13 s-  , [131.0, 51.0]   -- 14 s-  , [138.0, 58.0]   -- 15 s-  , [66.0]          -- 16 s-  , [75.0]          -- 17 s-  , [84.0]          -- 18 s-  , [93.0]          -- 19 s-  ]--rpswitch_t3 :: [[Double]]-rpswitch_t3 = take 20 $ embed (drpSwitchB []) rpswitch_inp2--rpswitch_t3r =-  [ []                                                      -- 0 s-  , [1.0]                                                   -- 1 s-  , [2.0]                                                   -- 2 s-  , [3.0]                                                   -- 3 s-  , [102.0, 5.0]                                            -- 4 s-  , [102.0, 104.0, 7.0]                                     -- 5 s-  , [102.0, 104.0, 106.0, 9.0]                              -- 6 s-  , [203.0, 105.0, 107.0, 109.0, 12.0]                      -- 7 s-  , [203.0, 206.0, 108.0, 110.0, 112.0, 15.0]               -- 8 s-  , [203.0, 206.0, 209.0, 111.0, 113.0, 115.0, 18.0]        -- 9 s-  , [207.0, 210.0, 213.0, 115.0, 117.0, 119.0, 22.0]        -- 10 s-  , [211.0, 214.0, 217.0, 119.0, 121.0, 123.0, 26.0]        -- 11 s-  , [215.0, 218.0, 221.0, 123.0, 125.0, 127.0, 30.0]        -- 12 s-  , [15.0, 220.0, 223.0, 226.0, 128.0, 130.0, 132.0, 35.0]  -- 13 s-  , [15.0, 225.0, 228.0, 231.0, 133.0, 135.0, 137.0, 40.0]  -- 14 s-  , [18.0, 230.0, 233.0, 236.0, 138.0, 140.0, 142.0, 45.0]  -- 15 s-  , [236.0, 239.0, 242.0, 144.0, 146.0, 148.0, 51.0]        -- 16 s-  , [56.0, 243.0, 246.0, 249.0, 151.0, 153.0, 155.0, 58.0]  -- 17 s-  , [63.0, 251.0]                                           -- 18 s-  , [63.0, 260.0]                                           -- 19 s-  ]---- Starts three "ramps" with different phase. As soon as one exceeds a--- threshold, it's restarted, while the others are left alone. The observaton--- of the output is done via a loop, thus the  use of a delayed switch is--- essential.--rpswitch_ramp :: Double -> SF a Double-rpswitch_ramp phase = constant 2.0 >>> integral >>> arr (+phase)---- We assume that only one signal function will reach the limit at a time.-rpswitch_limit :: Double -> SF [Double] (Event ([SF a Double]->[SF a Double]))-rpswitch_limit x = arr (findIndex (>=x)) >>> edgeJust >>> arr (fmap restart)-  where-    restart n = \sfs -> take n sfs ++ [rpswitch_ramp 0.0] ++ drop (n+1) sfs--rpswitch_t4 :: [[Double]]-rpswitch_t4 = take 30 $ embed (loop sf) (deltaEncode 0.1 (repeat ()))-  where-    sf :: SF (a, [Double]) ([Double],[Double])-    sf = (second (rpswitch_limit 2.99)-          >>> drpSwitchB [ rpswitch_ramp 0.0-                         , rpswitch_ramp 1.0-                         , rpswitch_ramp 2.0-                         ]-         )-         >>> arr dup--rpswitch_t4r =-  [ [0.0, 1.0, 2.0]-  , [0.2, 1.2, 2.2]-  , [0.4, 1.4, 2.4]-  , [0.6, 1.6, 2.6]-  , [0.8, 1.8, 2.8]-  , [1.0, 2.0, 3.0]-  , [1.2, 2.2, 0.2]-  , [1.4, 2.4, 0.4]-  , [1.6, 2.6, 0.6]-  , [1.8, 2.8, 0.8]-  , [2.0, 3.0, 1.0]-  , [2.2, 0.2, 1.2]-  , [2.4, 0.4, 1.4]-  , [2.6, 0.6, 1.6]-  , [2.8, 0.8, 1.8]-  , [3.0, 1.0, 2.0]-  , [0.2, 1.2, 2.2]-  , [0.4, 1.4, 2.4]-  , [0.6, 1.6, 2.6]-  , [0.8, 1.8, 2.8]-  , [1.0, 2.0, 3.0]-  , [1.2, 2.2, 0.2]-  , [1.4, 2.4, 0.4]-  , [1.6, 2.6, 0.6]-  , [1.8, 2.8, 0.8]-  , [2.0, 3.0, 1.0]-  , [2.2, 0.2, 1.2]-  , [2.4, 0.4, 1.4]-  , [2.6, 0.6, 1.6]-  , [2.8, 0.8, 1.8]-  ]---- * Parallel composition\/switching (lists)------ ** With "zip" routing--dynDelayLine :: a -> SF (a, Event Bool) a-dynDelayLine a0 =-    second (arr (fmap (\p -> if p then addDelay else delDelay)))-    >>> loop (arr (\((a, e), as) -> (a:as, e))-              >>> rpSwitchZ [iPre a0]-              >>> arr (\as -> (last as, init as)))-  where-    addDelay ds = ds ++ [last ds]--    delDelay [d] = [d]-    delDelay ds  = init ds--utils_t6 :: [Int]-utils_t6 = take 200 $ embed (dynDelayLine 0)-                            (deltaEncode 0.1 (zip [1..] evSeq))-  where-    evSeq = NoEvent : Event True : NoEvent : NoEvent : Event True :-            NoEvent : NoEvent : Event False : evSeq--utils_t6r =-  [ 0,1,1,2,3,3,4,6,7,8,8,9,10,10,11,13,14,15,15,16,17,17,18,20,21,22,22,23-  , 24,24,25,27,28,29,29,30,31,31,32,34,35,36,36,37,38,38,39,41,42,43,43,44-  , 45,45,46,48,49,50,50,51,52,52,53,55,56,57,57,58,59,59,60,62,63,64,64,65-  , 66,66,67,69,70,71,71,72,73,73,74,76,77,78,78,79,80,80,81,83,84,85,85,86-  , 87,87,88,90,91,92,92,93,94,94,95,97,98,99,99,100,101,101,102,104,105,106-  , 106,107,108,108,109,111,112,113,113,114,115,115,116,118,119,120,120,121-  , 122,122,123,125,126,127,127,128,129,129,130,132,133,134,134,135,136,136-  , 137,139,140,141,141,142,143,143,144,146,147,148,148,149,150,150,151,153-  , 154,155,155,156,157,157,158,160,161,162,162,163,164,164,165,167,168,169-  , 169,170,171,171,172,174-  ]---- * Auxiliary---- prop :: SF a b -> (a -> b ->-prop (a,b) = SP ((identity &&& a) >>^ uncurry b)+{-# LANGUAGE CPP    #-}+-- |+-- Description : Test cases for FRP.Yampa.Switches+-- Copyright   : (c) Ivan Perez, 2014-2022+--               (c) Antony Courtney and Henrik Nilsson, Yale University, 2003-2004+-- Authors     : Antony Courtney, Henrik Nilsson, Ivan Perez++-- - Restructure test cases for papallel composition and switches to reflect+--   Yampa structure better. Separate test cases for the generic definitions?+module Test.FRP.Yampa.Switches+    ( tests+    )+  where++#if __GLASGOW_HASKELL__ < 710+import Control.Applicative (pure, (<*>))+import Data.Functor        ((<$>))+#endif++import Data.Fixed+import Data.List (findIndex)+import Data.Maybe (fromJust)++import Test.QuickCheck+import Test.Tasty (TestTree, testGroup)+import Test.Tasty.QuickCheck (testProperty)++import FRP.Yampa as Yampa+import FRP.Yampa.Switches (dpSwitchZ, drpSwitchZ, pSwitchZ, parC, parZ,+                           rpSwitchZ)+import FRP.Yampa.EventS (snap)+import FRP.Yampa.Stream+import FRP.Yampa.QuickCheck+import FRP.Yampa.LTLFuture++import TestsCommon++tests :: TestTree+tests = testGroup "Regression tests for FRP.Yampa.Switches"+  [ testProperty "switch (0, fixed)"    (property $ switch_t0 ~= switch_t0r)+  , testProperty "switch (1, fixed)"    (property $ switch_t1 ~= switch_t1r)+  , testProperty "switch (5, fixed)"    (property $ switch_t5 ~= switch_t5r)+  , testProperty "switch (2, fixed)"    (property $ switch_t2 ~= switch_t2r)+  , testProperty "switch (3, fixed)"    (property $ switch_t3 ~= switch_t3r)+  , testProperty "switch (4, fixed)"    (property $ switch_t4 ~= switch_t4r)+  , testProperty "rswitch (0, fixed)"   (property $ rswitch_t0 ~= rswitch_t0r)+  , testProperty "rswitch (1, fixed)"   (property $ rswitch_t1 ~= rswitch_t1r)+  , testProperty "rswitch (2, fixed)"   (property $ rswitch_t2 ~= rswitch_t2r)+  , testProperty "rswitch (3, fixed)"   (property $ rswitch_t3 ~= rswitch_t3r)+  , testProperty "rswitch (4, fixed)"   (property $ rswitch_t4 ~= rswitch_t4r)+  , testProperty "kswitch (0, fixed)"   (property $ kswitch_t0 ~= kswitch_t0r)+  , testProperty "kswitch (2, fixed)"   (property $ kswitch_t2 ~= kswitch_t2r)+  , testProperty "kswitch (1, fixed)"   (property $ kswitch_t1 ~= kswitch_t1r)+  , testProperty "kswitch (3, fixed)"   (property $ kswitch_t3 ~= kswitch_t3r)+  , testProperty "kswitch (4, fixed)"   (property $ kswitch_t4 ~= kswitch_t4r)+  , testProperty "parB (fixed)"         (property $ coc_t0 ~= coc_t0r)+  , testProperty "parB (qc)"            prop_broadcast+  , testProperty "pswitch (0, fixed)"   (property $ pswitch_t0 ~= pswitch_t0r)+  , testProperty "pswitch (2, fixed)"   (property $ pswitch_t2 ~= pswitch_t2r)+  , testProperty "pswitch (5, fixed)"   (property $ pswitch_t5 ~= pswitch_t5r)+  , testProperty "pswitch (1, fixed)"   (property $ pswitch_t1 ~= pswitch_t1r)+  , testProperty "pswitch (3, fixed)"   (property $ pswitch_t3 ~= pswitch_t3r)+  , testProperty "pswitch (4, fixed)"   (property $ pswitch_t4 ~= pswitch_t4r)+  , testProperty "rpswitch (0, fixed)"  (property $ rpswitch_t0 ~= rpswitch_t0r)+  , testProperty "rpswitch (2, fixed)"  (property $ rpswitch_t2 ~= rpswitch_t2r)+  , 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++switch_t0 = take 18 $+  embed (switch switch_t0a $ \x ->+         switch (switch_t0b x) $ \x ->+         switch (switch_t0c x) $ \x ->+         switch (switch_t0c x) $ \x ->+         switch (switch_t0d x) $ \x ->+         switch (switch_t0e x) $ \x ->+         switch (switch_t0e x) $+         switch_t0final)+        switch_inp1++switch_t0a :: SF Double (Double, Event Int)+switch_t0a = localTime+             >>> arr dup+             >>> second (arr (>= 3.0) >>> edge >>> arr (`tag` 17))++switch_t0b :: Int -> SF Double (Double, Event Int)+switch_t0b x = localTime+               >>> arr dup+               >>> second (arr (>= 3.0) >>> edge >>> arr (`tag` (23 + x)))++-- This should raise an event IMMEDIATELY: no time should pass.+switch_t0c :: Num b => b -> SF a (a, Event b)+switch_t0c x = arr dup >>> second (now (x + 1))++switch_t0d x = (arr (+ (fromIntegral x))) &&& (arr (>= 7.0) >>> edge)++-- This should raise an event IMMEDIATELY: no time should pass.+switch_t0e :: b -> SF a (a, Event a)+switch_t0e _ = arr dup >>> second snap++switch_t0final :: Double -> SF Double Double+switch_t0final x = arr (+x)++switch_t0r =+  [ 0.0,  1.0,  2.0                     -- switch_t0a+  , 0.0,  1.0,  2.0                     -- switch_t0b+  , 46.0, 46.0, 46.0, 47.0, 48.0, 48.0  -- switch_t0d+  , 14.0, 14.0, 14.0, 15.0, 16.0, 16.0  -- switch_t0final+  ]++switch_inp1 = deltaEncode 1.0 $+  [ 1.0, 1.0, 1.0+  , 2.0+  , 3.0, 3.0+  , 4.0, 4.0, 4.0+  , 5.0+  , 6.0, 6.0+  , 7.0, 7.0, 7.0+  , 8.0+  ]+   ++ repeat 9.0++switch_t1 = take 32 $ embed (switch_t1rec 42.0) switch_inp1++-- Outputs current input, local time, and the value of the initializing+-- argument until some time has passed (determined by integrating a constant),+-- at which point an event occurs.+switch_t1a :: Double -> SF Double ((Double,Double,Double), Event ())+switch_t1a x = (arr dup >>> second localTime >>> arr (\(a,t) -> (a,t,x)))+               &&& (constant 0.5+                    >>> integral+                    >>> (arr (>= (2.0 :: Double)) -- Used to work with no sig.+                    >>> edge))++-- This should raise an event IMMEDIATELY: no time should pass.+switch_t1b :: b -> SF a ((Double,Double,Double), Event a)+switch_t1b _ = constant (-999.0,-999.0,-999.0) &&& snap++switch_t1rec :: Double -> SF Double (Double,Double,Double)+switch_t1rec x =+  switch (switch_t1a x) $ \x ->+  switch (switch_t1b x) $ \x ->+  switch (switch_t1b x) $+  switch_t1rec++switch_t1r =+  [ (1.0,0.0,42.0), (1.0,1.0,42.0), (1.0,2.0,42.0), (2.0,3.0,42.0)+  , (3.0,0.0,3.0),  (3.0,1.0,3.0),  (4.0,2.0,3.0),  (4.0,3.0,3.0)+  , (4.0,0.0,4.0),  (5.0,1.0,4.0),  (6.0,2.0,4.0),  (6.0,3.0,4.0)+  , (7.0,0.0,7.0),  (7.0,1.0,7.0),  (7.0,2.0,7.0),  (8.0,3.0,7.0)+  , (9.0,0.0,9.0),  (9.0,1.0,9.0),  (9.0,2.0,9.0),  (9.0,3.0,9.0)+  , (9.0,0.0,9.0),  (9.0,1.0,9.0),  (9.0,2.0,9.0),  (9.0,3.0,9.0)+  , (9.0,0.0,9.0),  (9.0,1.0,9.0),  (9.0,2.0,9.0),  (9.0,3.0,9.0)+  , (9.0,0.0,9.0),  (9.0,1.0,9.0),  (9.0,2.0,9.0),  (9.0,3.0,9.0)+  ]++prop_switch_t1 =+    forAll myStream $ evalT $+      Always $ SP ((switch_t1rec 42.0 &&& switch_tr) >>> arr same)++  where myStream :: Gen (SignalSampleStream Double)+        myStream = fixedDelayStreamWith f 1.0+        f dt = l!!(floor dt)+        l = [ 1.0, 1.0, 1.0+            , 2.0+            , 3.0, 3.0+            , 4.0, 4.0, 4.0+            , 5.0+            , 6.0, 6.0+            , 7.0, 7.0, 7.0+            , 8.0+            ]+             ++ repeat 9.0++        same = (uncurry (==))++switch_tr :: SF Double (Double, Double, Double)+switch_tr = proc (a) -> do+  t <- localTime -< ()+  let mt = fromIntegral $ floor (mod' t 4.0)+      v  = case floor (t / 4.0) of+             0 -> 42.0+             1 -> 3.0+             2 -> 4.0+             3 -> 7.0+             _ -> 9.0+  returnA -< (a, mt, v)++impulseIntegral2 :: (Fractional s, VectorSpace a s) => SF (a, Event a) a+impulseIntegral2 =+   switch (first integral >>> arr (\(a, ea) -> (a, fmap (^+^ a) ea)))+          impulseIntegral2'+ where+   impulseIntegral2' :: (Fractional s, VectorSpace a s)+                     => a -> SF (a, Event a) a+   impulseIntegral2' a =+     switch ((integral >>> arr (^+^ a)) *** notYet+             >>> arr (\(a, ea) -> (a, fmap (^+^ a) ea)))+            impulseIntegral2'++switch_t5 :: [Double]+switch_t5 = take 50 $ embed impulseIntegral2+                            (deltaEncode 0.1 (zip (repeat 1.0) evSeq))+  where+    evSeq = replicate 9 NoEvent ++ [Event 10.0]+            ++ replicate 9 NoEvent ++ [Event (-10.0)]+            ++ evSeq++switch_t5r =+  [  0.0,  0.1,  0.2,  0.3,  0.4,  0.5,  0.6,  0.7,  0.8, 10.9+  , 11.0, 11.1, 11.2, 11.3, 11.4, 11.5, 11.6, 11.7, 11.8,  1.9+  ,  2.0,  2.1,  2.2,  2.3,  2.4,  2.5,  2.6,  2.7,  2.8, 12.9+  , 13.0, 13.1, 13.2, 13.3, 13.4, 13.5, 13.6, 13.7, 13.8,  3.9+  ,  4.0,  4.1,  4.2,  4.3,  4.4,  4.5,  4.6,  4.7,  4.8, 14.9+  ]++switch_t2 = take 18 $+  embed (dSwitch switch_t0a $ \x ->+         dSwitch (switch_t0b x) $ \x ->+         dSwitch (switch_t0c x) $ \x ->+         dSwitch (switch_t0c x) $ \x ->+         dSwitch (switch_t0d x) $ \x ->+         dSwitch (switch_t0e x) $ \x ->+         dSwitch (switch_t0e x) $+         switch_t0final)+        switch_inp1++switch_t2r =+  [ 0.0,  1.0,  2.0                     -- switch_t0a+  , 3.0,  1.0,  2.0                     -- switch_t0b+  , 3.0,  46.0, 46.0, 47.0, 48.0, 48.0  -- switch_t0d+  , 49.0, 14.0, 14.0, 15.0, 16.0, 16.0  -- switch_t0final+  ]++switch_t3 = take 32 $ embed (switch_t3rec 42.0) switch_inp1++switch_t3rec :: Double -> SF Double (Double,Double,Double)+switch_t3rec x =+  dSwitch (switch_t1a x) $ \x ->+  dSwitch (switch_t1b x) $ \x ->+  dSwitch (switch_t1b x) $+  switch_t3rec++switch_t3r =+  [ (1.0,0.0,42.0), (1.0,1.0,42.0), (1.0,2.0,42.0), (2.0,3.0,42.0)+  , (3.0,4.0,42.0), (3.0,1.0,3.0),  (4.0,2.0,3.0),  (4.0,3.0,3.0)+  , (4.0,4.0,3.0),  (5.0,1.0,4.0),  (6.0,2.0,4.0),  (6.0,3.0,4.0)+  , (7.0,4.0,4.0),  (7.0,1.0,7.0),  (7.0,2.0,7.0),  (8.0,3.0,7.0)+  , (9.0,4.0,7.0),  (9.0,1.0,9.0),  (9.0,2.0,9.0),  (9.0,3.0,9.0)+  , (9.0,4.0,9.0),  (9.0,1.0,9.0),  (9.0,2.0,9.0),  (9.0,3.0,9.0)+  , (9.0,4.0,9.0),  (9.0,1.0,9.0),  (9.0,2.0,9.0),  (9.0,3.0,9.0)+  , (9.0,4.0,9.0),  (9.0,1.0,9.0),  (9.0,2.0,9.0),  (9.0,3.0,9.0)+  ]++-- The correct strictness properties of dSwitch are crucial here.+-- switch does not work.+switch_t4 = take 25 $+  embed (loop $+           dSwitch switch_t4a $ \_ ->+           dSwitch switch_t4a $ \_ ->+           dSwitch switch_t4a $ \_ ->+           switch_t4final+         )+        (deltaEncode 1.0 (repeat ()))++switch_t4a :: SF (a, Double) ((Double, Double), Event ())+switch_t4a = (constant 1.0 >>> integral >>> arr dup)+             &&& (arr (\ (_, x) -> x >= 5.0) >>> edge)++switch_t4final :: SF (a, Double) (Double, Double)+switch_t4final = constant 0.1 >>> integral >>> arr dup++switch_t4r =+  [ 0.0, 1.0, 2.0, 3.0, 4.0                           -- switch_t4a+  , 5.0, 1.0, 2.0, 3.0, 4.0                           -- switch_t4a+  , 5.0, 1.0, 2.0, 3.0, 4.0                           -- switch_t4a+  , 5.0, 0.1, 0.2, 0.3, 0.4, 0.5, 0.6, 0.7, 0.8, 0.9  -- switch_t4final+  ]++rswitch_inp1 = (fromJust (head delta_inp), zip (repeat 1.0) (tail delta_inp))+  where+    delta_inp =+      [ Just (1.0, NoEvent), Nothing, Nothing+      , Just (2.0, Event (arr (*3))), Just (3.0, NoEvent), Nothing+      , Just (4.0, NoEvent), Nothing, Nothing+      , Just (5.0, Event integral)+      , Just (6.0, NoEvent), Nothing+      , Just (7.0, NoEvent), Nothing, Nothing+      , Just (8.0, Event (arr (*7))), Just (9.0, NoEvent), Nothing+      ]+      ++ repeat Nothing++-- This input contains exaples of "continuos switching", i.e. the same+-- switching event ocurring during a a few contiguous time steps.+-- It also starts with an immediate switch.+rswitch_inp2 = (fromJust (head delta_inp), zip (repeat 1.0) (tail delta_inp))+  where+    delta_inp =+      [ Just (1.0, Event integral)+      , Just (1.0, NoEvent), Nothing+      , Just (2.0, Event (arr (*2))), Nothing, Nothing+      , Just (3.0, Event integral), Nothing, Nothing+      , Just (4.0, NoEvent), Nothing, Nothing+      , Just (5.0, Event integral)+      , Just (5.0, NoEvent), Nothing+      , Just (6.0, Event (arr (*3))), Just (7.0, Event (arr (*4)))+      , Just (8.0, Event integral)+      , Just (9.0, NoEvent), Nothing+      ]+      ++ repeat Nothing++rswitch_t0 = take 20 $ embed (rSwitch (arr (+3))) rswitch_inp1++-- Integration using rectangle rule assumed.+rswitch_t0r :: [Double]+rswitch_t0r =+  [ 4.0,  4.0,  4.0,  6.0,  9.0+  , 9.0,  12.0, 12.0, 12.0, 0.0+  , 5.0,  11.0, 17.0, 24.0, 31.0+  , 56.0, 63.0, 63.0, 63.0, 63.0+  ]++rswitch_t1 = take 20 $ embed (rSwitch integral) rswitch_inp1++-- Integration using rectangle rule assumed.+rswitch_t1r :: [Double]+rswitch_t1r =+  [ 0.0,  1.0,  2.0,  6.0,  9.0+  , 9.0,  12.0, 12.0, 12.0, 0.0+  , 5.0,  11.0, 17.0, 24.0, 31.0+  , 56.0, 63.0, 63.0, 63.0, 63.0+  ]++rswitch_t2 = take 20 $ embed (rSwitch (arr (+100))) rswitch_inp2++-- Integration using rectangle rule assumed.+rswitch_t2r :: [Double]+rswitch_t2r =+  [ 0.0,  1.0,  2.0, 4.0, 4.0+  , 4.0,  0.0,  0.0, 0.0, 3.0+  , 7.0,  11.0, 0.0, 5.0, 10.0+  , 18.0, 28.0, 0.0, 8.0, 17.0+  ]++rswitch_t3 = take 20 $ embed (drSwitch (arr (+100))) rswitch_inp2++-- Integration using rectangle rule assumed.+rswitch_t3r :: [Double]+rswitch_t3r =+  [ 101.0, 1.0,  2.0,  3.0, 4.0+  , 4.0,   6.0,  3.0,  3.0, 3.0+  , 7.0,   11.0, 15.0, 5.0, 10.0+  , 15.0,  21.0, 32.0, 8.0, 17.0+  ]++rswitch_sawTooth :: SF a Double+rswitch_sawTooth =+    loop (second (arr (>=5.0)+                  >>> edge+                  >>> arr (`tag` ramp))+          >>> drSwitch ramp+          >>> arr dup)+  where+    ramp :: SF a Double+    ramp = constant 1.0 >>> integral++rswitch_inp3 = deltaEncode 0.5 (repeat 0.0)++rswitch_t4 = take 40 $ embed rswitch_sawTooth rswitch_inp3++rswitch_t4r =+  [ 0.0, 0.5, 1.0, 1.5, 2.0+  , 2.5, 3.0, 3.5, 4.0, 4.5+  , 5.0, 0.5, 1.0, 1.5, 2.0+  , 2.5, 3.0, 3.5, 4.0, 4.5+  , 5.0, 0.5, 1.0, 1.5, 2.0+  , 2.5, 3.0, 3.5, 4.0, 4.5+  , 5.0, 0.5, 1.0, 1.5, 2.0+  , 2.5, 3.0, 3.5, 4.0, 4.5+  ]++kswitch_inp1 = deltaEncode 0.1 [0.0, 0.5 ..]++whenSndGE :: Ord b => b -> c -> SF (a, b) (Event c)+whenSndGE b c = arr snd >>> arr (>= b) >>> edge >>> arr (`tag` c)++kswitch_t0 :: [Double]+kswitch_t0 = take 20 $ embed sf kswitch_inp1+  where+    sf =+      kSwitch integral (whenSndGE 0.2 (-1.0)) $ \sf1 x ->+      kSwitch (integral >>> arr (+x)) (whenSndGE 1.0 (1.0)) $ \_ _ ->+      sf1++kswitch_t0r =+  [  0.00,  0.00,  0.05, 0.15, -1.00+  , -0.80, -0.55, -0.25, 0.10,  0.50+  ,  0.95,  0.30,  0.85, 1.45,  2.10+  ,  2.80,  3.55,  4.35, 5.20,  6.10+  ]++kswitch_t2 :: [Double]+kswitch_t2 = take 20 $ embed sf kswitch_inp1+  where+    sf =+      kSwitch integral (now (-1.0)) $ \sf1 x ->+      kSwitch (integral >>> arr (+x)) (whenSndGE 1.0 (1.0)) $ \_ _ ->+      sf1++kswitch_t2r =+  [ -1.00, -1.00, -0.95, -0.85, -0.70+  , -0.50, -0.25,  0.05,  0.40,  0.80+  ,  0.00,  0.50,  1.05,  1.65,  2.30+  ,  3.00,  3.75,  4.55,  5.40,  6.30+  ]++kswitch_t1 :: [Double]+kswitch_t1 = take 20 $ embed sf kswitch_inp1+  where+    sf =+      dkSwitch integral (whenSndGE 0.2 (-1.0)) $ \sf1 x ->+      dkSwitch (integral >>> arr (+x)) (whenSndGE 1.0 (1.0)) $ \_ _ ->+      sf1++kswitch_t1r =+  [  0.00,  0.00,  0.05, 0.15, 0.30+  , -0.80, -0.55, -0.25, 0.10, 0.50+  ,  0.95,  1.45,  0.85, 1.45, 2.10+  ,  2.80,  3.55,  4.35, 5.20, 6.10+  ]++kswitch_t3 :: [Double]+kswitch_t3 = take 20 $ embed sf kswitch_inp1+  where+    sf =+      dkSwitch integral (now (-1.0)) $ \sf1 x ->+      dkSwitch (integral >>> arr (+x)) (whenSndGE 1.0 (1.0)) $ \_ _ ->+      sf1++kswitch_t3r =+  [  0.00, -1.00, -0.95, -0.85, -0.70+  , -0.50, -0.25,  0.05,  0.40,  0.80+  ,  1.25,  0.50,  1.05,  1.65,  2.30+  ,  3.00,  3.75,  4.55,  5.40,  6.30+  ]++-- The correct strictness properties of dkSwitch are crucial here.+-- kSwitch does not work.+kswitch_t4 = take 40 $+    embed (loop $+             dkSwitch sf (sfe 0.55 (-1.0))              $ \sf1 x ->+             dkSwitch (sf >>> arr2 (+x)) (sfe 0.05 8.0) $ \sf2 y ->+             dkSwitch sf1 (sfe 2.0 (-2.0))              $ \_   z ->+             sf2 >>> arr2 (+(y + z))+          )+          (deltaEncode 0.1 (repeat ()))+  where+    sf :: SF (a, Double) (Double, Double)+    sf = constant 1.0 >>> integral >>> arr dup++    sfe :: Double -> Double -> SF ((a, Double), b) (Event Double)+    sfe x e = arr fst >>> whenSndGE x e++    arr2 f = arr (\(x,y) -> (f x, f y))++kswitch_t4r =+  [  0.0,  0.1,  0.2,  0.3,  0.4+  ,  0.5,  0.6, -0.9, -0.8, -0.7+  , -0.6, -0.5, -0.4, -0.3, -0.2+  , -0.1,  0.0,  0.1,  0.7,  0.8+  ,  0.9,  1.0,  1.1,  1.2,  1.3+  ,  1.4,  1.5,  1.6,  1.7,  1.8+  ,  1.9,  2.0,  6.2,  6.3,  6.4+  ,  6.5,  6.6,  6.7,  6.8,  6.9+  ]++-- * Parallel composition\/switching (collections)+-- ** With broadcasting++coc_inp1 = deltaEncode 0.1 [0.0, 0.5 ..]++coc_t0 :: [[Double]]+coc_t0 = take 20 $ embed (parB [constant 1.0, identity, integral]) coc_inp1++coc_t0r =+  [ [1.0, 0.0, 0.00]+  , [1.0, 0.5, 0.00]+  , [1.0, 1.0, 0.05]+  , [1.0, 1.5, 0.15]+  , [1.0, 2.0, 0.30]+  , [1.0, 2.5, 0.50]+  , [1.0, 3.0, 0.75]+  , [1.0, 3.5, 1.05]+  , [1.0, 4.0, 1.40]+  , [1.0, 4.5, 1.80]+  , [1.0, 5.0, 2.25]+  , [1.0, 5.5, 2.75]+  , [1.0, 6.0, 3.30]+  , [1.0, 6.5, 3.90]+  , [1.0, 7.0, 4.55]+  , [1.0, 7.5, 5.25]+  , [1.0, 8.0, 6.00]+  , [1.0, 8.5, 6.80]+  , [1.0, 9.0, 7.65]+  , [1.0, 9.5, 8.55]+  ]++-- Par with broadcast (collection-oriented combinators)+-- TODO: Add integral to the list of SFs being tested+prop_broadcast =+    forAll myStream $ evalT $ Always $ prop (sf, pred)+  where myStream :: Gen (SignalSampleStream Float)+        myStream = uniDistStream++        sf   = parB [identity, (arr (+1))]+        pred = (\x [y,z] -> x == y && (x + 1) == z)++pswitch_inp1 = deltaEncode 0.1 [0.0, 0.5 ..]++whenFstGE :: Ord a => a -> c -> SF (a, b) (Event c)+whenFstGE a c = arr fst >>> arr (>= a) >>> edge >>> arr (`tag` c)++pswitch_t0 :: [[Double]]+pswitch_t0 = take 20 $ embed sf pswitch_inp1+  where+    sf =+      pSwitchB [] (whenFstGE 1.25 10.0) $ \sfs x ->+      pSwitchB (integral:sfs) (whenFstGE 3.75 10.0) $ \sfs x ->+      pSwitchB ((integral>>>arr(+x)):sfs)(whenFstGE 5.25 20.0) $ \sfs x->+      pSwitchB ((integral>>>arr(+x)):sfs)(whenFstGE 7.25 20.0) $ \sfs _->+      parB (take 2 sfs)++pswitch_t0r =+  [ []                    -- 0.0+  , []                    -- 0.5+  , []                    -- 1.0+  , [0.0]                 -- 1.5+  , [0.15]                -- 2.0+  , [0.35]                -- 2.5+  , [0.60]                -- 3.0+  , [0.90]                -- 3.5+  , [10.00, 1.25]         -- 4.0+  , [10.40, 1.65]         -- 4.5+  , [10.85, 2.10]         -- 5.0+  , [20.00, 11.35, 2.60]  -- 5.5+  , [20.55, 11.90, 3.15]  -- 6.0+  , [21.15, 12.50, 3.75]  -- 6.5+  , [21.80, 13.15, 4.40]  -- 7.0+  , [22.50, 13.85]        -- 7.5+  , [23.25, 14.60]        -- 8.0+  , [24.05, 15.40]        -- 8.5+  , [24.90, 16.25]        -- 9.0+  , [25.80, 17.15]        -- 9.5+  ]++pswitch_t2 :: [[Double]]+pswitch_t2 = take 20 $ embed sf pswitch_inp1+  where+    sf =+      pSwitchB [] (now 10.0) $ \sfs x ->+      pSwitchB (integral:sfs) (whenFstGE 3.75 10.0) $ \sfs x ->+      pSwitchB ((integral>>>arr(+x)):sfs)(whenFstGE 5.25 20.0) $ \sfs x->+      pSwitchB ((integral>>>arr(+x)):sfs)(now 20.0) $ \sfs _->+      parB (take 2 sfs)++pswitch_t2r =+  [ [0.00]          -- 0.0+  , [0.00]          -- 0.5+  , [0.05]          -- 1.0+  , [0.15]          -- 1.5+  , [0.30]          -- 2.0+  , [0.50]          -- 2.5+  , [0.75]          -- 3.0+  , [1.05]          -- 3.5+  , [10.00,  1.40]  -- 4.0+  , [10.40,  1.80]  -- 4.5+  , [10.85,  2.25]  -- 5.0+  , [20.00, 11.35]  -- 5.5+  , [20.55, 11.90]  -- 6.0+  , [21.15, 12.50]  -- 6.5+  , [21.80, 13.15]  -- 7.0+  , [22.50, 13.85]  -- 7.5+  , [23.25, 14.60]  -- 8.0+  , [24.05, 15.40]  -- 8.5+  , [24.90, 16.25]  -- 9.0+  , [25.80, 17.15]  -- 9.5+  ]++-- Variation of the last dpSwitchB test below, with direct observation (not+-- via loop) and immediate switch.++-- We assume that only one signal function will reach the limit at a time.+pswitch_limit2 :: Double -> SF (a, [Double]) (Event Int)+pswitch_limit2 x = arr snd >>> arr (findIndex (>=x)) >>> edgeJust++pswitch_t5 :: [([Double], Double)]+pswitch_t5 = take 30 $ embed (loop sf) (deltaEncode 0.1 (repeat ()))+  where+    sf :: SF (a, [Double]) (([Double], Double), [Double])+    sf = ((pSwitchB [pswitch_ramp 0.0, pswitch_ramp 1.0, pswitch_ramp 2.0]+                    (pswitch_limit2 2.99)+                    pswitch_t5rec)+          &&& (arr snd >>> arr sum))+         >>> arr (\(xs, y) -> ((xs, y), xs))++pswitch_t5rec :: [SF (a, [Double]) Double]+                 -> Int+                 -> SF (a, [Double]) [Double]+pswitch_t5rec sfs n =+  pSwitchB (take n sfs ++ [pswitch_ramp 0.0] ++ drop (n+1) sfs)+           (pswitch_limit2 2.99)+           pswitch_t5rec++pswitch_t5r =+  [ ([0.0, 1.0, 2.0], 3.0)+  , ([0.2, 1.2, 2.2], 3.6)+  , ([0.4, 1.4, 2.4], 4.2)+  , ([0.6, 1.6, 2.6], 4.8)+  , ([0.8, 1.8, 2.8], 5.4)+  , ([1.0, 2.0, 0.0], 3.0)+  , ([1.2, 2.2, 0.2], 3.6)+  , ([1.4, 2.4, 0.4], 4.2)+  , ([1.6, 2.6, 0.6], 4.8)+  , ([1.8, 2.8, 0.8], 5.4)+  , ([2.0, 0.0, 1.0], 3.0)+  , ([2.2, 0.2, 1.2], 3.6)+  , ([2.4, 0.4, 1.4], 4.2)+  , ([2.6, 0.6, 1.6], 4.8)+  , ([2.8, 0.8, 1.8], 5.4)+  , ([0.0, 1.0, 2.0], 3.0)+  , ([0.2, 1.2, 2.2], 3.6)+  , ([0.4, 1.4, 2.4], 4.2)+  , ([0.6, 1.6, 2.6], 4.8)+  , ([0.8, 1.8, 2.8], 5.4)+  , ([1.0, 2.0, 0.0], 3.0)+  , ([1.2, 2.2, 0.2], 3.6)+  , ([1.4, 2.4, 0.4], 4.2)+  , ([1.6, 2.6, 0.6], 4.8)+  , ([1.8, 2.8, 0.8], 5.4)+  , ([2.0, 0.0, 1.0], 3.0)+  , ([2.2, 0.2, 1.2], 3.6)+  , ([2.4, 0.4, 1.4], 4.2)+  , ([2.6, 0.6, 1.6], 4.8)+  , ([2.8, 0.8, 1.8], 5.4)+  ]++pswitch_t1 :: [[Double]]+pswitch_t1 = take 20 $ embed sf pswitch_inp1+  where+    sf =+      dpSwitchB [] (whenFstGE 1.25 10.0) $ \sfs x ->+      dpSwitchB (integral:sfs) (whenFstGE 3.75 10.0) $ \sfs x ->+      dpSwitchB ((integral>>>arr(+x)):sfs)(whenFstGE 5.25 20.0)$ \sfs x->+      dpSwitchB ((integral>>>arr(+x)):sfs)(whenFstGE 7.25 20.0)$ \sfs _->+      parB (take 2 sfs)++pswitch_t1r =+  [ []                    -- 0.0+  , []                    -- 0.5+  , []                    -- 1.0+  , []                    -- 1.5+  , [0.15]                -- 2.0+  , [0.35]                -- 2.5+  , [0.60]                -- 3.0+  , [0.90]                -- 3.5+  , [1.25]                -- 4.0+  , [10.40, 1.65]         -- 4.5+  , [10.85, 2.10]         -- 5.0+  , [11.35, 2.60]         -- 5.5+  , [20.55, 11.90, 3.15]  -- 6.0+  , [21.15, 12.50, 3.75]  -- 6.5+  , [21.80, 13.15, 4.40]  -- 7.0+  , [22.50, 13.85, 5.10]  -- 7.5+  , [23.25, 14.60]        -- 8.0+  , [24.05, 15.40]        -- 8.5+  , [24.90, 16.25]        -- 9.0+  , [25.80, 17.15]        -- 9.5+  ]++pswitch_t3 :: [[Double]]+pswitch_t3 = take 20 $ embed sf pswitch_inp1+  where+    sf =+      dpSwitchB [] (now 10.0) $ \sfs x ->+      dpSwitchB (integral:sfs) (whenFstGE 3.75 10.0) $ \sfs x ->+      dpSwitchB ((integral>>>arr(+x)):sfs)(whenFstGE 5.25 20.0)$ \sfs x->+      dpSwitchB ((integral>>>arr(+x)):sfs) (now 20.0) $ \sfs _->+      parB (take 2 sfs)++pswitch_t3r =+  [ []                -- 0.0+  , [0.00]            -- 0.5+  , [0.05]            -- 1.0+  , [0.15]            -- 1.5+  , [0.30]            -- 2.0+  , [0.50]            -- 2.5+  , [0.75]            -- 3.0+  , [1.05]            -- 3.5+  , [1.40]            -- 4.0+  , [10.40,  1.80]    -- 4.5+  , [10.85,  2.25]    -- 5.0+  , [11.35,  2.75]    -- 5.5+  , [20.55, 11.90]    -- 6.0+  , [21.15, 12.50]    -- 6.5+  , [21.80, 13.15]    -- 7.0+  , [22.50, 13.85]    -- 7.5+  , [23.25, 14.60]    -- 8.0+  , [24.05, 15.40]    -- 8.5+  , [24.90, 16.25]    -- 9.0+  , [25.80, 17.15]    -- 9.5+  ]++-- Starts three "ramps" with different phase. As soon as one exceeds a+-- threshold, it's restarted, while the others are left alone. The+-- observaton of the output is done via the loop (rather than the directly+-- from the outputs of the signal functions in the collection), thus the+-- use of a delayed switch is essential.++pswitch_ramp :: Double -> SF a Double+pswitch_ramp phase = constant 2.0 >>> integral >>> arr (+phase)++-- We assume that only one signal function will reach the limit at a time.+pswitch_limit :: Double -> SF ((a, [Double]), b) (Event Int)+pswitch_limit x = arr (snd . fst) >>> arr (findIndex (>=x)) >>> edgeJust++pswitch_t4 :: [[Double]]+pswitch_t4 = take 30 $ embed (loop sf) (deltaEncode 0.1 (repeat ()))+  where+    sf :: SF (a, [Double]) ([Double],[Double])+    sf = dpSwitchB [pswitch_ramp 0.0, pswitch_ramp 1.0, pswitch_ramp 2.0]+                   (pswitch_limit 2.99)+                   pswitch_t4rec+         >>> arr dup++pswitch_t4rec :: [SF (a, [Double]) Double]+                 -> Int+                 -> SF (a, [Double]) [Double]+pswitch_t4rec sfs n =+  dpSwitchB (take n sfs ++ [pswitch_ramp 0.0] ++ drop (n+1) sfs)+            (pswitch_limit 2.99)+            pswitch_t4rec++pswitch_t4r =+  [ [0.0, 1.0, 2.0]+  , [0.2, 1.2, 2.2]+  , [0.4, 1.4, 2.4]+  , [0.6, 1.6, 2.6]+  , [0.8, 1.8, 2.8]+  , [1.0, 2.0, 3.0]+  , [1.2, 2.2, 0.2]+  , [1.4, 2.4, 0.4]+  , [1.6, 2.6, 0.6]+  , [1.8, 2.8, 0.8]+  , [2.0, 3.0, 1.0]+  , [2.2, 0.2, 1.2]+  , [2.4, 0.4, 1.4]+  , [2.6, 0.6, 1.6]+  , [2.8, 0.8, 1.8]+  , [3.0, 1.0, 2.0]+  , [0.2, 1.2, 2.2]+  , [0.4, 1.4, 2.4]+  , [0.6, 1.6, 2.6]+  , [0.8, 1.8, 2.8]+  , [1.0, 2.0, 3.0]+  , [1.2, 2.2, 0.2]+  , [1.4, 2.4, 0.4]+  , [1.6, 2.6, 0.6]+  , [1.8, 2.8, 0.8]+  , [2.0, 3.0, 1.0]+  , [2.2, 0.2, 1.2]+  , [2.4, 0.4, 1.4]+  , [2.6, 0.6, 1.6]+  , [2.8, 0.8, 1.8]+  ]++rpswitch_inp1 = (fromJust (head delta_inp), zip (repeat 1.0) (tail delta_inp))+  where+    delta_inp =+      [ Just (1.0, NoEvent), Nothing, Nothing+      , Just (2.0, Event (integral:)), Just (3.0, NoEvent), Nothing+      , Just (4.0, NoEvent), Nothing, Nothing+      , Just (5.0, Event ((integral >>> arr (+100.0)):))+      , Just (6.0, NoEvent), Nothing+      , Just (7.0, NoEvent), Nothing, Nothing+      , Just (8.0, Event tail), Just (9.0, NoEvent), Nothing+      ]+      ++ repeat Nothing++-- This input contains exaples of "continuos switching", i.e. the same+-- switching event ocurring during a a few contiguous time steps.+-- It also starts with an immediate switch.+rpswitch_inp2 = (fromJust (head delta_inp), zip (repeat 1.0) (tail delta_inp))+  where+    delta_inp =+      [ Just (1.0, Event (integral:))+      , Just (1.0, NoEvent), Nothing+      , Just (2.0, Event ((integral >>> arr(+100.0)):)), Nothing, Nothing+      , Just (3.0, Event ((integral >>> arr(+200.0)):)), Nothing, Nothing+      , Just (4.0, NoEvent), Nothing, Nothing+      , Just (5.0, Event ((arr (*3)):))+      , Just (5.0, NoEvent), Nothing+      , Just (6.0, Event tail), Just (7.0, Event ((arr (*7)):))+      , Just (8.0, Event (take 2))+      , Just (9.0, NoEvent), Nothing+      ]+      ++ repeat Nothing++rpswitch_t0 :: [[Double]]+rpswitch_t0 = take 20 $ embed (rpSwitchB []) rpswitch_inp1++rpswitch_t0r =+  [ []             -- 0 s+  , []             -- 1 s+  , []             -- 2 s+  , [0.0]          -- 3 s+  , [2.0]          -- 4 s+  , [5.0]          -- 5 s+  , [8.0]          -- 6 s+  , [12.0]         -- 7 s+  , [16.0]         -- 8 s+  , [100.0, 20.0]  -- 9 s+  , [105.0, 25.0]  -- 10 s+  , [111.0, 31.0]  -- 11 s+  , [117.0, 37.0]  -- 12 s+  , [124.0, 44.0]  -- 13 s+  , [131.0, 51.0]  -- 14 s+  , [58.0]         -- 15 s+  , [66.0]         -- 16 s+  , [75.0]         -- 17 s+  , [84.0]         -- 18 s+  , [93.0]         -- 19 s+  ]++rpswitch_t2 :: [[Double]]+rpswitch_t2 = take 20 $ embed (rpSwitchB []) rpswitch_inp2++rpswitch_t2r =+  [ [0.0]                                                   -- 0 s+  , [1.0]                                                   -- 1 s+  , [2.0]                                                   -- 2 s+  , [100.0, 3.0]                                            -- 3 s+  , [100.0, 102.0, 5.0]                                     -- 4 s+  , [100.0, 102.0, 104.0, 7.0]                              -- 5 s+  , [200.0, 102.0, 104.0, 106.0, 9.0]                       -- 6 s+  , [200.0, 203.0, 105.0, 107.0, 109.0, 12.0]               -- 7 s+  , [200.0, 203.0, 206.0, 108.0, 110.0, 112.0, 15.0]        -- 8 s+  , [203.0, 206.0, 209.0, 111.0, 113.0, 115.0, 18.0]        -- 9 s+  , [207.0, 210.0, 213.0, 115.0, 117.0, 119.0, 22.0]        -- 10 s+  , [211.0, 214.0, 217.0, 119.0, 121.0, 123.0, 26.0]        -- 11 s+  , [15.0, 215.0, 218.0, 221.0, 123.0, 125.0, 127.0, 30.0]  -- 12 s+  , [15.0, 220.0, 223.0, 226.0, 128.0, 130.0, 132.0, 35.0]  -- 13 s+  , [15.0, 225.0, 228.0, 231.0, 133.0, 135.0, 137.0, 40.0]  -- 14 s+  , [230.0, 233.0, 236.0, 138.0, 140.0, 142.0, 45.0]        -- 15 s+  , [49.0, 236.0, 239.0, 242.0, 144.0, 146.0, 148.0, 51.0]  -- 16 s+  , [56.0, 243.0]                                           -- 17 s+  , [63.0, 251.0]                                           -- 18 s+  , [63.0, 260.0]                                           -- 19 s+  ]++rpswitch_t1 :: [[Double]]+rpswitch_t1 = take 20 $ embed (drpSwitchB []) rpswitch_inp1++rpswitch_t1r =+  [ []              -- 0 s+  , []              -- 1 s+  , []              -- 2 s+  , []              -- 3 s+  , [2.0]           -- 4 s+  , [5.0]           -- 5 s+  , [8.0]           -- 6 s+  , [12.0]          -- 7 s+  , [16.0]          -- 8 s+  , [20.0]          -- 9 s+  , [105.0, 25.0]   -- 10 s+  , [111.0, 31.0]   -- 11 s+  , [117.0, 37.0]   -- 12 s+  , [124.0, 44.0]   -- 13 s+  , [131.0, 51.0]   -- 14 s+  , [138.0, 58.0]   -- 15 s+  , [66.0]          -- 16 s+  , [75.0]          -- 17 s+  , [84.0]          -- 18 s+  , [93.0]          -- 19 s+  ]++rpswitch_t3 :: [[Double]]+rpswitch_t3 = take 20 $ embed (drpSwitchB []) rpswitch_inp2++rpswitch_t3r =+  [ []                                                      -- 0 s+  , [1.0]                                                   -- 1 s+  , [2.0]                                                   -- 2 s+  , [3.0]                                                   -- 3 s+  , [102.0, 5.0]                                            -- 4 s+  , [102.0, 104.0, 7.0]                                     -- 5 s+  , [102.0, 104.0, 106.0, 9.0]                              -- 6 s+  , [203.0, 105.0, 107.0, 109.0, 12.0]                      -- 7 s+  , [203.0, 206.0, 108.0, 110.0, 112.0, 15.0]               -- 8 s+  , [203.0, 206.0, 209.0, 111.0, 113.0, 115.0, 18.0]        -- 9 s+  , [207.0, 210.0, 213.0, 115.0, 117.0, 119.0, 22.0]        -- 10 s+  , [211.0, 214.0, 217.0, 119.0, 121.0, 123.0, 26.0]        -- 11 s+  , [215.0, 218.0, 221.0, 123.0, 125.0, 127.0, 30.0]        -- 12 s+  , [15.0, 220.0, 223.0, 226.0, 128.0, 130.0, 132.0, 35.0]  -- 13 s+  , [15.0, 225.0, 228.0, 231.0, 133.0, 135.0, 137.0, 40.0]  -- 14 s+  , [18.0, 230.0, 233.0, 236.0, 138.0, 140.0, 142.0, 45.0]  -- 15 s+  , [236.0, 239.0, 242.0, 144.0, 146.0, 148.0, 51.0]        -- 16 s+  , [56.0, 243.0, 246.0, 249.0, 151.0, 153.0, 155.0, 58.0]  -- 17 s+  , [63.0, 251.0]                                           -- 18 s+  , [63.0, 260.0]                                           -- 19 s+  ]++-- Starts three "ramps" with different phase. As soon as one exceeds a+-- threshold, it's restarted, while the others are left alone. The observaton+-- of the output is done via a loop, thus the  use of a delayed switch is+-- essential.++rpswitch_ramp :: Double -> SF a Double+rpswitch_ramp phase = constant 2.0 >>> integral >>> arr (+phase)++-- We assume that only one signal function will reach the limit at a time.+rpswitch_limit :: Double -> SF [Double] (Event ([SF a Double]->[SF a Double]))+rpswitch_limit x = arr (findIndex (>=x)) >>> edgeJust >>> arr (fmap restart)+  where+    restart n = \sfs -> take n sfs ++ [rpswitch_ramp 0.0] ++ drop (n+1) sfs++rpswitch_t4 :: [[Double]]+rpswitch_t4 = take 30 $ embed (loop sf) (deltaEncode 0.1 (repeat ()))+  where+    sf :: SF (a, [Double]) ([Double],[Double])+    sf = (second (rpswitch_limit 2.99)+          >>> drpSwitchB [ rpswitch_ramp 0.0+                         , rpswitch_ramp 1.0+                         , rpswitch_ramp 2.0+                         ]+         )+         >>> arr dup++rpswitch_t4r =+  [ [0.0, 1.0, 2.0]+  , [0.2, 1.2, 2.2]+  , [0.4, 1.4, 2.4]+  , [0.6, 1.6, 2.6]+  , [0.8, 1.8, 2.8]+  , [1.0, 2.0, 3.0]+  , [1.2, 2.2, 0.2]+  , [1.4, 2.4, 0.4]+  , [1.6, 2.6, 0.6]+  , [1.8, 2.8, 0.8]+  , [2.0, 3.0, 1.0]+  , [2.2, 0.2, 1.2]+  , [2.4, 0.4, 1.4]+  , [2.6, 0.6, 1.6]+  , [2.8, 0.8, 1.8]+  , [3.0, 1.0, 2.0]+  , [0.2, 1.2, 2.2]+  , [0.4, 1.4, 2.4]+  , [0.6, 1.6, 2.6]+  , [0.8, 1.8, 2.8]+  , [1.0, 2.0, 3.0]+  , [1.2, 2.2, 0.2]+  , [1.4, 2.4, 0.4]+  , [1.6, 2.6, 0.6]+  , [1.8, 2.8, 0.8]+  , [2.0, 3.0, 1.0]+  , [2.2, 0.2, 1.2]+  , [2.4, 0.4, 1.4]+  , [2.6, 0.6, 1.6]+  , [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)))+    >>> loop (arr (\((a, e), as) -> (a:as, e))+              >>> rpSwitchZ [iPre a0]+              >>> arr (\as -> (last as, init as)))+  where+    addDelay ds = ds ++ [last ds]++    delDelay [d] = [d]+    delDelay ds  = init ds++utils_t6 :: [Int]+utils_t6 = take 200 $ embed (dynDelayLine 0)+                            (deltaEncode 0.1 (zip [1..] evSeq))+  where+    evSeq = NoEvent : Event True : NoEvent : NoEvent : Event True :+            NoEvent : NoEvent : Event False : evSeq++utils_t6r =+  [ 0,1,1,2,3,3,4,6,7,8,8,9,10,10,11,13,14,15,15,16,17,17,18,20,21,22,22,23+  , 24,24,25,27,28,29,29,30,31,31,32,34,35,36,36,37,38,38,39,41,42,43,43,44+  , 45,45,46,48,49,50,50,51,52,52,53,55,56,57,57,58,59,59,60,62,63,64,64,65+  , 66,66,67,69,70,71,71,72,73,73,74,76,77,78,78,79,80,80,81,83,84,85,85,86+  , 87,87,88,90,91,92,92,93,94,94,95,97,98,99,99,100,101,101,102,104,105,106+  , 106,107,108,108,109,111,112,113,113,114,115,115,116,118,119,120,120,121+  , 122,122,123,125,126,127,127,128,129,129,130,132,133,134,134,135,136,136+  , 137,139,140,141,141,142,143,143,144,146,147,148,148,149,150,150,151,153+  , 154,155,155,156,157,157,158,160,161,162,162,163,164,164,165,167,168,169+  , 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)]

@@ -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 @@     ( tests )   where +#if __GLASGOW_HASKELL__ < 710+import Data.Functor ((<$>))+#endif import Control.Monad (when, forever)  import Test.QuickCheck@@ -17,6 +21,10 @@ 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 @@   , 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 @@     , 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 @@ -- >>> 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)

@@ -31,7 +31,7 @@ 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 @@     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 @@     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.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