From 1a6912a616f3423ba5501a5becfd5427515d3267 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Wed, 7 Dec 2022 03:07:58 -0800 Subject: [PATCH 01/53] Revert "yampa: Disable flag before release. Refs #242." This reverts commit 223df6c9db93214f3b82613425d7e68c993472be. --- yampa/Yampa.cabal | 27 ++++++++++++++++++++++++++- 1 file changed, 26 insertions(+), 1 deletion(-) diff --git a/yampa/Yampa.cabal b/yampa/Yampa.cabal index 402e538e..470cb8ac 100644 --- a/yampa/Yampa.cabal +++ b/yampa/Yampa.cabal @@ -72,6 +72,25 @@ flag examples default: False manual: True +-- WARNING: The following flag exposes Yampa's core. You should avoid using +-- this at all. The only reason to expose it is that we are using Yampa for +-- research, and many extensions require that we expose the constructors. No +-- released project should depend on this. In general, you should always +-- install Yampa with this flag disabled. +flag expose-core + description: + You can enable exposing some of Yampa's core constructs using + -fexpose-core. + . + Enabling this is an unsupported configuration, but it may be useful if you + are building an extension of Yampa for research and do not wish to fork + Yampa completely. + . + No released project should ever depend on this. + default: False + manual: True + + library exposed-modules: FRP.Yampa @@ -94,7 +113,6 @@ library other-modules: -- Auxiliary (commonly used) types FRP.Yampa.Diagnostics - FRP.Yampa.InternalCore build-depends: base < 6 @@ -116,6 +134,13 @@ library build-depends: fail == 4.9.* + if flag(expose-core) + exposed-modules: + FRP.Yampa.InternalCore + else + other-modules: + FRP.Yampa.InternalCore + test-suite hlint type: From 2c7e28d8c7ab74f310229dadd524251642188956 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Sun, 25 Dec 2022 18:07:41 +0000 Subject: [PATCH 02/53] yampa-test: Complete tests for FRP.Yampa.Hybrid. Refs #243. This commit completes the unit tests for the functions in FRP.Yampa.Hybrid without a unit test, namely accumHold and dAccumHold. Note that the test for accumHold assumes that sampling happens more frequently than updates. --- yampa-test/tests/Test/FRP/Yampa/Hybrid.hs | 106 ++++++++++++++++++++++ 1 file changed, 106 insertions(+) diff --git a/yampa-test/tests/Test/FRP/Yampa/Hybrid.hs b/yampa-test/tests/Test/FRP/Yampa/Hybrid.hs index 67240e91..903657a9 100644 --- a/yampa-test/tests/Test/FRP/Yampa/Hybrid.hs +++ b/yampa-test/tests/Test/FRP/Yampa/Hybrid.hs @@ -8,14 +8,20 @@ module Test.FRP.Yampa.Hybrid where import Data.Maybe (fromJust) +import Data.Tuple (swap) import Test.QuickCheck +import Test.QuickCheck.Function import Test.Tasty (TestTree, testGroup) import Test.Tasty.QuickCheck (testProperty) import FRP.Yampa as Yampa import FRP.Yampa.Hybrid as Yampa +import FRP.Yampa.LTLFuture (evalT, TPred (Next, Always, SP)) +import FRP.Yampa.QuickCheck (uniDistStream, uniDistStreamMaxDT) +import FRP.Yampa.Stream + import TestsCommon tests :: TestTree @@ -46,6 +52,10 @@ tests = testGroup "Regression tests for FRP.Yampa.Hybrid" , testProperty "accum (15, fixed)" (property $ accum_t15 == accum_t15r) , testProperty "accum (16, fixed)" (property $ accum_t16 == accum_t16r) , testProperty "accum (17, fixed)" (property $ accum_t17 == accum_t17r) + , testProperty "accumHold (0, qc)" testAccumHold1 + , testProperty "accumHold (1, qc)" testAccumHold2 + , testProperty "dAccumHold (0, qc)" testDAccumHold1 + , testProperty "dAccumHold (1, qc)" testDAccumHold2 ] -- * Wave-form generation @@ -470,3 +480,99 @@ accum_t17 = take 40 $ embed (repeatedly 1.0 1 accum_t17r :: [Int] accum_t17r = accum_t16 -- Should agree! + +testAccumHold1 :: Property +testAccumHold1 = + forAll arbitrary $ \x -> + forAll myStream $ + evalT $ + Always $ prop ((sf x &&& sfByHand x), const close) + + where + myStream :: Gen (SignalSampleStream ()) + myStream = uniDistStream + + sf :: Double -> SF () Double + sf x = never >>> accumHold x + + sfByHand :: Double -> SF () Double + sfByHand x = constant x + + close (x, y) = abs (x - y) < 0.05 + +testAccumHold2 :: Property +testAccumHold2 = + forAll myStream $ evalT $ + Always $ prop ((sf &&& sfByHand), const close) + + where + myStream :: Gen (SignalSampleStream ()) + myStream = uniDistStreamMaxDT maxSamplingDelay + + sf :: SF () Double + sf = repeatedly eventUpdateDelay (+1) >>> accumHold 0 + + sfByHand :: SF () Double + sfByHand = time >>> arr floorDouble + + floorDouble :: Double -> Double + floorDouble x = fromIntegral ((floor x) :: Integer) + + -- Important that this number be smaller than eventUpdateDelay below. + maxSamplingDelay :: DTime + maxSamplingDelay = 0.9 + + -- Important that this delay be greater than maxSamplingDelay above. + eventUpdateDelay :: DTime + eventUpdateDelay = 1.0 + + close (x, y) = abs (x - y) < 0.05 + +-- Test that dAccumHold is like constant for the first sample +testDAccumHold1 :: Property +testDAccumHold1 = + forAll arbitrary $ \x -> + forAll myStream $ + evalT $ + prop (arr (fmap apply) >>> (sf x &&& sfByHand x), const close) + + where + myStream :: Gen (SignalSampleStream (Event (Fun Double Double))) + myStream = uniDistStream + + sf :: Double -> SF (Event (Double -> Double)) Double + sf x = dAccumHold x + + sfByHand :: Double -> SF (Event (Double -> Double)) Double + sfByHand x = constant x + + close (x, y) = abs (x - y) < 0.05 + +-- Test that dAccumHold is like accumHold delayed +testDAccumHold2 :: Property +testDAccumHold2 = + forAll arbitrary $ \x -> + forAll myStream $ + evalT $ + Next $ Always $ + prop (arr (fmap apply) >>> (sf x &&& sfByHand x), const close) + + where + myStream :: Gen (SignalSampleStream (Event (Fun Double Double))) + myStream = uniDistStream + + sf :: Double -> SF (Event (Double -> Double)) Double + sf x = dAccumHold x + + sfByHand :: Double -> SF (Event (Double -> Double)) Double + sfByHand x = accumHold x >>> loopPre x (arr swap) + + close (x, y) = abs (x - y) < 0.05 + +-- * Auxiliary +-- prop :: SF a b -> (a -> b -> +prop (a,b) = SP ((identity &&& a) >>^ uncurry b) + +-- ** Arbitrary value generation +instance Arbitrary x => Arbitrary (Event x) where + arbitrary = oneof [ return NoEvent, fmap Event $ arbitrary ] From fd2aaabbcaf22ca2894fc452cb656aeb44d9c8fe Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Sun, 25 Dec 2022 18:09:24 +0000 Subject: [PATCH 03/53] yampa-test: Document changes in CHANGELOG. Refs #243. --- yampa-test/CHANGELOG | 3 +++ 1 file changed, 3 insertions(+) diff --git a/yampa-test/CHANGELOG b/yampa-test/CHANGELOG index 028f2ac8..9fab54cb 100644 --- a/yampa-test/CHANGELOG +++ b/yampa-test/CHANGELOG @@ -1,3 +1,6 @@ +2022-12-25 Ivan Perez + * tests/: add tests for module FRP.Yampa.Hybrid (#243). + 2022-12-07 Ivan Perez * yampa-test.cabal: Version bump (0.14) (#242), add tests for module FRP.Yampa.Event (#237). From c52bf0ae70a56e8551ccb06bb384d22818129221 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Tue, 27 Dec 2022 01:24:49 +0000 Subject: [PATCH 04/53] yampa-test: Complete tests for FRP.Yampa.Arrow. Refs #244. This commit completes the unit tests for the functions in FRP.Yampa.Arrow. Note that this module is not FRP-specific or even FRP-aware. All functions are generic and require no signals. --- yampa-test/tests/Main.hs | 4 +- yampa-test/tests/Test/FRP/Yampa/Arrow.hs | 92 ++++++++++++++++++++++++ yampa-test/yampa-test.cabal | 1 + 3 files changed, 96 insertions(+), 1 deletion(-) create mode 100644 yampa-test/tests/Test/FRP/Yampa/Arrow.hs diff --git a/yampa-test/tests/Main.hs b/yampa-test/tests/Main.hs index 88a440e3..343f4b36 100644 --- a/yampa-test/tests/Main.hs +++ b/yampa-test/tests/Main.hs @@ -14,6 +14,7 @@ module Main where import Test.Tasty (TestTree, defaultMain, testGroup) +import qualified Test.FRP.Yampa.Arrow as Arrow import qualified Test.FRP.Yampa.Basic as Basic import qualified Test.FRP.Yampa.Conditional as Conditional import qualified Test.FRP.Yampa.Delays as Delays @@ -34,7 +35,8 @@ main = defaultMain tests tests :: TestTree tests = testGroup "Yampa QC properties" - [ Basic.tests + [ Arrow.tests + , Basic.tests , Conditional.tests , Delays.tests , Event.tests diff --git a/yampa-test/tests/Test/FRP/Yampa/Arrow.hs b/yampa-test/tests/Test/FRP/Yampa/Arrow.hs new file mode 100644 index 00000000..ab7119ff --- /dev/null +++ b/yampa-test/tests/Test/FRP/Yampa/Arrow.hs @@ -0,0 +1,92 @@ +-- | +-- Description : Test cases for arrow helper functions. +-- Copyright : (c) Ivan Perez, 2022 +-- Authors : Ivan Perez +module Test.FRP.Yampa.Arrow + ( tests + ) + where + +-- External modules +import Test.QuickCheck (Gen, Property, arbitrary, forAll, forAllBlind) +import Test.Tasty (TestTree, testGroup) +import Test.Tasty.QuickCheck (testProperty) + +-- External modules: Yampa +import FRP.Yampa as Yampa +import FRP.Yampa.Arrow as Yampa + +tests :: TestTree +tests = testGroup "Regression tests for FRP.Yampa.Arrow" + [ testProperty "dup (qc)" testDup + , testProperty "arr2 (qc)" testArr2 + , testProperty "arr3 (qc)" testArr3 + , testProperty "arr4 (qc)" testArr4 + , testProperty "arr5 (qc)" testArr5 + ] + +-- * Arrow plumbing aids + +testDup :: Property +testDup = + forAll input $ \x -> + (fst (dup x) == x) && (snd (dup x) == x) + where + input :: Gen Integer + input = arbitrary + +-- * Liftings + +testArr2 :: Property +testArr2 = + forAll input $ \x@(x1, x2) -> + forAllBlind inputF $ \f -> + arr2 f x == f x1 x2 + where + input :: Gen (Integer, Integer) + input = arbitrary + + inputF :: Gen (Integer -> Integer -> Integer) + inputF = arbitrary + +testArr3 :: Property +testArr3 = + forAll input $ \x@(x1, x2, x3) -> + forAllBlind inputF $ \f -> + arr3 f x == f x1 x2 x3 + where + input :: Gen (Integer, Integer, Integer) + input = arbitrary + + inputF :: Gen (Integer -> Integer -> Integer -> Integer) + inputF = arbitrary + +testArr4 :: Property +testArr4 = + forAll input $ \x@(x1, x2, x3, x4) -> + forAllBlind inputF $ \f -> + arr4 f x == f x1 x2 x3 x4 + where + input :: Gen (Integer, Integer, Integer, Integer) + input = arbitrary + + inputF :: Gen (Integer -> Integer -> Integer -> Integer -> Integer) + inputF = arbitrary + +testArr5 :: Property +testArr5 = + forAll input $ \x@(x1, x2, x3, x4, x5) -> + forAllBlind inputF $ \f -> + arr5 f x == f x1 x2 x3 x4 x5 + where + input :: Gen (Integer, Integer, Integer, Integer, Integer) + input = arbitrary + + inputF :: Gen ( Integer + -> Integer + -> Integer + -> Integer + -> Integer + -> Integer + ) + inputF = arbitrary diff --git a/yampa-test/yampa-test.cabal b/yampa-test/yampa-test.cabal index 919aa59f..a9fa040f 100644 --- a/yampa-test/yampa-test.cabal +++ b/yampa-test/yampa-test.cabal @@ -101,6 +101,7 @@ test-suite yampa-quicheck Main.hs other-modules: + Test.FRP.Yampa.Arrow Test.FRP.Yampa.Basic Test.FRP.Yampa.Conditional Test.FRP.Yampa.Delays From c654a8e778eb8d281c032c4863909a575dba3d6d Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Tue, 27 Dec 2022 01:26:40 +0000 Subject: [PATCH 05/53] yampa-test: Document changes in CHANGELOG. Refs #244. --- yampa-test/CHANGELOG | 5 +++-- 1 file changed, 3 insertions(+), 2 deletions(-) diff --git a/yampa-test/CHANGELOG b/yampa-test/CHANGELOG index 9fab54cb..bd1e7ad2 100644 --- a/yampa-test/CHANGELOG +++ b/yampa-test/CHANGELOG @@ -1,5 +1,6 @@ -2022-12-25 Ivan Perez - * tests/: add tests for module FRP.Yampa.Hybrid (#243). +2022-12-26 Ivan Perez + * tests/: add tests for module FRP.Yampa.Hybrid (#243), add tests for + module FRP.Yampa.Arrow (#244). 2022-12-07 Ivan Perez * yampa-test.cabal: Version bump (0.14) (#242), add tests for module From f1bae68aaa9c78d46f2093442853213f569f45a9 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Wed, 28 Dec 2022 10:34:59 +0000 Subject: [PATCH 06/53] yampa-test: test FRP.Yampa.Task.runTask_. Refs #245. This commit introduces a quickcheck-based unit test for the function FRP.Yampa.Task.runTask_. --- yampa-test/tests/Test/FRP/Yampa/Task.hs | 27 +++++++++++++++++++++++++ 1 file changed, 27 insertions(+) diff --git a/yampa-test/tests/Test/FRP/Yampa/Task.hs b/yampa-test/tests/Test/FRP/Yampa/Task.hs index b8a805a2..087741d4 100644 --- a/yampa-test/tests/Test/FRP/Yampa/Task.hs +++ b/yampa-test/tests/Test/FRP/Yampa/Task.hs @@ -17,6 +17,10 @@ import Test.Tasty.QuickCheck (testProperty) import FRP.Yampa as Yampa import FRP.Yampa.Task +import FRP.Yampa.LTLFuture (TPred (Always, SP), evalT) +import FRP.Yampa.QuickCheck (uniDistStream) +import FRP.Yampa.Stream (SignalSampleStream) + import TestsCommon tests :: TestTree @@ -30,6 +34,7 @@ tests = testGroup "Regression tests for FRP.Yampa.Task" , testProperty "tasks (fixed)" (property $ task_t6 ~= task_t6r) , testProperty "tasks (fixed)" (property $ task_t7 ~= task_t7r) , testProperty "tasks (fixed)" (property $ task_t8 ~= task_t8r) + , testProperty "runTask_ (qc)" testRunTask_ ] -- * The Task type @@ -210,6 +215,25 @@ task_t8r = , Right (Left 24.0,24.0) ] +testRunTask_ :: Property +testRunTask_ = + forAll arbitrary $ \i -> + forAll myStream $ + evalT $ Always $ prop (sf i &&& sfModel i, pred) + where + myStream :: Gen (SignalSampleStream Float) + myStream = uniDistStream + + sf :: Double -> SF Float Double + sf x = runTask_ $ constT x + + sfModel :: Double -> SF Float Double + sfModel x = constant x + + -- Both the SF under test and the model should behave the same way, + -- that is, output the same result. + pred _ = uncurry (==) + -- * Auxiliary -- | Repeat m until result satisfies the predicate p @@ -223,3 +247,6 @@ m `repeatUntil` p = m >>= \x -> if not (p x) then repeatUntil m p else return x -- >>> for 0 (+1) (>=10) ... for :: Monad m => a -> (a -> a) -> (a -> Bool) -> m b -> m () for i f p m = when (p i) $ m >> for (f i) f p m + +prop :: (SF a b, a -> b -> Bool) -> TPred a +prop (a, b) = SP ((identity &&& a) >>^ uncurry b) From aeee7e03a9c29ac3cdd873bd38180e4fe904fa4a Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Wed, 28 Dec 2022 10:35:23 +0000 Subject: [PATCH 07/53] yampa-test: test FRP.Yampa.Task.taskToSF. Refs #245. This commit introduces a quickcheck-based unit test for the function FRP.Yampa.Task.taskToSF. --- yampa-test/tests/Test/FRP/Yampa/Task.hs | 38 +++++++++++++++++++++++++ 1 file changed, 38 insertions(+) diff --git a/yampa-test/tests/Test/FRP/Yampa/Task.hs b/yampa-test/tests/Test/FRP/Yampa/Task.hs index 087741d4..04f1844e 100644 --- a/yampa-test/tests/Test/FRP/Yampa/Task.hs +++ b/yampa-test/tests/Test/FRP/Yampa/Task.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE CPP #-} -- | -- Description : Test cases for tasks (Task) -- Copyright : (c) Antony Courtney and Henrik Nilsson, Yale University, 2003-2004 @@ -8,6 +9,9 @@ module Test.FRP.Yampa.Task ( tests ) where +#if __GLASGOW_HASKELL__ < 710 +import Data.Functor ((<$>)) +#endif import Control.Monad (when, forever) import Test.QuickCheck @@ -35,6 +39,7 @@ tests = testGroup "Regression tests for FRP.Yampa.Task" , testProperty "tasks (fixed)" (property $ task_t7 ~= task_t7r) , testProperty "tasks (fixed)" (property $ task_t8 ~= task_t8r) , testProperty "runTask_ (qc)" testRunTask_ + , testProperty "taskToSF (qc)" testTaskToSF ] -- * The Task type @@ -234,6 +239,39 @@ testRunTask_ = -- 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 (==) + -- * Auxiliary -- | Repeat m until result satisfies the predicate p From 5a81178aa28434d3fc1ebbf31af988c7f72a8ec5 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Wed, 28 Dec 2022 10:35:30 +0000 Subject: [PATCH 08/53] yampa-test: test FRP.Yampa.Task.constT. Refs #245. This commit introduces a quickcheck-based unit test for the function FRP.Yampa.Task.constT. --- yampa-test/tests/Test/FRP/Yampa/Task.hs | 23 +++++++++++++++++++++++ 1 file changed, 23 insertions(+) diff --git a/yampa-test/tests/Test/FRP/Yampa/Task.hs b/yampa-test/tests/Test/FRP/Yampa/Task.hs index 04f1844e..3a1fc58f 100644 --- a/yampa-test/tests/Test/FRP/Yampa/Task.hs +++ b/yampa-test/tests/Test/FRP/Yampa/Task.hs @@ -40,6 +40,7 @@ tests = testGroup "Regression tests for FRP.Yampa.Task" , testProperty "tasks (fixed)" (property $ task_t8 ~= task_t8r) , testProperty "runTask_ (qc)" testRunTask_ , testProperty "taskToSF (qc)" testTaskToSF + , testProperty "constT (qc)" testConstT ] -- * The Task type @@ -272,6 +273,28 @@ testTaskToSF = -- 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 From 15bdad65ef9467b49e72f7aa6b90740e4e56f185 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Wed, 28 Dec 2022 12:25:14 +0000 Subject: [PATCH 09/53] yampa-test: Document changes in CHANGELOG. Refs #245. --- yampa-test/CHANGELOG | 5 +++-- 1 file changed, 3 insertions(+), 2 deletions(-) diff --git a/yampa-test/CHANGELOG b/yampa-test/CHANGELOG index bd1e7ad2..b2afd77b 100644 --- a/yampa-test/CHANGELOG +++ b/yampa-test/CHANGELOG @@ -1,6 +1,7 @@ -2022-12-26 Ivan Perez +2022-12-28 Ivan Perez * tests/: add tests for module FRP.Yampa.Hybrid (#243), add tests for - module FRP.Yampa.Arrow (#244). + module FRP.Yampa.Arrow (#244), complete unit tests for FRP.Yampa.Test + (#245). 2022-12-07 Ivan Perez * yampa-test.cabal: Version bump (0.14) (#242), add tests for module From a8446d23533685d774d4a64da455c9d6a396c3da Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Mon, 16 Jan 2023 20:27:22 +0000 Subject: [PATCH 10/53] yampa-test: Fix name of functions tested. Refs #246. The test names describing the functions tested in Test.FRP.Yampa.Simulation are incorrectly labeled: they say "react" when they should say "reactimate", and they say "embed" when they should say "embedSynch". This commit fixes those "labels" in the existing properties. --- yampa-test/tests/Test/FRP/Yampa/Simulation.hs | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/yampa-test/tests/Test/FRP/Yampa/Simulation.hs b/yampa-test/tests/Test/FRP/Yampa/Simulation.hs index 6056f1a8..f7a6f29f 100644 --- a/yampa-test/tests/Test/FRP/Yampa/Simulation.hs +++ b/yampa-test/tests/Test/FRP/Yampa/Simulation.hs @@ -19,9 +19,9 @@ 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 "embedSynch (0, fixed)" (property $ embed_t0 ~= embed_t0r) + , testProperty "embedSynch (1, fixed)" (property $ embed_t1 ~= embed_t1r) ] -- * Reactimation From 7b75e04c9620f3f66bb618197461cde572d4d24a Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Mon, 16 Jan 2023 14:03:57 -0800 Subject: [PATCH 11/53] yampa-test: Test FRP.Yampa.Simulation.{react, reactInit}. Refs #246. This commit introduces a quickcheck-based unit test for the function Test FRP.Yampa.Simulation.{react, reactInit}. There isn't much that can be tested with reactInit alone without the only other available function to work with ReactHandles, react. Consequenty, the test introduced tests both reactInit and react together. --- yampa-test/tests/Test/FRP/Yampa/Simulation.hs | 66 ++++++++++++++++++- 1 file changed, 65 insertions(+), 1 deletion(-) diff --git a/yampa-test/tests/Test/FRP/Yampa/Simulation.hs b/yampa-test/tests/Test/FRP/Yampa/Simulation.hs index f7a6f29f..649186b7 100644 --- a/yampa-test/tests/Test/FRP/Yampa/Simulation.hs +++ b/yampa-test/tests/Test/FRP/Yampa/Simulation.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE CPP #-} -- | -- Description : Test cases for FRP.Yampa.Simulation -- Copyright : (c) Antony Courtney and Henrik Nilsson, Yale University, 2003-2004 @@ -7,19 +8,28 @@ module Test.FRP.Yampa.Simulation ) where +#if __GLASGOW_HASKELL__ < 710 +import Control.Applicative ((<*>)) +import Data.Functor ((<$>)) +#endif + 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 "reactimate (fixed)" (property $ react_t0 ~= react_t0r) + , testProperty "react, reactInit (qc)" testReact , testProperty "embedSynch (0, fixed)" (property $ embed_t0 ~= embed_t0r) , testProperty "embedSynch (1, fixed)" (property $ embed_t1 ~= embed_t1r) ] @@ -66,6 +76,60 @@ react_t0r = , (2.0,1.50), (2.0,1.70), (2.0,1.90), (2.0,2.10), (2.0,2.30) ] +-- ** Low-level reactimation interface + +testReact :: Property +testReact = + forAll myStream $ \s -> + forAllBlind randomSF $ \sf -> + ioProperty $ do + outs <- reactEmbed sf s + let outsE = embed sf (structure s) + return $ outs == outsE + + where + + myStream :: Gen (SignalSampleStream Integer) + myStream = uniDistStream + + randomSF :: Gen (SF Integer Integer) + randomSF = oneof [ return identity + , pointwiseSF + , loopPre <$> arbitrary <*> randomSF2 + ] + + randomSF2 :: Gen (SF (Integer, Integer) (Integer, Integer)) + randomSF2 = oneof [ return identity + , pointwiseSF2 + ] + + pointwiseSF :: Gen (SF Integer Integer) + pointwiseSF = arr <$> arbitrary + + pointwiseSF2 :: Gen (SF (Integer, Integer) (Integer, Integer)) + pointwiseSF2 = arr <$> arbitrary + + 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 embed_ratio :: SF a Double From 9bba80b4b16109c4259da5a715f7ada1a7f32b11 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Mon, 16 Jan 2023 14:16:59 -0800 Subject: [PATCH 12/53] yampa-test: Test FRP.Yampa.Simulation.embed. Refs #246. This commit introduces a quickcheck-based unit test for the function Test FRP.Yampa.Simulation.embed. --- yampa-test/tests/Test/FRP/Yampa/Simulation.hs | 50 +++++++++++++++++++ 1 file changed, 50 insertions(+) diff --git a/yampa-test/tests/Test/FRP/Yampa/Simulation.hs b/yampa-test/tests/Test/FRP/Yampa/Simulation.hs index 649186b7..a6af8ffe 100644 --- a/yampa-test/tests/Test/FRP/Yampa/Simulation.hs +++ b/yampa-test/tests/Test/FRP/Yampa/Simulation.hs @@ -13,6 +13,8 @@ import Control.Applicative ((<*>)) import Data.Functor ((<$>)) #endif +import Data.Traversable (mapAccumL) + import Test.QuickCheck import Test.Tasty (TestTree, testGroup) import Test.Tasty.QuickCheck (testProperty) @@ -30,6 +32,7 @@ tests :: TestTree tests = testGroup "Regression tests for FRP.Yampa.Simulation" [ 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) ] @@ -132,6 +135,53 @@ testReact = -- * 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 ()) $ \_ -> From 4424c1ed5fa84ee7defcf75821370a7c02029867 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Mon, 16 Jan 2023 14:01:05 -0800 Subject: [PATCH 13/53] yampa-test: Test FRP.Yampa.Simulation.deltaEncode. Refs #246. This commit introduces a quickcheck-based unit test for the function Test FRP.Yampa.Simulation.deltaEncode. --- yampa-test/tests/Test/FRP/Yampa/Simulation.hs | 49 +++++++++++++++++++ 1 file changed, 49 insertions(+) diff --git a/yampa-test/tests/Test/FRP/Yampa/Simulation.hs b/yampa-test/tests/Test/FRP/Yampa/Simulation.hs index a6af8ffe..7c011f0d 100644 --- a/yampa-test/tests/Test/FRP/Yampa/Simulation.hs +++ b/yampa-test/tests/Test/FRP/Yampa/Simulation.hs @@ -13,6 +13,7 @@ import Control.Applicative ((<*>)) import Data.Functor ((<$>)) #endif +import Data.Maybe (fromMaybe) import Data.Traversable (mapAccumL) import Test.QuickCheck @@ -35,6 +36,7 @@ tests = testGroup "Regression tests for FRP.Yampa.Simulation" , 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 ] -- * Reactimation @@ -213,3 +215,50 @@ embed_t1r = , 22.75, 47.50, 81.25, 101.50, 101.50 , 101.50, 101.50, 101.50, 101.50, 101.50 ] + +testDeltaEncode :: Property +testDeltaEncode = testDeltaEncodeSamples + .&&. testDeltaEncodeTimes + + where + + -- True if the samples produced by deltaEncode are not altered + testDeltaEncodeSamples :: Property + testDeltaEncodeSamples = + forAll randomTime $ \t -> + forAll randomSamples $ \s -> + property $ s == streamSamples (deltaEncode t s) + + where + + -- 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 + + -- 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) + + where + + -- Extract the times from an "optimized" stream. + streamTimes :: (a, [(DTime, Maybe a)]) -> [DTime] + streamTimes = map fst . snd + + -- Generate a random positive time delta + randomTime :: Gen Double + randomTime = getPositive <$> arbitrary + + -- Generate multiple random integer samples + randomSamples :: Gen [Integer] + randomSamples = getNonEmpty <$> arbitrary From 533d2641f531dee308e60eac524e3259dd42f64c Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Mon, 16 Jan 2023 14:34:21 -0800 Subject: [PATCH 14/53] yampa-test: Move local functions to top level. Refs #246. This commit moves functions needed for other tests to the module's top-level scope. --- yampa-test/tests/Test/FRP/Yampa/Simulation.hs | 56 +++++++++---------- 1 file changed, 27 insertions(+), 29 deletions(-) diff --git a/yampa-test/tests/Test/FRP/Yampa/Simulation.hs b/yampa-test/tests/Test/FRP/Yampa/Simulation.hs index 7c011f0d..b95c9d2c 100644 --- a/yampa-test/tests/Test/FRP/Yampa/Simulation.hs +++ b/yampa-test/tests/Test/FRP/Yampa/Simulation.hs @@ -225,40 +225,38 @@ testDeltaEncode = testDeltaEncodeSamples -- 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) - - where - - -- 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 + 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) + forAll randomTime $ \t -> + forAll randomSamples $ \s -> + property $ all (== t) $ streamTimes (deltaEncode t s) - where +-- * Auxiliary - -- Extract the times from an "optimized" stream. - streamTimes :: (a, [(DTime, Maybe a)]) -> [DTime] - streamTimes = map fst . snd +-- | Generate a random positive time delta. +randomTime :: Gen Double +randomTime = getPositive <$> arbitrary - -- Generate a random positive time delta - randomTime :: Gen Double - randomTime = getPositive <$> arbitrary +-- | Generate multiple random integer samples. +randomSamples :: Gen [Integer] +randomSamples = getNonEmpty <$> arbitrary - -- Generate multiple random integer samples - randomSamples :: Gen [Integer] - randomSamples = getNonEmpty <$> 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 From ce77bccbacc0c66b4686871590a7196c1861f584 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Mon, 16 Jan 2023 14:02:01 -0800 Subject: [PATCH 15/53] yampa-test: Test FRP.Yampa.Simulation.deltaEncodeBy. Refs #246. This commit introduces a quickcheck-based unit test for the function Test FRP.Yampa.Simulation.deltaEncodeBy. --- yampa-test/tests/Test/FRP/Yampa/Simulation.hs | 54 +++++++++++++++++++ 1 file changed, 54 insertions(+) diff --git a/yampa-test/tests/Test/FRP/Yampa/Simulation.hs b/yampa-test/tests/Test/FRP/Yampa/Simulation.hs index b95c9d2c..bcc3aa23 100644 --- a/yampa-test/tests/Test/FRP/Yampa/Simulation.hs +++ b/yampa-test/tests/Test/FRP/Yampa/Simulation.hs @@ -37,6 +37,7 @@ tests = testGroup "Regression tests for FRP.Yampa.Simulation" , 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 ] -- * Reactimation @@ -236,6 +237,59 @@ testDeltaEncode = testDeltaEncodeSamples 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 + -- * Auxiliary -- | Generate a random positive time delta. From 407b8600c05b3057c947082fd6cbb51a861ce847 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Mon, 16 Jan 2023 23:49:41 +0000 Subject: [PATCH 16/53] yampa-test: Move local functions to top level. Refs #246. This commit moves functions needed for other tests to the module's top-level scope. --- yampa-test/tests/Test/FRP/Yampa/Simulation.hs | 38 ++++++++++--------- 1 file changed, 21 insertions(+), 17 deletions(-) diff --git a/yampa-test/tests/Test/FRP/Yampa/Simulation.hs b/yampa-test/tests/Test/FRP/Yampa/Simulation.hs index bcc3aa23..42cba3de 100644 --- a/yampa-test/tests/Test/FRP/Yampa/Simulation.hs +++ b/yampa-test/tests/Test/FRP/Yampa/Simulation.hs @@ -98,23 +98,6 @@ testReact = myStream :: Gen (SignalSampleStream Integer) myStream = uniDistStream - randomSF :: Gen (SF Integer Integer) - randomSF = oneof [ return identity - , pointwiseSF - , loopPre <$> arbitrary <*> randomSF2 - ] - - randomSF2 :: Gen (SF (Integer, Integer) (Integer, Integer)) - randomSF2 = oneof [ return identity - , pointwiseSF2 - ] - - pointwiseSF :: Gen (SF Integer Integer) - pointwiseSF = arr <$> arbitrary - - pointwiseSF2 :: Gen (SF (Integer, Integer) (Integer, Integer)) - pointwiseSF2 = arr <$> arbitrary - reactEmbed :: SF a b -> SignalSampleStream a -> IO [b] reactEmbed sf s@(s0, ss) = do outsRef <- newIORef [] @@ -300,6 +283,27 @@ randomTime = getPositive <$> arbitrary 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) From bc8538eee33c82cd61e6d129156f92dad9882be3 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Mon, 16 Jan 2023 14:02:35 -0800 Subject: [PATCH 17/53] yampa-test: Test FRP.Yampa.Simulation.evalAtZero. Refs #246. This commit introduces a quickcheck-based unit test for the function Test FRP.Yampa.Simulation.evalAtZero. --- yampa-test/tests/Test/FRP/Yampa/Simulation.hs | 21 +++++++++++++++++++ 1 file changed, 21 insertions(+) diff --git a/yampa-test/tests/Test/FRP/Yampa/Simulation.hs b/yampa-test/tests/Test/FRP/Yampa/Simulation.hs index 42cba3de..539604ec 100644 --- a/yampa-test/tests/Test/FRP/Yampa/Simulation.hs +++ b/yampa-test/tests/Test/FRP/Yampa/Simulation.hs @@ -38,6 +38,7 @@ tests = testGroup "Regression tests for FRP.Yampa.Simulation" , testProperty "embedSynch (1, fixed)" (property $ embed_t1 ~= embed_t1r) , testProperty "deltaEncode (0, qc)" testDeltaEncode , testProperty "deltaEncodeBy (0, qc)" testDeltaEncodeBy + , testProperty "evalAtZero (0, qc)" testEvalAtZero ] -- * Reactimation @@ -273,6 +274,26 @@ testDeltaEncodeBy = testDeltaEncodeBySamples 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, [])) + -- * Auxiliary -- | Generate a random positive time delta. From 484fb4bcbf5277b2573e312520f480f6cc9a85d9 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Mon, 16 Jan 2023 14:03:07 -0800 Subject: [PATCH 18/53] yampa-test: Test FRP.Yampa.Simulation.evalAt. Refs #246. This commit introduces a quickcheck-based unit test for the function Test FRP.Yampa.Simulation.evalAt. --- yampa-test/tests/Test/FRP/Yampa/Simulation.hs | 41 +++++++++++++++++++ 1 file changed, 41 insertions(+) diff --git a/yampa-test/tests/Test/FRP/Yampa/Simulation.hs b/yampa-test/tests/Test/FRP/Yampa/Simulation.hs index 539604ec..ee80f34f 100644 --- a/yampa-test/tests/Test/FRP/Yampa/Simulation.hs +++ b/yampa-test/tests/Test/FRP/Yampa/Simulation.hs @@ -39,6 +39,7 @@ tests = testGroup "Regression tests for FRP.Yampa.Simulation" , testProperty "deltaEncode (0, qc)" testDeltaEncode , testProperty "deltaEncodeBy (0, qc)" testDeltaEncodeBy , testProperty "evalAtZero (0, qc)" testEvalAtZero + , testProperty "evalAt (0, qc)" testEvalAt ] -- * Reactimation @@ -294,6 +295,46 @@ testEvalAtZero = testEvalAtZero1 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 + -- * Auxiliary -- | Generate a random positive time delta. From 26d61433768134c7ee201344d0f94f10e74941f3 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Mon, 16 Jan 2023 14:03:28 -0800 Subject: [PATCH 19/53] yampa-test: Test FRP.Yampa.Simulation.evalFuture. Refs #246. This commit introduces a quickcheck-based unit test for the function Test FRP.Yampa.Simulation.evalFuture. --- yampa-test/tests/Test/FRP/Yampa/Simulation.hs | 36 +++++++++++++++++++ 1 file changed, 36 insertions(+) diff --git a/yampa-test/tests/Test/FRP/Yampa/Simulation.hs b/yampa-test/tests/Test/FRP/Yampa/Simulation.hs index ee80f34f..2fa0bb45 100644 --- a/yampa-test/tests/Test/FRP/Yampa/Simulation.hs +++ b/yampa-test/tests/Test/FRP/Yampa/Simulation.hs @@ -40,6 +40,7 @@ tests = testGroup "Regression tests for FRP.Yampa.Simulation" , testProperty "deltaEncodeBy (0, qc)" testDeltaEncodeBy , testProperty "evalAtZero (0, qc)" testEvalAtZero , testProperty "evalAt (0, qc)" testEvalAt + , testProperty "evalFuture (0, qc)" testEvalFuture ] -- * Reactimation @@ -335,6 +336,41 @@ testEvalAt = testEvalAt1 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. From 72447e62ea655521c287d0509880f47c841cd612 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Tue, 17 Jan 2023 00:52:00 +0000 Subject: [PATCH 20/53] yampa-test: Document changes in CHANGELOG. Refs #246. --- yampa-test/CHANGELOG | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/yampa-test/CHANGELOG b/yampa-test/CHANGELOG index b2afd77b..db4d4f28 100644 --- a/yampa-test/CHANGELOG +++ b/yampa-test/CHANGELOG @@ -1,7 +1,7 @@ -2022-12-28 Ivan Perez +2023-01-16 Ivan Perez * 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). + (#245), complete unit tests for FRP.Yampa.Simulation (#246). 2022-12-07 Ivan Perez * yampa-test.cabal: Version bump (0.14) (#242), add tests for module From a12e4857b6aeb616fdade6370c2f4c363b5d9d4b Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Sat, 28 Jan 2023 16:48:25 +0000 Subject: [PATCH 21/53] yampa-test: Specify functions tested in property list. Refs #247. Two functions are currently being tested using pre-existing unit tests, delayEvent and delayEventCat, but the labels in the property list do not help understand that these tests are for those properties only. This commit changes the labels of those properties, to better understand the elements being tested by them. --- yampa-test/tests/Test/FRP/Yampa/EventS.hs | 82 +++++++++++------------ 1 file changed, 41 insertions(+), 41 deletions(-) diff --git a/yampa-test/tests/Test/FRP/Yampa/EventS.hs b/yampa-test/tests/Test/FRP/Yampa/EventS.hs index ddc410f0..2734a345 100644 --- a/yampa-test/tests/Test/FRP/Yampa/EventS.hs +++ b/yampa-test/tests/Test/FRP/Yampa/EventS.hs @@ -30,47 +30,47 @@ import TestsCommon tests :: TestTree tests = testGroup "Regression tests for FRP.Yampa.EventS" - [ testProperty "never (0, fixed)" (property $ evsrc_t0 ~= evsrc_t0r) - , testProperty "Events > No event" prop_event_noevent - , testProperty "eventS (1, fixed)" (property $ evsrc_t1 ~= evsrc_t1r) - , testProperty "Events > Now" prop_event_now - , testProperty "eventS (2, fixed)" (property $ evsrc_t2 ~= evsrc_t2r) - , testProperty "Events > After 0.0" prop_event_after_0 - , testProperty "eventS (3, fixed)" (property $ evsrc_t3 ~= evsrc_t3r) - , testProperty "eventS (4, fixed)" (property $ evsrc_t4 ~= evsrc_t4r) - , testProperty "eventS (5, fixed)" (property $ evsrc_t5 ~= evsrc_t5r) - , testProperty "eventS (6, fixed)" (property $ evsrc_t6 ~= evsrc_t6r) - , testProperty "eventS (7, fixed)" (property $ evsrc_t7 ~= evsrc_t7r) - , testProperty "eventS (8, fixed)" (property $ evsrc_t8 ~= evsrc_t8r) - , testProperty "eventS (9, fixed)" (property $ evsrc_t9 ~= evsrc_t9r) - , testProperty "eventS (10, fixed)" (property $ evsrc_t10 ~= evsrc_t10r) - , testProperty "eventS (11, fixed)" (property $ evsrc_t11 ~= evsrc_t11r) - , testProperty "eventS (28, fixed)" (property $ evsrc_t28 ~= evsrc_t28r) - , testProperty "eventS (30, fixed)" (property $ evsrc_t30 ~= evsrc_t30r) - , testProperty "eventS (29, fixed)" (property $ evsrc_t29 ~= evsrc_t29r) - , testProperty "eventS (12, fixed)" (property $ evsrc_t12 ~= evsrc_t12r) - , testProperty "eventS (13, fixed)" (property $ evsrc_t13 ~= evsrc_t13r) - , testProperty "eventS (14, fixed)" (property $ evsrc_t14 ~= evsrc_t14r) - , testProperty "eventS (15, fixed)" (property $ evsrc_t15 ~= evsrc_t15r) - , testProperty "eventS (16, fixed)" (property $ evsrc_t16 ~= evsrc_t16r) - , testProperty "eventS (17, fixed)" (property $ evsrc_t17 ~= evsrc_t17r) - , testProperty "eventS (18, fixed)" (property $ evsrc_t18 ~= evsrc_t18r) - , testProperty "eventS (19, fixed)" (property $ evsrc_t19 ~= evsrc_t19r) - , testProperty "eventS (20, fixed)" (property $ evsrc_t20 ~= evsrc_t20r) - , testProperty "eventS (21, fixed)" (property $ evsrc_t21 ~= evsrc_t21r) - , testProperty "eventS (22, fixed)" (property $ evsrc_t22 ~= evsrc_t22r) - , testProperty "eventS (23, fixed)" (property $ evsrc_t23 ~= evsrc_t23r) - , testProperty "eventS (24, fixed)" (property $ evsrc_t24 ~= evsrc_t24r) - , testProperty "eventS (25, fixed)" (property $ evsrc_t25 ~= evsrc_t25r) - , testProperty "eventS (26, fixed)" (property $ evsrc_t26 ~= evsrc_t26r) - , testProperty "eventS (27, fixed)" (property $ evsrc_t27 ~= evsrc_t27r) - , testProperty "snap (fixed)" (property $ utils_t10 ~= utils_t10r) - , testProperty "snapAfter (fixed)" (property $ utils_t11 ~= utils_t11r) - , testProperty "sample (fixed)" (property $ utils_t12 ~= utils_t12r) - , testProperty "sampleWindow (0, fixed)" (property $ utils_t15 ~= utils_t15r) - , testProperty "sampleWindow (1, fixed)" (property $ utils_t16 ~= utils_t16r) - , testProperty "after (0, fixed)" (property $ utils_t13 ~= utils_t13r) - , testProperty "after (1, fixed)" (property $ utils_t14 ~= utils_t14r) + [ testProperty "never (0, fixed)" (property $ evsrc_t0 ~= evsrc_t0r) + , testProperty "Events > No event" prop_event_noevent + , testProperty "eventS (1, fixed)" (property $ evsrc_t1 ~= evsrc_t1r) + , testProperty "Events > Now" prop_event_now + , testProperty "eventS (2, fixed)" (property $ evsrc_t2 ~= evsrc_t2r) + , testProperty "Events > After 0.0" prop_event_after_0 + , testProperty "eventS (3, fixed)" (property $ evsrc_t3 ~= evsrc_t3r) + , testProperty "eventS (4, fixed)" (property $ evsrc_t4 ~= evsrc_t4r) + , testProperty "eventS (5, fixed)" (property $ evsrc_t5 ~= evsrc_t5r) + , testProperty "eventS (6, fixed)" (property $ evsrc_t6 ~= evsrc_t6r) + , testProperty "eventS (7, fixed)" (property $ evsrc_t7 ~= evsrc_t7r) + , testProperty "eventS (8, fixed)" (property $ evsrc_t8 ~= evsrc_t8r) + , testProperty "eventS (9, fixed)" (property $ evsrc_t9 ~= evsrc_t9r) + , testProperty "eventS (10, fixed)" (property $ evsrc_t10 ~= evsrc_t10r) + , testProperty "eventS (11, fixed)" (property $ evsrc_t11 ~= evsrc_t11r) + , testProperty "eventS (28, fixed)" (property $ evsrc_t28 ~= evsrc_t28r) + , testProperty "delayEvent (0, fixed)" (property $ evsrc_t30 ~= evsrc_t30r) + , testProperty "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 "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) ] -- * Basic event sources From 44d8f16aedc28174638a8f9400692efb32d58736 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Sun, 29 Jan 2023 11:01:06 +0000 Subject: [PATCH 22/53] yampa-test: Test FRP.Yampa.EventS.delayEvent. Refs #247. This commit introduces a quickcheck-based unit test for the function FRP.Yampa.EventS.delayEvent. --- yampa-test/tests/Test/FRP/Yampa/EventS.hs | 44 +++++++++++++++++++++++ 1 file changed, 44 insertions(+) diff --git a/yampa-test/tests/Test/FRP/Yampa/EventS.hs b/yampa-test/tests/Test/FRP/Yampa/EventS.hs index 2734a345..1d6b6a7a 100644 --- a/yampa-test/tests/Test/FRP/Yampa/EventS.hs +++ b/yampa-test/tests/Test/FRP/Yampa/EventS.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE CPP #-} -- | -- Description : Test cases for signal functions working with events -- Copyright : (c) Antony Courtney and Henrik Nilsson, Yale University, 2003-2004 @@ -16,6 +17,10 @@ module Test.FRP.Yampa.EventS ) where +#if __GLASGOW_HASKELL__ < 710 +import Control.Applicative ((<*>)) +import Data.Functor ((<$>)) +#endif import Test.QuickCheck hiding (once, sample) import Test.Tasty (TestTree, testGroup) import Test.Tasty.QuickCheck (testProperty) @@ -47,6 +52,7 @@ tests = testGroup "Regression tests for FRP.Yampa.EventS" , 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) @@ -295,6 +301,44 @@ evsrc_t11r = , NoEvent ] +propDelayEvent :: Property +propDelayEvent = + forAll delayFactorG $ \delayFactor -> + forAll myStream $ evalT $ + Always $ SP $ (==) <$> originalSF delayFactor + <*> sfModelDelayEvent delayFactor + where + -- SF under test + originalSF :: Int -> SF () (Event ()) + originalSF factor = + time + >>> arr cos + >>> arr (< 0) + >>> edge + >>> delayEvent (fromIntegral factor * delay) + + -- Model SF that applies the delay internally + sfModelDelayEvent :: Int -> SF () (Event ()) + sfModelDelayEvent factor = + time + >>> arr (\x -> x - (fromIntegral factor * delay)) + >>> arr cos + >>> arr (< 0) + >>> edge + + -- Generator: Factor by which the signal is delayed + delayFactorG :: Gen Int + delayFactorG = getPositive <$> arbitrary + + -- Generator: Random input stream. Delays and values are fixed but the + -- length is not. + myStream :: Gen (SignalSampleStream ()) + myStream = fixedDelayStream delay + + -- Constant: Max delay + delay :: DTime + delay = 0.01 + evsrc_t28 :: [(Event Int, Event Int)] evsrc_t28 = embed (repeatedly 0.5 () >>> accumBy (\n _ -> n + 1) 0 From da4cac7b12d71a3376ece0ebad686221ba290988 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Sun, 29 Jan 2023 11:01:34 +0000 Subject: [PATCH 23/53] yampa-test: Test FRP.Yampa.EventS.iEdge. Refs #247. This commit introduces a quickcheck-based unit test for the function FRP.Yampa.EventS.iEdge. --- yampa-test/tests/Test/FRP/Yampa/EventS.hs | 34 ++++++++++++++++++++++- 1 file changed, 33 insertions(+), 1 deletion(-) diff --git a/yampa-test/tests/Test/FRP/Yampa/EventS.hs b/yampa-test/tests/Test/FRP/Yampa/EventS.hs index 1d6b6a7a..1530fdd1 100644 --- a/yampa-test/tests/Test/FRP/Yampa/EventS.hs +++ b/yampa-test/tests/Test/FRP/Yampa/EventS.hs @@ -1,4 +1,5 @@ -{-# LANGUAGE CPP #-} +{-# LANGUAGE Arrows #-} +{-# LANGUAGE CPP #-} -- | -- Description : Test cases for signal functions working with events -- Copyright : (c) Antony Courtney and Henrik Nilsson, Yale University, 2003-2004 @@ -56,6 +57,7 @@ tests = testGroup "Regression tests for FRP.Yampa.EventS" , 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 "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) @@ -478,6 +480,36 @@ evsrc_t13r = , NoEvent ] +propIEdge :: Property +propIEdge = + forAll initialValG $ \initialVal -> + forAll myStream $ evalT $ + Always $ SP $ (==) <$> originalSF initialVal <*> modelSF initialVal + where + -- SF under test + originalSF :: Bool -> SF Bool (Event ()) + originalSF = iEdge + + -- Model SF that behaves like edge except for the initial sample + modelSF :: Bool -> SF Bool (Event ()) + modelSF k = proc (x) -> do + t <- time -< () + e <- edge -< x + + let result | t == 0 && not k && x = Event () + | t == 0 && k = NoEvent + | otherwise = e + + returnA -< result + + -- Generator: Initialization value for iEdge + initialValG :: Gen Bool + initialValG = arbitrary + + -- Generator: Random input stream. + myStream :: Gen (SignalSampleStream Bool) + myStream = uniDistStream + -- Raising edge detector. evsrc_isEdge False False = Nothing evsrc_isEdge False True = Just () From 5c0dea7f1ac7e2323c4d54e719c90b23343910c5 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Sun, 29 Jan 2023 11:02:00 +0000 Subject: [PATCH 24/53] yampa-test: Test FRP.Yampa.EventS.edgeTag. Refs #247. This commit introduces a quickcheck-based unit test for the function FRP.Yampa.EventS.edgeTag. --- yampa-test/tests/Test/FRP/Yampa/EventS.hs | 23 +++++++++++++++++++++++ 1 file changed, 23 insertions(+) diff --git a/yampa-test/tests/Test/FRP/Yampa/EventS.hs b/yampa-test/tests/Test/FRP/Yampa/EventS.hs index 1530fdd1..d2a7d510 100644 --- a/yampa-test/tests/Test/FRP/Yampa/EventS.hs +++ b/yampa-test/tests/Test/FRP/Yampa/EventS.hs @@ -58,6 +58,7 @@ tests = testGroup "Regression tests for FRP.Yampa.EventS" , 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 "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) @@ -510,6 +511,28 @@ propIEdge = 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 + -- Raising edge detector. evsrc_isEdge False False = Nothing evsrc_isEdge False True = Just () From c1cc25cd793a65fba53d69874ebf7f67713955d4 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Sun, 29 Jan 2023 11:02:21 +0000 Subject: [PATCH 25/53] yampa-test: Test FRP.Yampa.EventS.edgeJust. Refs #247. This commit introduces a quickcheck-based unit test for the function FRP.Yampa.EventS.edgeJust. --- yampa-test/tests/Test/FRP/Yampa/EventS.hs | 21 +++++++++++++++++++++ 1 file changed, 21 insertions(+) diff --git a/yampa-test/tests/Test/FRP/Yampa/EventS.hs b/yampa-test/tests/Test/FRP/Yampa/EventS.hs index d2a7d510..b2cc777e 100644 --- a/yampa-test/tests/Test/FRP/Yampa/EventS.hs +++ b/yampa-test/tests/Test/FRP/Yampa/EventS.hs @@ -59,6 +59,7 @@ tests = testGroup "Regression tests for FRP.Yampa.EventS" , 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) @@ -533,6 +534,26 @@ propEdgeTag = 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 () From da4a8aab11e69c73c5f3642092002934f2e262be Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Sun, 29 Jan 2023 11:02:53 +0000 Subject: [PATCH 26/53] yampa-test: Test FRP.Yampa.EventS.notYet. Refs #247. This commit introduces a quickcheck-based unit test for the function FRP.Yampa.EventS.notYet. --- yampa-test/tests/Test/FRP/Yampa/EventS.hs | 27 +++++++++++++++++++++++ 1 file changed, 27 insertions(+) diff --git a/yampa-test/tests/Test/FRP/Yampa/EventS.hs b/yampa-test/tests/Test/FRP/Yampa/EventS.hs index b2cc777e..7ee56417 100644 --- a/yampa-test/tests/Test/FRP/Yampa/EventS.hs +++ b/yampa-test/tests/Test/FRP/Yampa/EventS.hs @@ -63,6 +63,7 @@ tests = testGroup "Regression tests for FRP.Yampa.EventS" , 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) @@ -609,6 +610,24 @@ evsrc_t16r = -- * Stateful event suppression +propNotYet :: Property +propNotYet = + forAll myStream $ evalT $ + Always $ SP $ (==) <$> originalSF + <*> modelSF + where + -- SF under test + originalSF :: SF (Event Int) (Event Int) + originalSF = notYet + + -- Model SF that sets the initial value of an Event signal to noEvent + modelSF :: SF (Event Int) (Event Int) + modelSF = const noEvent -=> identity + + -- Generator: Random input stream. + myStream :: Gen (SignalSampleStream (Event Int)) + myStream = uniDistStream + evsrc_t17 :: [Event Int] evsrc_t17 = testSF1 (now 17 &&& repeatedly 0.795 42 >>> arr (uncurry merge) @@ -917,3 +936,11 @@ utils_t14r = -- prop :: SF a b -> (a -> b -> prop (a,b) = SP ((identity &&& a) >>^ uncurry b) + +-- * Arbitrary value generation + +instance Arbitrary a => Arbitrary (Event a) where + arbitrary = oneof [ return NoEvent + , do x <- arbitrary + return $ Event x + ] From b24e8bb185c6851861503094f52c804102c91915 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Sun, 29 Jan 2023 11:16:24 +0000 Subject: [PATCH 27/53] yampa-test: Document changes in CHANGELOG. Refs #247. --- yampa-test/CHANGELOG | 5 +++-- 1 file changed, 3 insertions(+), 2 deletions(-) diff --git a/yampa-test/CHANGELOG b/yampa-test/CHANGELOG index db4d4f28..59729243 100644 --- a/yampa-test/CHANGELOG +++ b/yampa-test/CHANGELOG @@ -1,7 +1,8 @@ -2023-01-16 Ivan Perez +2023-01-29 Ivan Perez * 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). + (#245), complete unit tests for FRP.Yampa.Simulation (#246), complete + unit tests for FRP.Yampa.EventS (#247). 2022-12-07 Ivan Perez * yampa-test.cabal: Version bump (0.14) (#242), add tests for module From 0026385f2243ebf03f267b2e89d1898b7ebb3cf1 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Sun, 29 Jan 2023 12:29:43 +0000 Subject: [PATCH 28/53] yampa-test: Add module to test SFs producing random values. Refs #248. This commit adds an empty module to test the module FRP.Yampa.Random. The module is enabled in the testing suite, but, as of this commit, contains no properties. --- yampa-test/tests/Main.hs | 2 ++ yampa-test/tests/Test/FRP/Yampa/Random.hs | 14 ++++++++++++++ yampa-test/yampa-test.cabal | 1 + 3 files changed, 17 insertions(+) create mode 100644 yampa-test/tests/Test/FRP/Yampa/Random.hs diff --git a/yampa-test/tests/Main.hs b/yampa-test/tests/Main.hs index 343f4b36..ccc0257f 100644 --- a/yampa-test/tests/Main.hs +++ b/yampa-test/tests/Main.hs @@ -24,6 +24,7 @@ import qualified Test.FRP.Yampa.Hybrid as Hybrid import qualified Test.FRP.Yampa.Integration as Integration import qualified Test.FRP.Yampa.InternalCore as InternalCore import qualified Test.FRP.Yampa.Loop as Loop +import qualified Test.FRP.Yampa.Random as Random import qualified Test.FRP.Yampa.Scan as Scan import qualified Test.FRP.Yampa.Simulation as Simulation import qualified Test.FRP.Yampa.Switches as Switches @@ -45,6 +46,7 @@ tests = testGroup "Yampa QC properties" , Integration.tests , InternalCore.tests , Loop.tests + , Random.tests , Scan.tests , Simulation.tests , Switches.tests diff --git a/yampa-test/tests/Test/FRP/Yampa/Random.hs b/yampa-test/tests/Test/FRP/Yampa/Random.hs new file mode 100644 index 00000000..fb858b11 --- /dev/null +++ b/yampa-test/tests/Test/FRP/Yampa/Random.hs @@ -0,0 +1,14 @@ +-- | +-- 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 + +import Test.Tasty (TestTree, testGroup) + +tests :: TestTree +tests = testGroup "Regression tests for FRP.Yampa.Random" [] diff --git a/yampa-test/yampa-test.cabal b/yampa-test/yampa-test.cabal index a9fa040f..42c4b089 100644 --- a/yampa-test/yampa-test.cabal +++ b/yampa-test/yampa-test.cabal @@ -111,6 +111,7 @@ test-suite yampa-quicheck Test.FRP.Yampa.Integration Test.FRP.Yampa.InternalCore Test.FRP.Yampa.Loop + Test.FRP.Yampa.Random Test.FRP.Yampa.Scan Test.FRP.Yampa.Simulation Test.FRP.Yampa.Switches From ec0685457af12e628a5c4f3d9037229fd0265040 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Sun, 29 Jan 2023 13:34:52 +0000 Subject: [PATCH 29/53] yampa-test: Test FRP.Yampa.Random.noise. Refs #248. This commit introduces a quickcheck-based unit test for the function FRP.Yampa.Random.noise. --- yampa-test/tests/Test/FRP/Yampa/Random.hs | 105 +++++++++++++++++++++- 1 file changed, 103 insertions(+), 2 deletions(-) diff --git a/yampa-test/tests/Test/FRP/Yampa/Random.hs b/yampa-test/tests/Test/FRP/Yampa/Random.hs index fb858b11..bbe48349 100644 --- a/yampa-test/tests/Test/FRP/Yampa/Random.hs +++ b/yampa-test/tests/Test/FRP/Yampa/Random.hs @@ -1,3 +1,5 @@ +{-# LANGUAGE CPP #-} +{-# LANGUAGE ForeignFunctionInterface #-} -- | -- Description : Test cases for signal functions working with random values. -- Copyright : (c) Ivan Perez, 2023 @@ -8,7 +10,106 @@ module Test.FRP.Yampa.Random ) where -import Test.Tasty (TestTree, testGroup) +#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 (embed, noise, second) +import FRP.Yampa.QuickCheck (Distribution (DistRandom), generateStream) +import FRP.Yampa.Stream (SignalSampleStream) tests :: TestTree -tests = testGroup "Regression tests for FRP.Yampa.Random" [] +tests = testGroup "Regression tests for FRP.Yampa.Random" + [ testProperty "noise (0, qc)" propNoise ] + +-- * 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 + +-- * 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 From 87f8e8cc76f03e5c2717bad30dd75a1d0f6e3585 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Sun, 29 Jan 2023 14:23:47 +0000 Subject: [PATCH 30/53] yampa-test: Test FRP.Yampa.Random.noiseR. Refs #248. This commit introduces a quickcheck-based unit test for the function FRP.Yampa.Random.noiseR. --- yampa-test/tests/Test/FRP/Yampa/Random.hs | 56 ++++++++++++++++++++++- 1 file changed, 54 insertions(+), 2 deletions(-) diff --git a/yampa-test/tests/Test/FRP/Yampa/Random.hs b/yampa-test/tests/Test/FRP/Yampa/Random.hs index bbe48349..52898294 100644 --- a/yampa-test/tests/Test/FRP/Yampa/Random.hs +++ b/yampa-test/tests/Test/FRP/Yampa/Random.hs @@ -26,13 +26,15 @@ import Test.QuickCheck hiding (once, sample) import Test.Tasty (TestTree, testGroup) import Test.Tasty.QuickCheck (testProperty) -import FRP.Yampa (embed, noise, second) +import FRP.Yampa (embed, noise, noiseR, 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 "noise (0, qc)" propNoise + , testProperty "noiseR (0, qc)" propNoiseR + ] -- * Noise (i.e. random signal generators) and stochastic processes @@ -60,6 +62,56 @@ propNoise = 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 + -- * Auxiliary definitions -- | Check whether a list of values exhibits randomness. From 7f2a90671c2446b2c33cc3e67c03705ca645a345 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Sun, 29 Jan 2023 20:18:23 +0000 Subject: [PATCH 31/53] yampa-test: Test FRP.Yampa.Random.occasionally. Refs #248. This commit introduces a quickcheck-based unit test for the function FRP.Yampa.Random.occasionally. --- yampa-test/tests/Test/FRP/Yampa/Random.hs | 69 ++++++++++++++++++++++- 1 file changed, 66 insertions(+), 3 deletions(-) diff --git a/yampa-test/tests/Test/FRP/Yampa/Random.hs b/yampa-test/tests/Test/FRP/Yampa/Random.hs index 52898294..f4ce02cb 100644 --- a/yampa-test/tests/Test/FRP/Yampa/Random.hs +++ b/yampa-test/tests/Test/FRP/Yampa/Random.hs @@ -26,14 +26,16 @@ import Test.QuickCheck hiding (once, sample) import Test.Tasty (TestTree, testGroup) import Test.Tasty.QuickCheck (testProperty) -import FRP.Yampa (embed, noise, noiseR, second) +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 "noise (0, qc)" propNoise + , testProperty "noiseR (0, qc)" propNoiseR + , testProperty "occasionally (0, qc)" propOccasionally ] -- * Noise (i.e. random signal generators) and stochastic processes @@ -112,6 +114,67 @@ propNoiseR = 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. From 1f8694d979d1c7faf565cf51ac53678175a045e0 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Sun, 29 Jan 2023 20:25:44 +0000 Subject: [PATCH 32/53] yampa-test: Document changes in CHANGELOG. Refs #248. --- yampa-test/CHANGELOG | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/yampa-test/CHANGELOG b/yampa-test/CHANGELOG index 59729243..d7a4f512 100644 --- a/yampa-test/CHANGELOG +++ b/yampa-test/CHANGELOG @@ -2,7 +2,8 @@ * 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). + unit tests for FRP.Yampa.EventS (#247), complete unit tests for + FRP.Yampa.Random (#248). 2022-12-07 Ivan Perez * yampa-test.cabal: Version bump (0.14) (#242), add tests for module From 0b10aac992bb0108afcf80f6ee9e275b69726160 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Sun, 5 Feb 2023 22:46:39 +0000 Subject: [PATCH 33/53] yampa-test: Auxiliary SF and Event generation. Refs #250. Introduce random generators necessary in multiple properties to be tested. --- yampa-test/tests/Test/FRP/Yampa/Switches.hs | 33 +++++++++++++++++++++ 1 file changed, 33 insertions(+) diff --git a/yampa-test/tests/Test/FRP/Yampa/Switches.hs b/yampa-test/tests/Test/FRP/Yampa/Switches.hs index f10b6503..30a1ff05 100644 --- a/yampa-test/tests/Test/FRP/Yampa/Switches.hs +++ b/yampa-test/tests/Test/FRP/Yampa/Switches.hs @@ -1,4 +1,5 @@ {-# LANGUAGE Arrows #-} +{-# LANGUAGE CPP #-} -- | -- Description : Test cases for FRP.Yampa.Switches -- Copyright : (c) Ivan Perez, 2014-2022 @@ -12,6 +13,11 @@ module Test.FRP.Yampa.Switches ) where +#if __GLASGOW_HASKELL__ < 710 +import Control.Applicative (pure, (<*>)) +import Data.Functor ((<$>)) +#endif + import Data.Fixed import Data.List (findIndex) import Data.Maybe (fromJust) @@ -1006,3 +1012,30 @@ utils_t6r = -- prop :: SF a b -> (a -> b -> prop (a,b) = SP ((identity &&& a) >>^ uncurry b) + +-- * Auxiliary + +-- | 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)] From 865f86e4f3bbd98b4508fb16fce85807da691faa Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Sun, 5 Feb 2023 19:09:00 +0000 Subject: [PATCH 34/53] yampa-test: Test FRP.Yampa.Switches.par. Refs #250. Introduce a quickcheck-based unit test for the function FRP.Yampa.Switches.par. --- yampa-test/tests/Test/FRP/Yampa/Switches.hs | 37 +++++++++++++++++++++ 1 file changed, 37 insertions(+) diff --git a/yampa-test/tests/Test/FRP/Yampa/Switches.hs b/yampa-test/tests/Test/FRP/Yampa/Switches.hs index 30a1ff05..9ae220c3 100644 --- a/yampa-test/tests/Test/FRP/Yampa/Switches.hs +++ b/yampa-test/tests/Test/FRP/Yampa/Switches.hs @@ -66,6 +66,7 @@ tests = testGroup "Regression tests for FRP.Yampa.Switches" , testProperty "rpswitch (1, fixed)" (property $ rpswitch_t1 ~= rpswitch_t1r) , testProperty "rpswitch (3, fixed)" (property $ rpswitch_t3 ~= rpswitch_t3r) , testProperty "rpswitch (4, fixed)" (property $ rpswitch_t4 ~= rpswitch_t4r) + , testProperty "par (0, qc)" propPar , testProperty "rpSwitchZ (0, fixed)" (property $ utils_t6 ~= utils_t6r) ] @@ -972,6 +973,42 @@ rpswitch_t4r = , [2.8, 0.8, 1.8] ] +-- ** With helper routing function + +propPar :: Property +propPar = + forAllBlind genSFs $ \sfs -> + forAll (genPos (length sfs)) $ \n -> + forAll myStream $ evalT $ + Always $ SP $ (originalSF sfs n &&& modelSF sfs n) >>^ uncurry (==) + + where + + -- SF under test: Apply par and look at one specific value only. + originalSF :: [SF Int Int] -> Int -> SF Int Int + originalSF sfs n = par broad sfs >>^ (!! n) + + -- Model SF: Pick an SF from a given list and apply only that SF to the + -- corresponding input using the routing function. + modelSF :: [SF Int Int] -> Int -> SF Int Int + modelSF sfs n = (fst . (!! n) . (`broad` sfs)) ^>> sfs !! n + + -- Generator: Random non-empty list of SFs. + genSFs :: Gen [SF Int Int] + genSFs = listOf1 randomSF + + -- Generator: Random position in a list of the given length. + genPos :: Int -> Gen Int + genPos n = chooseInt (0, n - 1) + + -- Generator: Random input stream generator. + myStream :: Gen (SignalSampleStream Int) + myStream = uniDistStream + + -- Pair list with element. + broad :: a -> [b] -> [(a, b)] + broad a = map (\x -> (a, x)) + -- * Parallel composition\/switching (lists) -- -- ** With "zip" routing From dc589bbb563009211ed2bbaaca97cd002261639b Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Sun, 5 Feb 2023 23:25:12 +0000 Subject: [PATCH 35/53] yampa-test: Test FRP.Yampa.Switches.pSwitch. Refs #250. Introduce a quickcheck-based unit test for the function FRP.Yampa.Switches.pSwitch. --- yampa-test/tests/Test/FRP/Yampa/Switches.hs | 155 ++++++++++++++++++++ 1 file changed, 155 insertions(+) diff --git a/yampa-test/tests/Test/FRP/Yampa/Switches.hs b/yampa-test/tests/Test/FRP/Yampa/Switches.hs index 9ae220c3..cba16b10 100644 --- a/yampa-test/tests/Test/FRP/Yampa/Switches.hs +++ b/yampa-test/tests/Test/FRP/Yampa/Switches.hs @@ -67,6 +67,7 @@ tests = testGroup "Regression tests for FRP.Yampa.Switches" , 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 "rpSwitchZ (0, fixed)" (property $ utils_t6 ~= utils_t6r) ] @@ -1009,6 +1010,160 @@ propPar = 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)) + -- * Parallel composition\/switching (lists) -- -- ** With "zip" routing From 853fe35b8314a0b0e2dacb3c47e1edf5df288340 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Sun, 5 Feb 2023 23:32:47 +0000 Subject: [PATCH 36/53] yampa-test: Test FRP.Yampa.Switches.dpSwitch. Refs #250. Introduce a quickcheck-based unit test for the function FRP.Yampa.Switches.dpSwitch. --- yampa-test/tests/Test/FRP/Yampa/Switches.hs | 166 ++++++++++++++++++++ 1 file changed, 166 insertions(+) diff --git a/yampa-test/tests/Test/FRP/Yampa/Switches.hs b/yampa-test/tests/Test/FRP/Yampa/Switches.hs index cba16b10..15ae4b76 100644 --- a/yampa-test/tests/Test/FRP/Yampa/Switches.hs +++ b/yampa-test/tests/Test/FRP/Yampa/Switches.hs @@ -68,6 +68,7 @@ tests = testGroup "Regression tests for FRP.Yampa.Switches" , 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 "rpSwitchZ (0, fixed)" (property $ utils_t6 ~= utils_t6r) ] @@ -1164,6 +1165,171 @@ propPSwitch = propPSwitchNoSwitch 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)) + -- * Parallel composition\/switching (lists) -- -- ** With "zip" routing From 81a79d0e70fe82908427b5cbc20a0b7200b75a95 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Mon, 6 Feb 2023 00:15:47 +0000 Subject: [PATCH 37/53] yampa-test: Test FRP.Yampa.Switches.rpSwitch. Refs #250. Introduce a quickcheck-based unit test for the function FRP.Yampa.Switches.rpSwitch. --- yampa-test/tests/Test/FRP/Yampa/Switches.hs | 97 +++++++++++++++++++++ 1 file changed, 97 insertions(+) diff --git a/yampa-test/tests/Test/FRP/Yampa/Switches.hs b/yampa-test/tests/Test/FRP/Yampa/Switches.hs index 15ae4b76..c3af882a 100644 --- a/yampa-test/tests/Test/FRP/Yampa/Switches.hs +++ b/yampa-test/tests/Test/FRP/Yampa/Switches.hs @@ -69,6 +69,7 @@ tests = testGroup "Regression tests for FRP.Yampa.Switches" , testProperty "par (0, qc)" propPar , testProperty "pSwitch (0, qc)" propPSwitch , testProperty "dpSwitch (0, qc)" propDPSwitch + , testProperty "rpSwitch (0, qc)" propRPSwitch , testProperty "rpSwitchZ (0, fixed)" (property $ utils_t6 ~= utils_t6r) ] @@ -1330,6 +1331,102 @@ propDPSwitch = propDPSwitchNoSwitch 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)) + -- * Parallel composition\/switching (lists) -- -- ** With "zip" routing From e3788dd39caefda8da04f49e204b883f5d8b6a61 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Mon, 6 Feb 2023 00:53:25 +0000 Subject: [PATCH 38/53] yampa-test: Test FRP.Yampa.Switches.drpSwitch. Refs #250. Introduce a quickcheck-based unit test for the function FRP.Yampa.Switches.drpSwitch. --- yampa-test/tests/Test/FRP/Yampa/Switches.hs | 107 ++++++++++++++++++++ 1 file changed, 107 insertions(+) diff --git a/yampa-test/tests/Test/FRP/Yampa/Switches.hs b/yampa-test/tests/Test/FRP/Yampa/Switches.hs index c3af882a..2037d9ae 100644 --- a/yampa-test/tests/Test/FRP/Yampa/Switches.hs +++ b/yampa-test/tests/Test/FRP/Yampa/Switches.hs @@ -70,6 +70,7 @@ tests = testGroup "Regression tests for FRP.Yampa.Switches" , testProperty "pSwitch (0, qc)" propPSwitch , testProperty "dpSwitch (0, qc)" propDPSwitch , testProperty "rpSwitch (0, qc)" propRPSwitch + , testProperty "drpSwitch (0, qc)" propDRPSwitch , testProperty "rpSwitchZ (0, fixed)" (property $ utils_t6 ~= utils_t6r) ] @@ -1427,6 +1428,112 @@ propRPSwitch = propRPSwitchNoSwitch 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 From e530199e59488144f385fff3511b09939826c966 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Sun, 5 Feb 2023 22:46:47 +0000 Subject: [PATCH 39/53] yampa-test: Test FRP.Yampa.Switches.parZ. Refs #250. Introduce a quickcheck-based unit test for the function FRP.Yampa.Switches.parZ. --- yampa-test/tests/Test/FRP/Yampa/Switches.hs | 41 ++++++++++++++++++++- 1 file changed, 40 insertions(+), 1 deletion(-) diff --git a/yampa-test/tests/Test/FRP/Yampa/Switches.hs b/yampa-test/tests/Test/FRP/Yampa/Switches.hs index 2037d9ae..ff5c8f01 100644 --- a/yampa-test/tests/Test/FRP/Yampa/Switches.hs +++ b/yampa-test/tests/Test/FRP/Yampa/Switches.hs @@ -27,7 +27,7 @@ import Test.Tasty (TestTree, testGroup) import Test.Tasty.QuickCheck (testProperty) import FRP.Yampa as Yampa -import FRP.Yampa.Switches (rpSwitchZ) +import FRP.Yampa.Switches (parZ, rpSwitchZ) import FRP.Yampa.EventS (snap) import FRP.Yampa.Stream import FRP.Yampa.QuickCheck @@ -71,6 +71,7 @@ tests = testGroup "Regression tests for FRP.Yampa.Switches" , testProperty "dpSwitch (0, qc)" propDPSwitch , testProperty "rpSwitch (0, qc)" propRPSwitch , testProperty "drpSwitch (0, qc)" propDRPSwitch + , testProperty "parZ (0, qc)" propParZ , testProperty "rpSwitchZ (0, fixed)" (property $ utils_t6 ~= utils_t6r) ] @@ -1538,6 +1539,44 @@ propDRPSwitch = propDRPSwitchNoSwitch -- -- ** 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 + dynDelayLine :: a -> SF (a, Event Bool) a dynDelayLine a0 = second (arr (fmap (\p -> if p then addDelay else delDelay))) From c619a97c5698e4f9575f9c66ea53bb4ef1df45b5 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Sun, 5 Feb 2023 15:25:51 +0000 Subject: [PATCH 40/53] yampa-test: Test FRP.Yampa.Switches.pSwitchZ. Refs #250. Introduce a quickcheck-based unit test for the function FRP.Yampa.Switches.pSwitchZ. --- yampa-test/tests/Test/FRP/Yampa/Switches.hs | 166 +++++++++++++++++++- 1 file changed, 165 insertions(+), 1 deletion(-) diff --git a/yampa-test/tests/Test/FRP/Yampa/Switches.hs b/yampa-test/tests/Test/FRP/Yampa/Switches.hs index ff5c8f01..07ca4d0a 100644 --- a/yampa-test/tests/Test/FRP/Yampa/Switches.hs +++ b/yampa-test/tests/Test/FRP/Yampa/Switches.hs @@ -27,7 +27,7 @@ import Test.Tasty (TestTree, testGroup) import Test.Tasty.QuickCheck (testProperty) import FRP.Yampa as Yampa -import FRP.Yampa.Switches (parZ, rpSwitchZ) +import FRP.Yampa.Switches (parZ, pSwitchZ, rpSwitchZ) import FRP.Yampa.EventS (snap) import FRP.Yampa.Stream import FRP.Yampa.QuickCheck @@ -72,6 +72,7 @@ tests = testGroup "Regression tests for FRP.Yampa.Switches" , testProperty "rpSwitch (0, qc)" propRPSwitch , testProperty "drpSwitch (0, qc)" propDRPSwitch , testProperty "parZ (0, qc)" propParZ + , testProperty "pSwitchZ (0, qc)" propPSwitchZ , testProperty "rpSwitchZ (0, fixed)" (property $ utils_t6 ~= utils_t6r) ] @@ -1577,6 +1578,165 @@ propParZ = 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 + dynDelayLine :: a -> SF (a, Event Bool) a dynDelayLine a0 = second (arr (fmap (\p -> if p then addDelay else delDelay))) @@ -1616,6 +1776,10 @@ 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 From 8ee5f6fb909438fe43d0c77ad88e22571b5f9a38 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Sun, 5 Feb 2023 18:18:17 +0000 Subject: [PATCH 41/53] yampa-test: Test FRP.Yampa.Switches.dpSwitchZ. Refs #250. Introduce a quickcheck-based unit test for the function FRP.Yampa.Switches.dpSwitchZ. --- yampa-test/tests/Test/FRP/Yampa/Switches.hs | 174 +++++++++++++++++++- 1 file changed, 173 insertions(+), 1 deletion(-) diff --git a/yampa-test/tests/Test/FRP/Yampa/Switches.hs b/yampa-test/tests/Test/FRP/Yampa/Switches.hs index 07ca4d0a..e1d41705 100644 --- a/yampa-test/tests/Test/FRP/Yampa/Switches.hs +++ b/yampa-test/tests/Test/FRP/Yampa/Switches.hs @@ -27,7 +27,7 @@ import Test.Tasty (TestTree, testGroup) import Test.Tasty.QuickCheck (testProperty) import FRP.Yampa as Yampa -import FRP.Yampa.Switches (parZ, pSwitchZ, rpSwitchZ) +import FRP.Yampa.Switches (dpSwitchZ, parZ, pSwitchZ, rpSwitchZ) import FRP.Yampa.EventS (snap) import FRP.Yampa.Stream import FRP.Yampa.QuickCheck @@ -73,6 +73,7 @@ tests = testGroup "Regression tests for FRP.Yampa.Switches" , 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) ] @@ -1737,6 +1738,177 @@ propPSwitchZ = propPSwitchZNoSwitch 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))) From 15efb008cf3cb495da794ae81b1c3c8d1cb38eba Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Mon, 6 Feb 2023 02:55:52 +0000 Subject: [PATCH 42/53] yampa-test: Test FRP.Yampa.Switches.drpSwitchZ. Refs #250. Introduce a quickcheck-based unit test for the function FRP.Yampa.Switches.drpSwitchZ. --- yampa-test/tests/Test/FRP/Yampa/Switches.hs | 126 +++++++++++++++++++- 1 file changed, 125 insertions(+), 1 deletion(-) diff --git a/yampa-test/tests/Test/FRP/Yampa/Switches.hs b/yampa-test/tests/Test/FRP/Yampa/Switches.hs index e1d41705..ee4131c3 100644 --- a/yampa-test/tests/Test/FRP/Yampa/Switches.hs +++ b/yampa-test/tests/Test/FRP/Yampa/Switches.hs @@ -27,7 +27,7 @@ import Test.Tasty (TestTree, testGroup) import Test.Tasty.QuickCheck (testProperty) import FRP.Yampa as Yampa -import FRP.Yampa.Switches (dpSwitchZ, parZ, pSwitchZ, rpSwitchZ) +import FRP.Yampa.Switches (dpSwitchZ, drpSwitchZ, parZ, pSwitchZ, rpSwitchZ) import FRP.Yampa.EventS (snap) import FRP.Yampa.Stream import FRP.Yampa.QuickCheck @@ -75,6 +75,7 @@ tests = testGroup "Regression tests for FRP.Yampa.Switches" , testProperty "pSwitchZ (0, qc)" propPSwitchZ , testProperty "dpSwitchZ (0, qc)" propDPSwitchZ , testProperty "rpSwitchZ (0, fixed)" (property $ utils_t6 ~= utils_t6r) + , testProperty "drpSwitchZ (0, qc)" propDRPSwitchZ ] -- * Basic switching @@ -1941,6 +1942,129 @@ utils_t6r = , 169,170,171,171,172,174 ] +propDRPSwitchZ :: Property +propDRPSwitchZ = propDRPSwitchZNoSwitch + .&&. propDRPSwitchZSwitch0 + .&&. propDRPSwitchZSwitchNId + + where + + propDRPSwitchZNoSwitch :: Property + propDRPSwitchZNoSwitch = + forAllBlind genSFs $ \sfs -> + forAll (myStream (length sfs)) $ evalT $ + Always $ SP $ (originalSF sfs &&& modelSF sfs) >>^ uncurry (==) + + where + + -- SF under test: drpSwitchZ but never switch. + originalSF :: [SF Int Int] -> SF [Int] [Int] + originalSF sfs = + (identity &&& never) >>> drpSwitchZ sfs + + -- Model SF: With no switching, drpSwitchZ behaves like parZ. + modelSF :: [SF Int Int] -> SF [Int] [Int] + modelSF = parZ + + -- Generator: Random non-empty list of SFs. + genSFs :: Gen [SF Int Int] + genSFs = listOf1 randomSF + + -- Generator: Random input stream generator where the lists generated + -- have the given length. + myStream :: Int -> Gen (SignalSampleStream [Int]) + myStream n = + -- This is uniDistStream with a custom value generator. + generateStreamWith + valueGenerator DistRandom (Nothing, Nothing) Nothing + where + -- Ensure that the values generated (lists) have the expected + -- length. + valueGenerator :: Int -> DTime -> Gen [Int] + valueGenerator _ _ = vectorOf n arbitrary + + propDRPSwitchZSwitch0 :: Property + propDRPSwitchZSwitch0 = + forAllBlind genSFs $ \sfs -> + forAll (myStream (length sfs)) $ evalT $ + And (SP $ + (originalSF sfs &&& modelSF0 sfs) >>^ uncurry (==) + ) + (Next $ Always $ SP $ + (originalSF sfs &&& modelSFN sfs) >>^ uncurry (==) + ) + + where + + -- SF under test: drpSwitchZ that switches immediately. + originalSF :: [SF Int Int] -> SF [Int] [Int] + originalSF sfs = + (identity &&& now reverse) >>> drpSwitchZ sfs + + -- Model SF: With immediate switching, drpSwitchZ behaves like parZ at + -- time 0. + modelSF0 :: [SF Int Int] -> SF [Int] [Int] + modelSF0 = parZ + + -- Model SF: With immediate switching, drpSwitchZ behaves like (parZ . + -- reverse) after time 0. + modelSFN :: [SF Int Int] -> SF [Int] [Int] + modelSFN = parZ . reverse + + -- Generator: Random non-empty list of SFs. + genSFs :: Gen [SF Int Int] + genSFs = listOf1 randomSF + + -- Generator: Random input stream generator where the lists generated + -- have the given length. + myStream :: Int -> Gen (SignalSampleStream [Int]) + myStream n = + -- This is uniDistStream with a custom value generator. + generateStreamWith + valueGenerator DistRandom (Nothing, Nothing) Nothing + where + -- Ensure that the values generated (lists) have the expected + -- length. + valueGenerator :: Int -> DTime -> Gen [Int] + valueGenerator _ _ = vectorOf n arbitrary + + propDRPSwitchZSwitchNId :: Property + propDRPSwitchZSwitchNId = + forAllBlind genSFs $ \sfs -> + forAll (myStream (length sfs)) $ evalT $ + Always $ SP $ + (originalSF sfs &&& modelSF sfs) >>^ uncurry (==) + + where + + -- SF under test: drpSwitchZ that switches at some random time but + -- leaves the list of SFs unchanged. + originalSF :: [SF Int Int] + -> SF ([Int], Event ()) [Int] + originalSF sfs = (identity *** arr (tagWith id)) >>> drpSwitchZ sfs + + -- Model SF: If you switch to the input sfs, it's like never switching. + modelSF :: [SF Int Int] + -> SF ([Int], Event ()) [Int] + modelSF sfs = fst ^>> parZ sfs + + -- Generator: Random non-empty list of SFs. + genSFs :: Gen [SF Int Int] + genSFs = listOf1 randomSF + + -- Generator: Random input stream generator where the lists generated + -- have the given length. + myStream :: Int -> Gen (SignalSampleStream ([Int], Event ())) + myStream n = + -- This is uniDistStream with a custom value generator. + generateStreamWith + valueGenerator DistRandom (Nothing, Nothing) Nothing + where + -- Ensure that the values generated (lists) have the expected + -- length. + valueGenerator :: Int -> DTime -> Gen ([Int], Event ()) + valueGenerator _ _ = (,) <$> vectorOf n arbitrary <*> arbitrary + -- * Auxiliary -- prop :: SF a b -> (a -> b -> From 9cb3f2489858f9555bdab696736963f3c22828fe Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Sun, 5 Feb 2023 19:06:38 +0000 Subject: [PATCH 43/53] yampa-test: Test FRP.Yampa.Switches.parC. Refs #250. Introduce a quickcheck-based unit test for the function FRP.Yampa.Switches.parC. --- yampa-test/tests/Test/FRP/Yampa/Switches.hs | 45 ++++++++++++++++++++- 1 file changed, 44 insertions(+), 1 deletion(-) diff --git a/yampa-test/tests/Test/FRP/Yampa/Switches.hs b/yampa-test/tests/Test/FRP/Yampa/Switches.hs index ee4131c3..1045d01c 100644 --- a/yampa-test/tests/Test/FRP/Yampa/Switches.hs +++ b/yampa-test/tests/Test/FRP/Yampa/Switches.hs @@ -27,7 +27,8 @@ import Test.Tasty (TestTree, testGroup) import Test.Tasty.QuickCheck (testProperty) import FRP.Yampa as Yampa -import FRP.Yampa.Switches (dpSwitchZ, drpSwitchZ, parZ, pSwitchZ, rpSwitchZ) +import FRP.Yampa.Switches (dpSwitchZ, drpSwitchZ, pSwitchZ, parC, parZ, + rpSwitchZ) import FRP.Yampa.EventS (snap) import FRP.Yampa.Stream import FRP.Yampa.QuickCheck @@ -76,6 +77,7 @@ tests = testGroup "Regression tests for FRP.Yampa.Switches" , 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 @@ -2065,6 +2067,47 @@ propDRPSwitchZ = propDRPSwitchZNoSwitch 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 -> From 2782c38811d0356ae8c9cda2429815ccc8370923 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Mon, 6 Feb 2023 01:42:34 +0000 Subject: [PATCH 44/53] yampa-test: Document changes in CHANGELOG. Refs #250. --- yampa-test/CHANGELOG | 5 +++-- 1 file changed, 3 insertions(+), 2 deletions(-) diff --git a/yampa-test/CHANGELOG b/yampa-test/CHANGELOG index d7a4f512..80b2772c 100644 --- a/yampa-test/CHANGELOG +++ b/yampa-test/CHANGELOG @@ -1,9 +1,10 @@ -2023-01-29 Ivan Perez +2023-02-05 Ivan Perez * 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). + FRP.Yampa.Random (#248), complete unit tests for FRP.Yampa.Switches + (#250). 2022-12-07 Ivan Perez * yampa-test.cabal: Version bump (0.14) (#242), add tests for module From ba88a7a6baf9b03954a51b843367be32aa098b4b Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Tue, 7 Feb 2023 06:26:04 +0000 Subject: [PATCH 45/53] yampa: Replace broken links. Refs #253. There are multiple references to the Yampa Arcade paper pointing to Yale's Haskell server in the CS department. That server is down so the links no longer work. This commit replaces all links to the same paper on Antony Courtney's website, which is currently working. We specifically do not point users to the ACM website directly because the paper is not freely accessible there as of the time of this writing. --- yampa/src/FRP/Yampa/Switches.hs | 18 +++++++++--------- 1 file changed, 9 insertions(+), 9 deletions(-) diff --git a/yampa/src/FRP/Yampa/Switches.hs b/yampa/src/FRP/Yampa/Switches.hs index 93e522d3..2dea101e 100644 --- a/yampa/src/FRP/Yampa/Switches.hs +++ b/yampa/src/FRP/Yampa/Switches.hs @@ -363,7 +363,7 @@ broadcast a = fmap (\sf -> (a, sf)) -- of outputs. See 'par'. -- -- For more information on how parallel composition works, check --- +-- parB :: Functor col => col (SF a b) -> SF a (col b) parB = par broadcast @@ -371,7 +371,7 @@ parB = par broadcast -- in parallel) with broadcasting. See 'pSwitch'. -- -- For more information on how parallel composition works, check --- +-- pSwitchB :: Functor col => col (SF a b) -> SF (a,col b) (Event c) -> (col (SF a b)->c-> SF a (col b)) -> SF a (col b) @@ -381,7 +381,7 @@ pSwitchB = pSwitch broadcast -- signal functions spatially composed in parallel). See 'dpSwitch'. -- -- For more information on how parallel composition works, check --- +-- dpSwitchB :: Functor col => col (SF a b) -> SF (a,col b) (Event c) -> (col (SF a b)->c->SF a (col b)) -> SF a (col b) @@ -400,7 +400,7 @@ dpSwitchB = dpSwitch broadcast -- See 'rpSwitch'. -- -- For more information on how parallel composition works, check --- +-- rpSwitchB :: Functor col => col (SF a b) -> SF (a, Event (col (SF a b) -> col (SF a b))) (col b) rpSwitchB = rpSwitch broadcast @@ -418,7 +418,7 @@ rpSwitchB = rpSwitch broadcast -- This is the decoupled version of 'rpSwitchB'. -- -- For more information on how parallel composition works, check --- +-- drpSwitchB :: Functor col => col (SF a b) -> SF (a, Event (col (SF a b) -> col (SF a b))) (col b) drpSwitchB = drpSwitch broadcast @@ -635,7 +635,7 @@ parZ = par (safeZip "parZ") -- in parallel). See 'pSwitch'. -- -- For more information on how parallel composition works, check --- +-- pSwitchZ :: [SF a b] -> SF ([a],[b]) (Event c) -> ([SF a b] -> c -> SF [a] [b]) -> SF [a] [b] pSwitchZ = pSwitch (safeZip "pSwitchZ") @@ -644,7 +644,7 @@ pSwitchZ = pSwitch (safeZip "pSwitchZ") -- signal functions spatially composed in parallel). See 'dpSwitch'. -- -- For more information on how parallel composition works, check --- +-- dpSwitchZ :: [SF a b] -> SF ([a],[b]) (Event c) -> ([SF a b] -> c ->SF [a] [b]) -> SF [a] [b] dpSwitchZ = dpSwitch (safeZip "dpSwitchZ") @@ -661,7 +661,7 @@ dpSwitchZ = dpSwitch (safeZip "dpSwitchZ") -- See 'rpSwitch'. -- -- For more information on how parallel composition works, check --- +-- rpSwitchZ :: [SF a b] -> SF ([a], Event ([SF a b] -> [SF a b])) [b] rpSwitchZ = rpSwitch (safeZip "rpSwitchZ") @@ -677,7 +677,7 @@ rpSwitchZ = rpSwitch (safeZip "rpSwitchZ") -- See 'rpSwitchZ' and 'drpSwitch'. -- -- For more information on how parallel composition works, check --- +-- drpSwitchZ :: [SF a b] -> SF ([a], Event ([SF a b] -> [SF a b])) [b] drpSwitchZ = drpSwitch (safeZip "drpSwitchZ") From 6faab5ee3dd204ac59a8b6f4a395c2aeacc83be4 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Tue, 7 Feb 2023 06:27:57 +0000 Subject: [PATCH 46/53] yampa: Document changes in CHANGELOG. Refs #253. --- yampa/CHANGELOG | 3 +++ 1 file changed, 3 insertions(+) diff --git a/yampa/CHANGELOG b/yampa/CHANGELOG index 1239dd1e..1aa75428 100644 --- a/yampa/CHANGELOG +++ b/yampa/CHANGELOG @@ -1,3 +1,6 @@ +2023-02-06 Ivan Perez + * src/: Replace broken links (#253). + 2022-12-07 Ivan Perez * Yampa.cabal: Version bump (0.14) (#242), bump version bounds of dependency (#241). From 8e43cdd312c754d92a01af9fc36efddb6f956872 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Tue, 7 Feb 2023 06:39:28 +0000 Subject: [PATCH 47/53] yampa: Fix typo. Refs #252. Fix typo in FRP.Yampa.Switches ('fromed' => 'formed'). --- yampa/src/FRP/Yampa/Switches.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/yampa/src/FRP/Yampa/Switches.hs b/yampa/src/FRP/Yampa/Switches.hs index 2dea101e..64383a7b 100644 --- a/yampa/src/FRP/Yampa/Switches.hs +++ b/yampa/src/FRP/Yampa/Switches.hs @@ -13,7 +13,7 @@ -- -- Switches allow you to change the signal function being applied. -- --- The basic idea of switching is fromed by combining a subordinate signal +-- The basic idea of switching is formed by combining a subordinate signal -- function and a signal function continuation parameterised over some initial -- data. -- From b5698a7521c4dd5d23b7d23dae9100fb4352e8d8 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Tue, 7 Feb 2023 06:43:49 +0000 Subject: [PATCH 48/53] yampa: Document changes in CHANGELOG. Refs #252. --- yampa/CHANGELOG | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/yampa/CHANGELOG b/yampa/CHANGELOG index 1aa75428..85bd4380 100644 --- a/yampa/CHANGELOG +++ b/yampa/CHANGELOG @@ -1,5 +1,5 @@ 2023-02-06 Ivan Perez - * src/: Replace broken links (#253). + * src/: Replace broken links (#253), fix typo (#252). 2022-12-07 Ivan Perez * Yampa.cabal: Version bump (0.14) (#242), bump version bounds of From 0b04f6bb39b1aa4aa9b1436288b4e4b5c1093e37 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Tue, 7 Feb 2023 06:48:28 +0000 Subject: [PATCH 49/53] yampa: Disable flag before release. Refs #251. The internal-core flag exposes Yampa's internals. This kind of facility is discouraged by hackage. This commit removes that flag altogether before the upload to hackage. --- yampa/Yampa.cabal | 26 +------------------------- 1 file changed, 1 insertion(+), 25 deletions(-) diff --git a/yampa/Yampa.cabal b/yampa/Yampa.cabal index 470cb8ac..11a3348d 100644 --- a/yampa/Yampa.cabal +++ b/yampa/Yampa.cabal @@ -72,24 +72,6 @@ flag examples default: False manual: True --- WARNING: The following flag exposes Yampa's core. You should avoid using --- this at all. The only reason to expose it is that we are using Yampa for --- research, and many extensions require that we expose the constructors. No --- released project should depend on this. In general, you should always --- install Yampa with this flag disabled. -flag expose-core - description: - You can enable exposing some of Yampa's core constructs using - -fexpose-core. - . - Enabling this is an unsupported configuration, but it may be useful if you - are building an extension of Yampa for research and do not wish to fork - Yampa completely. - . - No released project should ever depend on this. - default: False - manual: True - library exposed-modules: @@ -113,6 +95,7 @@ library other-modules: -- Auxiliary (commonly used) types FRP.Yampa.Diagnostics + FRP.Yampa.InternalCore build-depends: base < 6 @@ -134,13 +117,6 @@ library build-depends: fail == 4.9.* - if flag(expose-core) - exposed-modules: - FRP.Yampa.InternalCore - else - other-modules: - FRP.Yampa.InternalCore - test-suite hlint type: From d538eb33bc0294215a451687122977d308252645 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Tue, 7 Feb 2023 08:02:50 +0000 Subject: [PATCH 50/53] yampa: Version bump (0.14.1). Refs #251. --- yampa/Yampa.cabal | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/yampa/Yampa.cabal b/yampa/Yampa.cabal index 11a3348d..fa13034b 100644 --- a/yampa/Yampa.cabal +++ b/yampa/Yampa.cabal @@ -30,7 +30,7 @@ cabal-version: >= 1.10 build-type: Simple name: Yampa -version: 0.14 +version: 0.14.1 author: Henrik Nilsson, Antony Courtney maintainer: Ivan Perez (ivan.perez@keera.co.uk) homepage: https://github.com/ivanperez-keera/Yampa/ From 5f52cbb7ecf751af96f13db5023ff67eeb35ddf0 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Tue, 7 Feb 2023 08:03:24 +0000 Subject: [PATCH 51/53] yampa-test: Version bump (0.14.1). Refs #251. Bump version and adjust dependencies. --- yampa-test/yampa-test.cabal | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/yampa-test/yampa-test.cabal b/yampa-test/yampa-test.cabal index 42c4b089..56a1093b 100644 --- a/yampa-test/yampa-test.cabal +++ b/yampa-test/yampa-test.cabal @@ -31,7 +31,7 @@ cabal-version: >= 1.10 build-type: Simple name: yampa-test -version: 0.14 +version: 0.14.1 author: Ivan Perez maintainer: ivan.perez@keera.co.uk homepage: http://github.com/ivanperez-keera/Yampa @@ -81,10 +81,10 @@ library FRP.Yampa.Stream build-depends: - base >= 4 && < 5 + base >= 4 && < 5 , normaldistribution , QuickCheck - , Yampa >= 0.14 && < 0.15 + , Yampa >= 0.14.1 && < 0.15 default-language: Haskell2010 From 5a7da437b006f18220de5b6425ad7487f619c137 Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Tue, 7 Feb 2023 08:02:04 +0000 Subject: [PATCH 52/53] yampa: Document changes in CHANGELOG. Refs #251. --- yampa/CHANGELOG | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/yampa/CHANGELOG b/yampa/CHANGELOG index 85bd4380..429eaf62 100644 --- a/yampa/CHANGELOG +++ b/yampa/CHANGELOG @@ -1,4 +1,5 @@ -2023-02-06 Ivan Perez +2023-02-07 Ivan Perez + * Yampa.cabal: Version bump (0.14.1) (#251). * src/: Replace broken links (#253), fix typo (#252). 2022-12-07 Ivan Perez From 4a0c56edbed41ade42937117d6b1cf4b68ed216c Mon Sep 17 00:00:00 2001 From: Ivan Perez Date: Tue, 7 Feb 2023 08:02:12 +0000 Subject: [PATCH 53/53] yampa-test: Document changes in CHANGELOG. Refs #251. --- yampa-test/CHANGELOG | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/yampa-test/CHANGELOG b/yampa-test/CHANGELOG index 80b2772c..196426d7 100644 --- a/yampa-test/CHANGELOG +++ b/yampa-test/CHANGELOG @@ -1,4 +1,5 @@ -2023-02-05 Ivan Perez +2023-02-07 Ivan Perez + * Yampa.cabal: Version bump (0.14.1) (#251). * tests/: add tests for module FRP.Yampa.Hybrid (#243), add tests for module FRP.Yampa.Arrow (#244), complete unit tests for FRP.Yampa.Test (#245), complete unit tests for FRP.Yampa.Simulation (#246), complete