yampa-test 0.13.3 → 0.13.4
raw patch · 32 files changed
+5221/−43 lines, 32 filesdep ~Yampadep ~basePVP ok
version bump matches the API change (PVP)
Dependency ranges changed: Yampa, base
API changes (from Hackage documentation)
Files
- CHANGELOG +6/−0
- tests/Tests.hs +191/−0
- tests/TestsAccum.hs +361/−0
- tests/TestsArr.hs +53/−0
- tests/TestsBasicSF.hs +70/−0
- tests/TestsCOC.hs +57/−0
- tests/TestsCommon.hs +170/−0
- tests/TestsComp.hs +72/−0
- tests/TestsDelay.hs +89/−0
- tests/TestsDer.hs +56/−0
- tests/TestsEmbed.hs +62/−0
- tests/TestsEvSrc.hs +584/−0
- tests/TestsFirstSecond.hs +128/−0
- tests/TestsKSwitch.hs +129/−0
- tests/TestsLaws.hs +90/−0
- tests/TestsLoop.hs +207/−0
- tests/TestsLoopIntegral.hs +105/−0
- tests/TestsLoopLaws.hs +110/−0
- tests/TestsLoopPre.hs +63/−0
- tests/TestsPSwitch.hs +325/−0
- tests/TestsPre.hs +209/−0
- tests/TestsRPSwitch.hs +246/−0
- tests/TestsRSwitch.hs +144/−0
- tests/TestsReact.hs +71/−0
- tests/TestsSscan.hs +473/−0
- tests/TestsSwitch.hs +214/−0
- tests/TestsTask.hs +232/−0
- tests/TestsUtils.hs +372/−0
- tests/TestsWFG.hs +103/−0
- tests/YampaQC.hs +1/−6
- tests/testYampaMain.hs +78/−0
- yampa-test.cabal +150/−37
CHANGELOG view
@@ -1,3 +1,9 @@+2022-04-07 Ivan Perez <ivan.perez@haskell.sexy>+ * yampa-test.cabal: Version bump (0.13.4) (#203), syntax rules (#196),+ add regression tests (#201).+ * tests/YampaQC.hs: Remove incorrect tests (#198).+ * tests/: Add regression tests (#201).+ 2021-10-07 Ivan Perez <ivan.perez@keera.co.uk> * yampa-test.cabal: Version bump (0.13.3).
+ tests/Tests.hs view
@@ -0,0 +1,191 @@+{-# OPTIONS_GHC -fno-warn-tabs #-}+{- $Id: Tests.hs,v 1.27 2003/11/10 21:28:58 antony Exp $+******************************************************************************+* Y A M P A *+* *+* Module: Tests *+* Purpose: regression tests. *+* Authors: Antony Courtney and Henrik Nilsson *+* *+* Copyright (c) Yale University, 2003 *+* *+******************************************************************************+-}++-- TODO:+-- * Add test cases for Yampa. There should be at least one test case for each+-- "non-trivial" entity exported from Yampa.+--+-- * Make tests cases for after and repeatedly more robust. Must not+-- fail due to small discrepancies in floating point implementation.+--+-- 01-May-2002: evsrc_t7 currently fails in hugs.+--+-- * Restructure test cases for papallel composition and switches to reflect+-- Yampa structure better. Separate test cases for the generic definitions?+-- There are some test cases for Utils. Not intended to be exhaustive.+--+-- VectorSpace has caused some ambiguity problems. See e.g. looplaws_t2,+-- switch_t1a.+--+-- 2005-11-26: A simple way of making many test cases more robust would+-- be to have a version of deltaEncode that adds a little extra time+-- to the very first delta time. That way sampling would always be slightly+-- "late".+--+-- But since we often compare time stamps, we'd also either have+-- to adjust the "~=" relation to tolerate "jitter" of that magnitute,+-- or we'd have to formulate many tests more carefully to allow a+-- certain "fuzziness".++module Tests where++import FRP.Yampa++import TestsCommon+import TestsArr+import TestsComp+import TestsFirstSecond+import TestsLaws+import TestsLoop+import TestsLoopLaws+import TestsBasicSF+import TestsSscan+import TestsEvSrc+import TestsCOC+import TestsSwitch+import TestsKSwitch+import TestsRSwitch+import TestsPSwitch+import TestsRPSwitch+import TestsWFG+import TestsAccum+import TestsPre+import TestsDelay+import TestsDer+import TestsLoopPre+import TestsLoopIntegral+import TestsReact+import TestsEmbed+import TestsUtils+import TestsTask+++------------------------------------------------------------------------------+-- Global test and error reporting+------------------------------------------------------------------------------++allGood = arr_tr+ && comp_tr+ && first_tr+ && second_tr+ && laws_tr+ && loop_tr+ && looplaws_tr+ && basicsf_tr+ && sscan_tr+ && evsrc_tr+ && coc_tr+ && switch_tr+ && kswitch_tr+ && rswitch_tr+ && pswitch_tr+ && rpswitch_tr+ && wfg_tr+ && accum_tr+ && pre_tr+ && delay_tr+ && der_tr+ && loopPre_tr+ && loopIntegral_tr+ && react_tr+ && embed_tr+ && utils_tr+ && task_tr+++all_trs =+ [ ("arr", arr_trs),+ ("comp", comp_trs),+ ("first", first_trs),+ ("second", second_trs),+ ("laws", laws_trs),+ ("loop", loop_trs),+ ("looplaws", looplaws_trs),+ ("basicsf", basicsf_trs),+ ("sscan", sscan_trs),+ ("evsrc", evsrc_trs),+ ("coc", coc_trs),+ ("switch", switch_trs),+ ("kswitch", kswitch_trs),+ ("rswitch", rswitch_trs),+ ("pswitch", pswitch_trs),+ ("rpswitch", rpswitch_trs),+ ("wfg", wfg_trs),+ ("accum", accum_trs),+ ("pre", pre_trs),+ ("delay", delay_trs),+ ("der", der_trs),+ ("loopPre", loopPre_trs),+ ("loopIntegral", loopIntegral_trs),+ ("react", react_trs),+ ("embed", embed_trs),+ ("utils", utils_trs),+ ("task", task_trs)+ ]+++failedTests =+ [ format n i | (n, trs) <- all_trs, (i, tr) <- zip [0..] trs, not tr ]+ where+ format n i = "Test " ++ n ++ "_t" ++ show i ++ " failed."+++runRegTests :: IO Bool+runRegTests = do+ putStrLn ""+ putStrLn "Running the Yampa regression tests ..."+ if allGood+ then putStrLn "All tests succeeded!"+ else mapM_ putStrLn failedTests+ return allGood++runSpaceTests :: IO ()+runSpaceTests = do+ putStrLn ""+ putStrLn "Running the Yampa space tests ..."+ putStrLn "Testing the space behaviour. This may take a LONG time."+ putStrLn "Observe the process size using some tool like top."+ putStrLn "The process should not grow significantly."+ putStrLn "Emitted success/failure indications signify termination"+ putStrLn "and whether or not the right result was obtained. They do"+ putStrLn "not necessarily indicate that the space behaviour is correct"+ putStrLn "(i.e., absence of leaks)."+ putStrLn ""+ rst "arr" 0 arr_st0 arr_st0r+ rst "arr" 1 arr_st1 arr_st1r+ rst "loop" 0 loop_st0 loop_st0r+ rst "loop" 1 loop_st1 loop_st1r+ rst "rswitch" 0 rswitch_st0 rswitch_st0r+ rst "pswitch" 0 pswitch_st0 pswitch_st0r+ rst "pswitch" 1 pswitch_st1 pswitch_st1r+ rst "rpswitch" 0 rpswitch_st0 rpswitch_st0r+ rst "accum" 0 accum_st0 accum_st0r+ rst "accum" 1 accum_st1 accum_st1r+ where+ rst n i st str = do+ putStrLn ("Running " ++ n ++ "_st" ++ show i ++ " ...")+ if st ~= str then+ putStrLn "Success!"+ else+ -- We probably won't get here in case of a (space) failure ...+ putStrLn "Failure!"++-- AC: here because I had trouble running ghci:+-- fixTest :: IO ()+-- fixTest =+-- let vs = loop_t17+-- in putStrLn ("loop_t17 output: " ++ show vs)+++
+ tests/TestsAccum.hs view
@@ -0,0 +1,361 @@+{-# OPTIONS_GHC -fno-warn-tabs #-}+{- $Id: TestsAccum.hs,v 1.2 2003/11/10 21:28:58 antony Exp $+******************************************************************************+* Y A M P A *+* *+* Module: TestsAccum *+* Purpose: Test cases for accumulators *+* Authors: Antony Courtney and Henrik Nilsson *+* *+* Copyright (c) Yale University, 2003 *+* University of Nottingham, 2005 *+* *+******************************************************************************+-}++module TestsAccum (+ accum_tr,+ accum_trs,+ accum_st0,+ accum_st0r,+ accum_st1,+ accum_st1r+) where++import Data.Maybe (fromJust)++import FRP.Yampa++import TestsCommon++------------------------------------------------------------------------------+-- Test cases for accumulators+------------------------------------------------------------------------------++accum_inp1 = (fromJust (head delta_inp), zip (repeat 1.0) (tail delta_inp))+ where+ delta_inp =+ [Just NoEvent, Nothing, Just (Event (+1.0)), Just NoEvent,+ Just (Event (+2.0)), Just NoEvent, Nothing, Nothing,+ Just (Event (*3.0)), Just (Event (+5.0)), Nothing, Just NoEvent,+ Just (Event (/2.0)), Just NoEvent, Nothing, Nothing]+ ++ repeat Nothing++accum_inp2 = (fromJust (head delta_inp), zip (repeat 1.0) (tail delta_inp))+ where+ delta_inp =+ [Just (Event (+1.0)), Just NoEvent, Nothing, Nothing,+ Just (Event (+2.0)), Just NoEvent, Nothing, Nothing,+ Just (Event (*3.0)), Just (Event (+5.0)), Nothing, Just NoEvent,+ Just (Event (/2.0)), Just NoEvent, Nothing, Nothing]+ ++ repeat Nothing++accum_inp3 = deltaEncode 1.0 $+ [NoEvent, NoEvent, Event 1.0, NoEvent,+ Event 2.0, NoEvent, NoEvent, NoEvent,+ Event 3.0, Event 5.0, Event 5.0, NoEvent,+ Event 0.0, NoEvent, NoEvent, NoEvent]+ ++ repeat NoEvent++accum_inp4 = deltaEncode 1.0 $+ [Event 1.0, NoEvent, NoEvent, NoEvent,+ Event 2.0, NoEvent, NoEvent, NoEvent,+ Event 3.0, Event 5.0, Event 5.0, NoEvent,+ Event 0.0, NoEvent, NoEvent, NoEvent]+ ++ repeat NoEvent+++accum_inp5 = deltaEncode 0.25 (repeat ())+++accum_t0 :: [Event Double]+accum_t0 = take 16 $ embed (accum 0.0) accum_inp1++accum_t0r =+ [NoEvent, NoEvent, Event 1.0, NoEvent,+ Event 3.0, NoEvent, NoEvent, NoEvent,+ Event 9.0, Event 14.0, Event 19.0, NoEvent,+ Event 9.5, NoEvent, NoEvent, NoEvent]+++accum_t1 :: [Event Double]+accum_t1 = take 16 $ embed (accum 0.0) accum_inp2++accum_t1r =+ [Event 1.0, NoEvent, NoEvent, NoEvent,+ Event 3.0, NoEvent, NoEvent, NoEvent,+ Event 9.0, Event 14.0, Event 19.0, NoEvent,+ Event 9.5, NoEvent, NoEvent, NoEvent]+++accum_t2 :: [Event Int]+accum_t2 = take 16 $ embed (accumBy (\a d -> a + floor d) 0) accum_inp3++accum_t2r :: [Event Int]+accum_t2r =+ [NoEvent, NoEvent, Event 1, NoEvent,+ Event 3, NoEvent, NoEvent, NoEvent,+ Event 6, Event 11, Event 16, NoEvent,+ Event 16, NoEvent, NoEvent, NoEvent]+++accum_t3 :: [Event Int]+accum_t3 = take 16 $ embed (accumBy (\a d -> a + floor d) 0) accum_inp4++accum_t3r :: [Event Int]+accum_t3r =+ [Event 1, NoEvent, NoEvent, NoEvent,+ Event 3, NoEvent, NoEvent, NoEvent,+ Event 6, Event 11, Event 16, NoEvent,+ Event 16, NoEvent, NoEvent, NoEvent]+++accum_accFiltFun1 a d =+ let a' = a + floor d+ in+ if even a' then+ (a', Just (a' > 10, a'))+ else+ (a', Nothing)++accum_t4 :: [Event (Bool,Int)]+accum_t4 = take 16 $ embed (accumFilter accum_accFiltFun1 0) accum_inp3++accum_t4r :: [Event (Bool,Int)]+accum_t4r =+ [NoEvent, NoEvent, NoEvent, NoEvent,+ NoEvent, NoEvent, NoEvent, NoEvent,+ Event (False,6), NoEvent, Event (True,16), NoEvent,+ Event (True,16), NoEvent, NoEvent, NoEvent]+++accum_accFiltFun2 a d =+ let a' = a + floor d+ in+ if odd a' then+ (a', Just (a' > 10, a'))+ else+ (a', Nothing)++accum_t5 :: [Event (Bool,Int)]+accum_t5 = take 16 $ embed (accumFilter accum_accFiltFun2 0) accum_inp4++accum_t5r :: [Event (Bool,Int)]+accum_t5r =+ [Event (False,1), NoEvent, NoEvent, NoEvent,+ Event (False,3), NoEvent, NoEvent, NoEvent,+ NoEvent, Event (True,11), NoEvent, NoEvent,+ NoEvent, NoEvent, NoEvent, NoEvent]+++-- This can be seen as the definition of accumFilter+accumFilter2 :: (c -> a -> (c, Maybe b)) -> c -> SF (Event a) (Event b)+accumFilter2 f c_init =+ switch (never &&& attach c_init) afAux+ where+ afAux (c, a) =+ case f c a of+ (c', Nothing) -> switch (never &&& (notYet>>>attach c')) afAux+ (c', Just b) -> switch (now b &&& (notYet>>>attach c')) afAux++ attach :: b -> SF (Event a) (Event (b, a))+ attach c = arr (fmap (\a -> (c, a)))++accum_t6 :: [Event (Bool,Int)]+accum_t6 = take 16 $ embed (accumFilter2 accum_accFiltFun1 0) accum_inp3++accum_t6r = accum_t4 -- Should agree!++accum_t7 :: [Event (Bool,Int)]+accum_t7 = take 16 $ embed (accumFilter2 accum_accFiltFun2 0) accum_inp4++accum_t7r = accum_t5 -- Should agree!+++accum_t8 :: [Event Int]+accum_t8 = take 40 $ embed (repeatedly 1.0 1+ >>> accumBy (+) 0+ >>> accumBy (+) 0)+ accum_inp5++accum_t8r :: [Event Int]+accum_t8r = [NoEvent, NoEvent, NoEvent, NoEvent,+ Event 1, NoEvent, NoEvent, NoEvent,+ Event 3, NoEvent, NoEvent, NoEvent,+ Event 6, NoEvent, NoEvent, NoEvent,+ Event 10, NoEvent, NoEvent, NoEvent,+ Event 15, NoEvent, NoEvent, NoEvent,+ Event 21, NoEvent, NoEvent, NoEvent,+ Event 28, NoEvent, NoEvent, NoEvent,+ Event 36, NoEvent, NoEvent, NoEvent,+ Event 45, NoEvent, NoEvent, NoEvent]+++accum_t9 :: [Int]+accum_t9 = take 40 $ embed (repeatedly 1.0 1+ >>> accumBy (+) 0+ >>> accumBy (+) 0+ >>> hold 0)+ accum_inp5++accum_t9r :: [Int]+accum_t9r = [0,0,0,0,1,1,1,1,3,3,3,3,6,6,6,6,10,10,10,10,15,15,15,15,+ 21,21,21,21,28,28,28,28,36,36,36,36,45,45,45,45]+++accum_t10 :: [Int]+accum_t10 = take 40 $ embed (repeatedly 1.0 1+ >>> accumBy (+) 0+ >>> accumHoldBy (+) 0)+ accum_inp5++accum_t10r :: [Int]+accum_t10r = accum_t9 -- Should agree!+++accum_t11 :: [Int]+accum_t11 = take 40 $ embed (repeatedly 1.0 1+ >>> accumBy (+) 0+ >>> accumBy (+) 0+ >>> dHold 0)+ accum_inp5++accum_t11r :: [Int]+accum_t11r = [0,0,0,0,0,1,1,1,1,3,3,3,3,6,6,6,6,10,10,10,10,15,15,15,+ 15,21,21,21,21,28,28,28,28,36,36,36,36,45,45,45]+++accum_t12 :: [Int]+accum_t12 = take 40 $ embed (repeatedly 1.0 1+ >>> accumBy (+) 0+ >>> dAccumHoldBy (+) 0)+ accum_inp5++accum_t12r :: [Int]+accum_t12r = accum_t11 -- Should agree!+++accum_accFiltFun3 :: Int -> Int -> (Int, Maybe Int)+accum_accFiltFun3 s a =+ let s' = s + a+ in+ if odd s' then+ (s', Just s')+ else+ (s', Nothing)+++accum_t13 :: [Event Int]+accum_t13 = take 40 $ embed (repeatedly 1.0 1+ >>> accumFilter accum_accFiltFun3 0+ >>> accumBy (+) 0+ >>> accumBy (+) 0)+ accum_inp5++accum_t13r :: [Event Int]+accum_t13r = [NoEvent, NoEvent, NoEvent, NoEvent,+ Event 1, NoEvent, NoEvent, NoEvent,+ NoEvent, NoEvent, NoEvent, NoEvent,+ Event 5, NoEvent, NoEvent, NoEvent,+ NoEvent, NoEvent, NoEvent, NoEvent,+ Event 14, NoEvent, NoEvent, NoEvent,+ NoEvent, NoEvent, NoEvent, NoEvent,+ Event 30, NoEvent, NoEvent, NoEvent,+ NoEvent, NoEvent, NoEvent, NoEvent,+ Event 55, NoEvent, NoEvent, NoEvent]+++accum_t14 :: [Int]+accum_t14 = take 40 $ embed (repeatedly 1.0 1+ >>> accumFilter accum_accFiltFun3 0+ >>> accumBy (+) 0+ >>> accumBy (+) 0+ >>> hold 0)+ accum_inp5++accum_t14r :: [Int]+accum_t14r = [0,0,0,0,1,1,1,1,1,1,1,1,5,5,5,5,5,5,5,5,14,14,14,14,+ 14,14,14,14,30,30,30,30,30,30,30,30,55,55,55,55]+++accum_t15 :: [Int]+accum_t15 = take 40 $ embed (repeatedly 1.0 1+ >>> accumFilter accum_accFiltFun3 0+ >>> accumBy (+) 0+ >>> accumHoldBy (+) 0)+ accum_inp5++accum_t15r :: [Int]+accum_t15r = accum_t14 -- Should agree!+++accum_t16 :: [Int]+accum_t16 = take 40 $ embed (repeatedly 1.0 1+ >>> accumFilter accum_accFiltFun3 0+ >>> accumBy (+) 0+ >>> accumBy (+) 0+ >>> dHold 0)+ accum_inp5++accum_t16r :: [Int]+accum_t16r = [0,0,0,0,0,1,1,1,1,1,1,1,1,5,5,5,5,5,5,5,5,14,14,14,+ 14,14,14,14,14,30,30,30,30,30,30,30,30,55,55,55]+++accum_t17 :: [Int]+accum_t17 = take 40 $ embed (repeatedly 1.0 1+ >>> accumFilter accum_accFiltFun3 0+ >>> accumBy (+) 0+ >>> dAccumHoldBy (+) 0)+ accum_inp5++accum_t17r :: [Int]+accum_t17r = accum_t16 -- Should agree!++++accum_trs =+ [ accum_t0 == accum_t0r,+ accum_t1 == accum_t1r,+ accum_t2 == accum_t2r,+ accum_t3 == accum_t3r,+ accum_t4 == accum_t4r,+ accum_t5 == accum_t5r,+ accum_t6 == accum_t6r,+ accum_t7 == accum_t7r,+ accum_t8 == accum_t8r,+ accum_t9 == accum_t9r,+ accum_t10 == accum_t10r,+ accum_t11 == accum_t11r,+ accum_t12 == accum_t12r,+ accum_t13 == accum_t13r,+ accum_t14 == accum_t14r,+ accum_t15 == accum_t15r,+ accum_t16 == accum_t16r,+ accum_t17 == accum_t17r+ ]++accum_tr = and accum_trs+++accum_st0 :: Double+accum_st0 = testSFSpaceLeak 1000000+ (repeatedly 1.0 1.0+ >>> accumBy (+) 0.0+ >>> hold (-99.99))++accum_st0r = 249999.0+++accum_st1 :: Double+accum_st1 = testSFSpaceLeak 1000000+ (arr dup+ >>> first (repeatedly 1.0 1.0)+ >>> arr (\(e,a) -> tag e a)+ >>> accumFilter accumFun 0.0+ >>> hold (-99.99))+ where+ accumFun c a | even (floor a) = (c+a, Just (c+a))+ | otherwise = (c, Nothing)++accum_st1r = 6.249975e10
+ tests/TestsArr.hs view
@@ -0,0 +1,53 @@+{-# OPTIONS_GHC -fno-warn-tabs #-}+{- $Id: TestsArr.hs,v 1.2 2003/11/10 21:28:58 antony Exp $+******************************************************************************+* Y A M P A *+* *+* Module: TestsArr *+* Purpose: Test cases for arr *+* Authors: Antony Courtney and Henrik Nilsson *+* *+* Copyright (c) Yale University, 2003 *+* *+******************************************************************************+-}++module TestsArr (+ arr_trs,+ arr_tr,+ arr_st0,+ arr_st0r,+ arr_st1,+ arr_st1r+) where++import FRP.Yampa++import TestsCommon++------------------------------------------------------------------------------+-- Test cases for arr+------------------------------------------------------------------------------++arr_t0 = testSF1 (arr (+1))+arr_t0r =+ [1.0,2.0,3.0,4.0,5.0,6.0,7.0,8.0,9.0,10.0,11.0,12.0,13.0,14.0,15.0,16.0,+ 17.0,18.0,19.0,20.0,21.0,22.0,23.0,24.0,25.0]++arr_t1 = testSF2 (arr (+1))+arr_t1r =+ [1.0,1.0,1.0,1.0,1.0,2.0,2.0,2.0,2.0,2.0,3.0,3.0,3.0,3.0,3.0,4.0,4.0,4.0,+ 4.0,4.0,5.0,5.0,5.0,5.0,5.0]++arr_trs =+ [ arr_t0 ~= arr_t0r,+ arr_t1 ~= arr_t1r+ ]++arr_tr = and arr_trs++arr_st0 = testSFSpaceLeak 2000000 (arr (+1))+arr_st0r = 1000000.5++arr_st1 = testSFSpaceLeak 2000000 identity+arr_st1r = 999999.5
+ tests/TestsBasicSF.hs view
@@ -0,0 +1,70 @@+{-# OPTIONS_GHC -fno-warn-tabs #-}+{- $Id: TestsBasicSF.hs,v 1.2 2003/11/10 21:28:58 antony Exp $+******************************************************************************+* Y A M P A *+* *+* Module: TestsBasicSF *+* Purpose: Test cases for basic signal functions *+* Authors: Antony Courtney and Henrik Nilsson *+* *+* Copyright (c) Yale University, 2003 *+* *+******************************************************************************+-}++module TestsBasicSF (basicsf_trs, basicsf_tr) where++import FRP.Yampa++import TestsCommon++------------------------------------------------------------------------------+-- Test cases for basic signal functions and initialization+------------------------------------------------------------------------------++basicsf_t0 :: [Double]+basicsf_t0 = testSF1 identity+basicsf_t0r =+ [0.0, 1.0, 2.0, 3.0, 4.0, 5.0, 6.0, 7.0, 8.0, 9.0,+ 10.0, 11.0, 12.0, 13.0, 14.0, 15.0, 16.0, 17.0, 18.0, 19.0,+ 20.0, 21.0, 22.0, 23.0, 24.0]+++basicsf_t1 :: [Double]+basicsf_t1 = testSF1 (constant 42.0)+basicsf_t1r =+ [42.0, 42.0, 42.0, 42.0, 42.0, 42.0, 42.0, 42.0, 42.0, 42.0,+ 42.0, 42.0, 42.0, 42.0, 42.0, 42.0, 42.0, 42.0, 42.0, 42.0,+ 42.0, 42.0, 42.0, 42.0, 42.0]++basicsf_t2 :: [Double]+basicsf_t2 = testSF1 localTime+basicsf_t2r =+ [0.0, 0.25, 0.5, 0.75, 1.0, 1.25, 1.5, 1.75, 2.0, 2.25,+ 2.5, 2.75, 3.0, 3.25, 3.5, 3.75, 4.0, 4.25, 4.5, 4.75,+ 5.0, 5.25, 5.5, 5.75, 6.0]++basicsf_t3 :: [Double]+basicsf_t3 = testSF1 time+basicsf_t3r =+ [0.0, 0.25, 0.5, 0.75, 1.0, 1.25, 1.5, 1.75, 2.0, 2.25,+ 2.5, 2.75, 3.0, 3.25, 3.5, 3.75, 4.0, 4.25, 4.5, 4.75,+ 5.0, 5.25, 5.5, 5.75, 6.0]++basicsf_t4 :: [Double]+basicsf_t4 = testSF1 (initially 42.0)+basicsf_t4r =+ [42.0, 1.0, 2.0, 3.0, 4.0, 5.0, 6.0, 7.0, 8.0, 9.0,+ 10.0, 11.0, 12.0, 13.0, 14.0, 15.0, 16.0, 17.0, 18.0, 19.0,+ 20.0, 21.0, 22.0, 23.0, 24.0]+++basicsf_trs =+ [ basicsf_t0 ~= basicsf_t0r,+ basicsf_t1 ~= basicsf_t1r,+ basicsf_t2 ~= basicsf_t2r,+ basicsf_t3 ~= basicsf_t3r,+ basicsf_t4 ~= basicsf_t4r+ ]++basicsf_tr = and basicsf_trs
+ tests/TestsCOC.hs view
@@ -0,0 +1,57 @@+{-# OPTIONS_GHC -fno-warn-tabs #-}+{- $Id: TestsCOC.hs,v 1.2 2003/11/10 21:28:58 antony Exp $+******************************************************************************+* Y A M P A *+* *+* Module: TestsCOC *+* Purpose: Test cases for collection-oriented combinators *+* Authors: Antony Courtney and Henrik Nilsson *+* *+* Copyright (c) Yale University, 2003 *+* *+******************************************************************************+-}++module TestsCOC (coc_tr, coc_trs) where++import FRP.Yampa++import TestsCommon++------------------------------------------------------------------------------+-- Test cases for collection-oriented combinators+------------------------------------------------------------------------------++coc_inp1 = deltaEncode 0.1 [0.0, 0.5 ..]++coc_t0 :: [[Double]]+coc_t0 = take 20 $ embed (parB [constant 1.0, identity, integral]) coc_inp1++coc_t0r =+ [[1.0, 0.0, 0.00],+ [1.0, 0.5, 0.00],+ [1.0, 1.0, 0.05],+ [1.0, 1.5, 0.15],+ [1.0, 2.0, 0.30],+ [1.0, 2.5, 0.50],+ [1.0, 3.0, 0.75],+ [1.0, 3.5, 1.05],+ [1.0, 4.0, 1.40],+ [1.0, 4.5, 1.80],+ [1.0, 5.0, 2.25],+ [1.0, 5.5, 2.75],+ [1.0, 6.0, 3.30],+ [1.0, 6.5, 3.90],+ [1.0, 7.0, 4.55],+ [1.0, 7.5, 5.25],+ [1.0, 8.0, 6.00],+ [1.0, 8.5, 6.80],+ [1.0, 9.0, 7.65],+ [1.0, 9.5, 8.55]]+++coc_trs =+ [ coc_t0 ~= coc_t0r+ ]++coc_tr = and coc_trs
+ tests/TestsCommon.hs view
@@ -0,0 +1,170 @@+{-# OPTIONS_GHC -fno-warn-tabs #-}+{-+******************************************************************************+* Y A M P A *+* *+* Module: TestsCommon *+* Purpose: Common definitions for the regression test modules. *+* Authors: Antony Courtney and Henrik Nilsson *+* *+* Copyright (c) Yale University, 2003 *+* *+******************************************************************************+-}++module TestsCommon where++import System.IO.Unsafe (unsafePerformIO)+import Data.IORef (newIORef, writeIORef, readIORef)++import FRP.Yampa++------------------------------------------------------------------------------+-- Rough equality with instances+------------------------------------------------------------------------------++-- Rough equality. Only intended to be good enough for test cases in this+-- module.++class REq a where+ (~=) :: a -> a -> Bool++epsilon :: Fractional a => a+epsilon = 0.0001++instance REq Float where+ x ~= y = abs (x - y) < epsilon -- A relative measure should be used.++instance REq Double where+ x ~= y = abs (x - y) < epsilon -- A relative measure should be used.++instance REq Int where+ (~=) = (==)++instance REq Integer where+ (~=) = (==)++instance REq Bool where+ (~=) = (==)++instance REq Char where+ (~=) = (==)++instance REq () where+ () ~= () = True++instance (REq a, REq b) => REq (a,b) where+ (x1,x2) ~= (y1,y2) = x1 ~= y1 && x2 ~= y2++instance (REq a, REq b, REq c) => REq (a,b,c) where+ (x1,x2,x3) ~= (y1,y2,y3) = x1 ~= y1 && x2 ~= y2 && x3 ~= y3++instance (REq a, REq b, REq c, REq d) => REq (a,b,c,d) where+ (x1,x2,x3,x4) ~= (y1,y2,y3,y4) = x1 ~= y1+ && x2 ~= y2+ && x3 ~= y3+ && x4 ~= y4++instance (REq a, REq b, REq c, REq d, REq e) => REq (a,b,c,d,e) where+ (x1,x2,x3,x4,x5) ~= (y1,y2,y3,y4,y5) = x1 ~= y1+ && x2 ~= y2+ && x3 ~= y3+ && x4 ~= y4+ && x5 ~= y5++instance REq a => REq (Maybe a) where+ Nothing ~= Nothing = True+ (Just x) ~= (Just y) = x ~= y+ _ ~= _ = False++instance REq a => REq (Event a) where+ NoEvent ~= NoEvent = True+ (Event x) ~= (Event y) = x ~= y+ _ ~= _ = False++instance (REq a, REq b) => REq (Either a b) where+ (Left x) ~= (Left y) = x ~= y+ (Right x) ~= (Right y) = x ~= y+ _ ~= _ = False++instance REq a => REq [a] where+ [] ~= [] = True+ (x:xs) ~= (y:ys) = x ~= y && xs ~= ys+ _ ~= _ = False+++------------------------------------------------------------------------------+-- Testing utilities+------------------------------------------------------------------------------++testSF1 :: SF Double a -> [a]+testSF1 sf = take 25 (embed sf (deltaEncodeBy (~=) 0.25 [0.0..]))+++testSF2 :: SF Double a -> [a]+testSF2 sf = take 25 (embed sf (deltaEncodeBy (~=) 0.25 input))+ where+ -- The initial 0.0 is just for result compatibility with an older+ -- version.+ input = 0.0 : [ fromIntegral (b `div` freq) | b <- [1..] :: [Int] ]+ freq = 5+++------------------------------------------------------------------------------+-- Test harness for space behaviour+------------------------------------------------------------------------------++{-+-- Test for space leaks.+-- Carefully defined in an attempt to defeat fully lazy lambda lifting.+-- Seems to work, but may be unsafe if the compiler decides to optimize+-- aggressively.+testSFSpaceLeak :: Int -> SF Double a -> a+testSFSpaceLeak n sf = embed sf (deltaEncodeBy (~=) 0.25 [(seq n 0.0)..]) !! n+-}+++-- Using embed/deltaEncode seems to be a bad idea since fully lazy+-- lambda lifting often results in lifting a big input list to the top+-- level in the form of a CAF. Using reactimate and avoiding constructing+-- input/output lists should be more robust.++testSFSpaceLeak :: Int -> SF Double a -> a+testSFSpaceLeak n sf = unsafePerformIO $ do+ countr <- newIORef 0+ inputr <- newIORef undefined+ outputr <- newIORef undefined+ let init = do+ let input0 = 0.0+ writeIORef inputr input0+ count <- readIORef countr+ writeIORef countr (count + 1)+ return input0+ sense _ = do+ input <- readIORef inputr+ let input' = input + 0.5+ writeIORef inputr input'+ count <- readIORef countr+ writeIORef countr (count + 1)+ return (0.25, Just input')+ actuate _ output = do+ writeIORef outputr output+ _input <- readIORef inputr+ count <- readIORef countr+ return (count >= n)+ reactimate init sense actuate sf++ -- return output+ readIORef outputr++------------------------------------------------------------------------------+-- Some utilities used for testing laws+------------------------------------------------------------------------------++fun_prod f g = \(x,y) -> (f x, g y)++assoc :: ((a,b),c) -> (a,(b,c))+assoc ((a,b),c) = (a,(b,c))++assocInv :: (a,(b,c)) -> ((a,b),c)+assocInv (a,(b,c)) = ((a,b),c)
+ tests/TestsComp.hs view
@@ -0,0 +1,72 @@+{-# OPTIONS_GHC -fno-warn-tabs #-}+{- $Id: TestsComp.hs,v 1.2 2003/11/10 21:28:58 antony Exp $+******************************************************************************+* Y A M P A *+* *+* Module: TestsComp *+* Purpose: Test cases for (>>>) *+* Authors: Antony Courtney and Henrik Nilsson *+* *+* Copyright (c) Yale University, 2003 *+* *+******************************************************************************+-}++module TestsComp (comp_tr, comp_trs) where++import FRP.Yampa++import TestsCommon++------------------------------------------------------------------------------+-- Test cases for comp+------------------------------------------------------------------------------++comp_t0 = testSF1 ((arr (+1)) >>> (arr (+2)))+comp_t0r :: [Double]+comp_t0r =+ [3.0,4.0,5.0,6.0,7.0,8.0,9.0,10.0,11.0,12.0,13.0,14.0,15.0,16.0,17.0,+ 18.0,19.0,20.0,21.0,22.0,23.0,24.0,25.0,26.0,27.0]++comp_t1 = testSF2 ((arr (+1)) >>> (arr (+2)))+comp_t1r :: [Double]+comp_t1r =+ [3.0,3.0,3.0,3.0,3.0,4.0,4.0,4.0,4.0,4.0,5.0,5.0,5.0,5.0,5.0,+ 6.0,6.0,6.0,6.0,6.0,7.0,7.0,7.0,7.0,7.0]++comp_t2 = testSF1 ((constant 5.0) >>> (arr (+1)))+comp_t2r :: [Double]+comp_t2r =+ [6.0,6.0,6.0,6.0,6.0,6.0,6.0,6.0,6.0,6.0,6.0,6.0,6.0,6.0,6.0,6.0,+ 6.0,6.0,6.0,6.0,6.0,6.0,6.0,6.0,6.0]++comp_t3 = testSF2 ((constant 5.0) >>> (arr (+1)))+comp_t3r :: [Double]+comp_t3r =+ [6.0,6.0,6.0,6.0,6.0,6.0,6.0,6.0,6.0,6.0,6.0,6.0,6.0,6.0,6.0,6.0,+ 6.0,6.0,6.0,6.0,6.0,6.0,6.0,6.0,6.0]++-- Integration by the rectangle rule or trapezoid rule makes no difference.+comp_t4 = testSF1 ((constant 2.0) >>> integral)+comp_t4r :: [Double]+comp_t4r =+ [0.0,0.5,1.0,1.5,2.0,2.5,3.0,3.5,4.0,4.5,5.0,5.5,6.0,6.5,7.0,7.5,8.0,8.5,+ 9.0,9.5,10.0,10.5,11.0,11.5,12.0]++-- Same result as above.+comp_t5 = testSF2 ((constant 2.0) >>> integral)+comp_t5r :: [Double]+comp_t5r =+ [0.0,0.5,1.0,1.5,2.0,2.5,3.0,3.5,4.0,4.5,5.0,5.5,6.0,6.5,7.0,7.5,8.0,8.5,+ 9.0,9.5,10.0,10.5,11.0,11.5,12.0]++comp_trs =+ [ comp_t0 ~= comp_t0r,+ comp_t1 ~= comp_t1r,+ comp_t2 ~= comp_t2r,+ comp_t3 ~= comp_t3r,+ comp_t4 ~= comp_t4r,+ comp_t5 ~= comp_t5r+ ]++comp_tr = and comp_trs
+ tests/TestsDelay.hs view
@@ -0,0 +1,89 @@+{-# OPTIONS_GHC -fno-warn-tabs #-}+{- $Id: TestsDelay.hs,v 1.2 2003/11/10 21:28:58 antony Exp $+******************************************************************************+* Y A M P A *+* *+* Module: TestsDelay *+* Purpose: Test cases for delays *+* Authors: Antony Courtney and Henrik Nilsson *+* *+* Copyright (c) Yale University, 2003 *+* *+******************************************************************************+-}++module TestsDelay (delay_tr, delay_trs) where++import FRP.Yampa++import TestsCommon++------------------------------------------------------------------------------+-- Test cases for delays+------------------------------------------------------------------------------++delay_t0 = testSF1 (delay 0.0 undefined)+delay_t0r =+ [0.0,1.0,2.0,3.0,4.0,5.0,6.0,7.0,8.0,9.0,10.0,11.0,12.0,13.0,14.0,+ 15.0,16.0,17.0,18.0,19.0,20.0,21.0,22.0,23.0,24.0]++delay_t1 = testSF1 (delay 0.0001 17)+delay_t1r =+ [17.0,0.0,1.0,2.0,3.0,4.0,5.0,6.0,7.0,8.0,9.0,10.0,11.0,12.0,13.0,14.0,+ 15.0,16.0,17.0,18.0,19.0,20.0,21.0,22.0,23.0]++delay_t2 = testSF2 (delay 0.0001 17)+delay_t2r =+ [17.0,0.0,0.0,0.0,0.0,0.0,1.0,1.0,1.0,1.0,1.0,2.0,2.0,2.0,2.0,2.0,+ 3.0,3.0,3.0,3.0,3.0,4.0,4.0,4.0,4.0]++delay_t3 = testSF1 (time+ >>> arr (\t -> sin (0.5 * t * pi + pi))+ >>> loop (arr (\(x1,x2) -> let x' = max x1 x2 in (x',x'))+ >>> second (delay 0.0001 0.0)))+delay_t3r =+ take 25+ (let xs = [ sin (0.5 * t * pi + pi) | t <- [0.0, 0.25 ..] ]+ in tail (scanl max 0 xs))++dts_t4 = take 15 (repeat 0.1)+ ++ [0.5, 0.5]+ ++ take 15 (repeat 0.1)+ ++ [2.0]+ ++ take 20 (repeat 0.1)++input_t4 = (0, [ (dt, Just i) | (dt, i) <- zip dts_t4 [1..] ])++delay_t4, delay_t4r :: [Int]+delay_t4 = take 100 (embed (delay 1.05 (-1)) input_t4)+delay_t4r =+ [ -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -- 0.0 s -- 0.9 s+ -1, 0, 1, 2, 3, 4, -- 1.0 s -- 1.5 s+ 9, 14, 15, 15, 15, 15, -- 2.0 s -- 2.9 s+ 15, 16, 16, 16, 16, 16, 17, 18, 19, 20, -- 3.0 s -- 3.9 s+ 21, -- 4.0 s+ 32, 32, 32, 32, 32, 32, 32, 32, 32, 32, -- 6.0 s -- 6.9 s+ 32, 33, 34, 35, 36, 37, 38, 39, 40, 41, -- 7.0 s -- 7.9 s+ 42 -- 8.0 s+ ]+++delay_t5 = take 100 (drop 6 (embed sf (deltaEncode 0.1 (repeat ()))))+ where+ sf = time >>> arr (\t -> sin (2*pi*t)) >>> delay 0.55 (-1.0)++delay_t5r = take 100 (drop 6 (embed sf (deltaEncode 0.1 (repeat ()))))+ where+ sf = time >>> arr (\t -> sin (2*pi*(t-0.6)))+++delay_trs =+ [ delay_t0 ~= delay_t0r,+ delay_t1 ~= delay_t1r,+ delay_t2 ~= delay_t2r,+ delay_t3 ~= delay_t3r,+ delay_t4 == delay_t4r,+ delay_t5 ~= delay_t5r+ ]++delay_tr = and delay_trs
+ tests/TestsDer.hs view
@@ -0,0 +1,56 @@+{-# OPTIONS_GHC -fno-warn-tabs #-}+{- $Id: TestsDer.hs,v 1.2 2003/11/10 21:28:58 antony Exp $+******************************************************************************+* Y A M P A *+* *+* Module: TestsDer *+* Purpose: Test cases for derivative *+* Authors: Antony Courtney and Henrik Nilsson *+* *+* Copyright (c) Yale University, 2003 *+* *+******************************************************************************+-}++module TestsDer (der_tr, der_trs) where++import FRP.Yampa++import TestsCommon++------------------------------------------------------------------------------+-- Test cases for derivative+------------------------------------------------------------------------------++der_step = 0.001+der_N = 1000++der_t0 :: [Double]+der_t0 = take der_N $ -- First value is always 0+ embed derivative+ (deltaEncode der_step+ [sin(2 * pi * t) | t <- [0.0, der_step ..]])+{-+-- For stepsize 0.1+der_t0r :: [Double]+der_t0r =+ [ 0.0000, 5.8779, 3.6327, 0.0000, -3.6327,+ -5.8779, -5.8779, -3.6327, 0.0000, 3.6327,+ 5.8779, 5.8779, 3.6327, 0.0000, -3.6327,+ -5.8779, -5.8779, -3.6327, 0.0000, 3.6327]+-}++der_t0r :: [Double]+der_t0r = take der_N $+ [2 * pi * cos (2 * pi * t) | t <- [0.0, der_step ..]]++-- We're happy if we are in the right ball park.+der_t0_max_diff = (maximum (zipWith (\x y -> abs (x - y))+ (tail der_t0)+ (tail der_t0r)))++der_trs =+ [ der_t0_max_diff < 0.05+ ]++der_tr = and der_trs
+ tests/TestsEmbed.hs view
@@ -0,0 +1,62 @@+{-# OPTIONS_GHC -fno-warn-tabs #-}+{- $Id: TestsEmbed.hs,v 1.2 2003/11/10 21:28:58 antony Exp $+******************************************************************************+* Y A M P A *+* *+* Module: TestsEmbed *+* Purpose: Test cases for embedding *+* Authors: Antony Courtney and Henrik Nilsson *+* *+* Copyright (c) Yale University, 2003 *+* *+******************************************************************************+-}++module TestsEmbed (embed_tr, embed_trs) where++import FRP.Yampa++import TestsCommon++------------------------------------------------------------------------------+-- Test cases for embedding+------------------------------------------------------------------------------++embed_ratio :: SF a Double+embed_ratio = switch (constant 1.0 &&& after 5.0 ()) $ \_ ->+ switch (constant 0.0 &&& after 5.0 ()) $ \_ ->+ constant 3.0++embed_sf :: SF a Double+embed_sf = localTime >>> integral++embed_t0 = take 20 $ embed (embed_ratio+ >>> embedSynch embed_sf+ (deltaEncode 0.01 (repeat ())))+ (deltaEncode 1.0 (repeat ()))++embed_t0r =+ [ 0.0000, 0.4851, 1.9701, 4.4850, 7.9800,+ 7.9800, 7.9800, 7.9800, 7.9800, 7.9800,+ 24.4650, 49.9500, 84.4350, 127.9200, 180.2151,+ 241.6701, 312.1251, 391.5801, 480.03510, 577.4901]+++embed_t1 = take 20 $ embed (embed_ratio+ >>> embedSynch embed_sf+ (deltaEncode 0.5 (replicate 30 ())))+ (deltaEncode 1.0 (repeat ()))++embed_t1r =+ [ 0.00, 0.25, 1.50, 3.75, 7.00,+ 7.00, 7.00, 7.00, 7.00, 7.00,+ 22.75, 47.50, 81.25, 101.50, 101.50,+ 101.50, 101.50, 101.50, 101.50, 101.50]++embed_trs =+ [ embed_t0 ~= embed_t0r,+ embed_t1 ~= embed_t1r+ ]+++embed_tr = and embed_trs
+ tests/TestsEvSrc.hs view
@@ -0,0 +1,584 @@+{-# OPTIONS_GHC -fno-warn-tabs #-}+{- $Id: TestsEvSrc.hs,v 1.3 2003/12/19 15:32:22 henrik Exp $+******************************************************************************+* Y A M P A *+* *+* Module: TestsEvSrc *+* Purpose: Test cases for event sources *+* Authors: Antony Courtney and Henrik Nilsson *+* *+* Copyright (c) Yale University, 2003 *+* *+******************************************************************************+-}++module TestsEvSrc (evsrc_trs, evsrc_tr) where++import FRP.Yampa++import TestsCommon++------------------------------------------------------------------------------+-- Test cases for basic event sources and stateful event suppression+------------------------------------------------------------------------------++evsrc_t0 :: [Event ()]+evsrc_t0 = testSF1 never++evsrc_t0r =+ [NoEvent, NoEvent, NoEvent, NoEvent, -- 0.0 s+ NoEvent, NoEvent, NoEvent, NoEvent, -- 1.0 s+ NoEvent, NoEvent, NoEvent, NoEvent, -- 2.0 s+ NoEvent, NoEvent, NoEvent, NoEvent, -- 3.0 s+ NoEvent, NoEvent, NoEvent, NoEvent, -- 4.0 s+ NoEvent, NoEvent, NoEvent, NoEvent, -- 5.0 s+ NoEvent]+++evsrc_t1 :: [Event Int]+evsrc_t1 = testSF1 (now 42)++evsrc_t1r :: [Event Int]+evsrc_t1r =+ [Event 42, NoEvent, NoEvent, NoEvent, -- 0.0 s+ NoEvent, NoEvent, NoEvent, NoEvent, -- 1.0 s+ NoEvent, NoEvent, NoEvent, NoEvent, -- 2.0 s+ NoEvent, NoEvent, NoEvent, NoEvent, -- 3.0 s+ NoEvent, NoEvent, NoEvent, NoEvent, -- 4.0 s+ NoEvent, NoEvent, NoEvent, NoEvent, -- 5.0 s+ NoEvent]+++evsrc_t2 :: [Event Int]+evsrc_t2 = testSF1 (after 0.0 42)+evsrc_t2r :: [Event Int]+evsrc_t2r =+ [Event 42, NoEvent, NoEvent, NoEvent, -- 0.0 s+ NoEvent, NoEvent, NoEvent, NoEvent, -- 1.0 s+ NoEvent, NoEvent, NoEvent, NoEvent, -- 2.0 s+ NoEvent, NoEvent, NoEvent, NoEvent, -- 3.0 s+ NoEvent, NoEvent, NoEvent, NoEvent, -- 4.0 s+ NoEvent, NoEvent, NoEvent, NoEvent, -- 5.0 s+ NoEvent]+++evsrc_t3 :: [Event Int]+evsrc_t3 = testSF1 (after 3.0 42)++evsrc_t3r :: [Event Int]+evsrc_t3r =+ [NoEvent, NoEvent, NoEvent, NoEvent, -- 0.0 s+ NoEvent, NoEvent, NoEvent, NoEvent, -- 1.0 s+ NoEvent, NoEvent, NoEvent, NoEvent, -- 2.0 s+ Event 42, NoEvent, NoEvent, NoEvent, -- 3.0 s+ NoEvent, NoEvent, NoEvent, NoEvent, -- 4.0 s+ NoEvent, NoEvent, NoEvent, NoEvent, -- 5.0 s+ NoEvent]+++evsrc_t4 :: [Event Int]+evsrc_t4 = testSF1 (after 3.01 42)++evsrc_t4r :: [Event Int]+evsrc_t4r =+ [NoEvent, NoEvent, NoEvent, NoEvent, -- 0.0 s+ NoEvent, NoEvent, NoEvent, NoEvent, -- 1.0 s+ NoEvent, NoEvent, NoEvent, NoEvent, -- 2.0 s+ NoEvent, Event 42, NoEvent, NoEvent, -- 3.0 s+ NoEvent, NoEvent, NoEvent, NoEvent, -- 4.0 s+ NoEvent, NoEvent, NoEvent, NoEvent, -- 5.0 s+ NoEvent]+++evsrc_t5 :: [Event Int]+evsrc_t5 = testSF1 (repeatedly 0.795 42)++evsrc_t5r :: [Event Int]+evsrc_t5r =+ [NoEvent, NoEvent, NoEvent, NoEvent, -- 0.0 s+ Event 42, NoEvent, NoEvent, Event 42, -- 1.0 s+ NoEvent, NoEvent, Event 42, NoEvent, -- 2.0 s+ NoEvent, Event 42, NoEvent, NoEvent, -- 3.0 s+ Event 42, NoEvent, NoEvent, NoEvent, -- 4.0 s+ Event 42, NoEvent, NoEvent, Event 42, -- 5.0 s+ NoEvent]++evsrc_t6 :: [Event Int]+evsrc_t6 = testSF1 (repeatedly 0.29999 42)++evsrc_t6r :: [Event Int]+evsrc_t6r =+ [NoEvent, NoEvent, Event 42, Event 42, -- 0.0 s+ Event 42, Event 42, Event 42, NoEvent, -- 1.0 s+ Event 42, Event 42, Event 42, Event 42, -- 2.0 s+ Event 42, NoEvent, Event 42, Event 42, -- 3.0 s+ Event 42, Event 42, Event 42, NoEvent, -- 4.0 s+ Event 42, Event 42, Event 42, Event 42, -- 5.0 s+ Event 42]++evsrc_t7 :: [Event Int]+evsrc_t7 = testSF1 (repeatedly 0.24 42)++evsrc_t7r :: [Event Int]+evsrc_t7r =+ [NoEvent, Event 42, Event 42, Event 42, -- 0.0 s+ Event 42, Event 42, Event 42, Event 42, -- 1.0 s+ Event 42, Event 42, Event 42, Event 42, -- 2.0 s+ Event 42, Event 42, Event 42, Event 42, -- 3.0 s+ Event 42, Event 42, Event 42, Event 42, -- 4.0 s+ Event 42, Event 42, Event 42, Event 42, -- 5.0 s+ Event 42]+++evsrc_t8 :: [Event Int]+evsrc_t8 = testSF1 (afterEach [(0.00, 1), (0.00, 2), (0.01, 3), (0.23, 4),+ (0.02, 5), (0.75, 6), (0.10, 7), (0.10, 8),+ (0.10, 9), (2.00, 10)])++evsrc_t8r :: [Event Int]+evsrc_t8r =+ [Event 1, Event 3, Event 5, NoEvent, -- 0.0 s+ NoEvent, Event 6, Event 9, NoEvent, -- 1.0 s+ NoEvent, NoEvent, NoEvent, NoEvent, -- 2.0 s+ NoEvent, NoEvent, Event 10, NoEvent, -- 3.0 s+ NoEvent, NoEvent, NoEvent, NoEvent, -- 4.0 s+ NoEvent, NoEvent, NoEvent, NoEvent, -- 5.0 s+ NoEvent]+++evsrc_t9 :: [Event Int]+evsrc_t9 = testSF1 (afterEach [(2.03, 0),+ (0.00, 1), (0.00, 2), (0.01, 3), (0.23, 4),+ (0.02, 5), (0.75, 6), (0.10, 7), (0.10, 8),+ (0.10, 9), (2.00, 10), (0.00, 11), (0.00, 12)])++evsrc_t9r :: [Event Int]+evsrc_t9r =+ [NoEvent, NoEvent, NoEvent, NoEvent, -- 0.0 s+ NoEvent, NoEvent, NoEvent, NoEvent, -- 1.0 s+ NoEvent, Event 0, Event 4, NoEvent, -- 2.0 s+ NoEvent, Event 6, Event 9, NoEvent, -- 3.0 s+ NoEvent, NoEvent, NoEvent, NoEvent, -- 4.0 s+ NoEvent, NoEvent, Event 10, NoEvent, -- 5.0 s+ NoEvent]++++evsrc_t10 :: [Event [Int]]+evsrc_t10 = testSF1 (afterEachCat [(0.00, 1), (0.00, 2), (0.01, 3), (0.23, 4),+ (0.02, 5), (0.75, 6), (0.10, 7), (0.10, 8),+ (0.10, 9), (2.00, 10)])++evsrc_t10r :: [Event [Int]]+evsrc_t10r =+ [Event [1,2], Event [3,4], Event [5], NoEvent, -- 0.0 s+ NoEvent, Event [6,7,8], Event [9], NoEvent, -- 1.0 s+ NoEvent, NoEvent, NoEvent, NoEvent, -- 2.0 s+ NoEvent, NoEvent, Event [10], NoEvent, -- 3.0 s+ NoEvent, NoEvent, NoEvent, NoEvent, -- 4.0 s+ NoEvent, NoEvent, NoEvent, NoEvent, -- 5.0 s+ NoEvent]+++evsrc_t11 :: [Event [Int]]+evsrc_t11 = testSF1 (afterEachCat [(2.03, 0),+ (0.00, 1), (0.00, 2), (0.01, 3), (0.23, 4),+ (0.02, 5), (0.75, 6), (0.10, 7), (0.10, 8),+ (0.10, 9), (2.00, 10)])++evsrc_t11r :: [Event [Int]]+evsrc_t11r =+ [NoEvent, NoEvent, NoEvent, NoEvent, -- 0.0 s+ NoEvent, NoEvent, NoEvent, NoEvent, -- 1.0 s+ NoEvent, Event [0,1,2,3], Event [4,5], NoEvent, -- 2.0 s+ NoEvent, Event [6,7,8], Event [9], NoEvent, -- 3.0 s+ NoEvent, NoEvent, NoEvent, NoEvent, -- 4.0 s+ NoEvent, NoEvent, Event [10], NoEvent, -- 5.0 s+ NoEvent]+++evsrc_t12 :: [Event ()]+evsrc_t12 = testSF1 (localTime >>> arr (>=0) >>> edge)++evsrc_t12r =+ [NoEvent, NoEvent, NoEvent, NoEvent, -- 0.0 s+ NoEvent, NoEvent, NoEvent, NoEvent, -- 1.0 s+ NoEvent, NoEvent, NoEvent, NoEvent, -- 2.0 s+ NoEvent, NoEvent, NoEvent, NoEvent, -- 3.0 s+ NoEvent, NoEvent, NoEvent, NoEvent, -- 4.0 s+ NoEvent, NoEvent, NoEvent, NoEvent, -- 5.0 s+ NoEvent]+++evsrc_t13 :: [Event ()]+evsrc_t13 = testSF1 (localTime >>> arr (>=4.26) >>> edge)++evsrc_t13r =+ [NoEvent, NoEvent, NoEvent, NoEvent, -- 0.0 s+ NoEvent, NoEvent, NoEvent, NoEvent, -- 1.0 s+ NoEvent, NoEvent, NoEvent, NoEvent, -- 2.0 s+ NoEvent, NoEvent, NoEvent, NoEvent, -- 3.0 s+ NoEvent, NoEvent, Event (), NoEvent, -- 4.0 s+ NoEvent, NoEvent, NoEvent, NoEvent, -- 5.0 s+ NoEvent]+++-- Raising edge detector.+evsrc_isEdge False False = Nothing+evsrc_isEdge False True = Just ()+evsrc_isEdge True True = Nothing+evsrc_isEdge True False = Nothing+++evsrc_t14 :: [Event ()]+evsrc_t14 = testSF1 (localTime >>> arr (>=0) >>> edgeBy evsrc_isEdge False)++evsrc_t14r =+ [Event (), NoEvent, NoEvent, NoEvent, -- 0.0 s+ NoEvent, NoEvent, NoEvent, NoEvent, -- 1.0 s+ NoEvent, NoEvent, NoEvent, NoEvent, -- 2.0 s+ NoEvent, NoEvent, NoEvent, NoEvent, -- 3.0 s+ NoEvent, NoEvent, NoEvent, NoEvent, -- 4.0 s+ NoEvent, NoEvent, NoEvent, NoEvent, -- 5.0 s+ NoEvent]++evsrc_t15 :: [Event ()]+evsrc_t15 = testSF1 (localTime >>> arr (>=4.26) >>> edgeBy evsrc_isEdge False)++evsrc_t15r =+ [NoEvent, NoEvent, NoEvent, NoEvent, -- 0.0 s+ NoEvent, NoEvent, NoEvent, NoEvent, -- 1.0 s+ NoEvent, NoEvent, NoEvent, NoEvent, -- 2.0 s+ NoEvent, NoEvent, NoEvent, NoEvent, -- 3.0 s+ NoEvent, NoEvent, Event (), NoEvent, -- 4.0 s+ NoEvent, NoEvent, NoEvent, NoEvent, -- 5.0 s+ NoEvent]++-- Raising and falling edge detector.+evsrc_isEdge2 False False = Nothing+evsrc_isEdge2 False True = Just True+evsrc_isEdge2 True True = Nothing+evsrc_isEdge2 True False = Just False++evsrc_t16 :: [Event Bool]+evsrc_t16 = testSF1 (localTime+ >>> arr (\t -> t >=2.01 && t <= 4.51)+ >>> edgeBy evsrc_isEdge2 True)++evsrc_t16r =+ [Event False, NoEvent, NoEvent, NoEvent, -- 0.0 s+ NoEvent, NoEvent, NoEvent, NoEvent, -- 1.0 s+ NoEvent, Event True, NoEvent, NoEvent, -- 2.0 s+ NoEvent, NoEvent, NoEvent, NoEvent, -- 3.0 s+ NoEvent, NoEvent, NoEvent, Event False, -- 4.0 s+ NoEvent, NoEvent, NoEvent, NoEvent, -- 5.0 s+ NoEvent]++evsrc_t17 :: [Event Int]+evsrc_t17 = testSF1 (now 17 &&& repeatedly 0.795 42+ >>> arr (uncurry merge)+ >>> notYet)++evsrc_t17r :: [Event Int]+evsrc_t17r =+ [NoEvent, NoEvent, NoEvent, NoEvent, -- 0.0 s+ Event 42, NoEvent, NoEvent, Event 42, -- 1.0 s+ NoEvent, NoEvent, Event 42, NoEvent, -- 2.0 s+ NoEvent, Event 42, NoEvent, NoEvent, -- 3.0 s+ Event 42, NoEvent, NoEvent, NoEvent, -- 4.0 s+ Event 42, NoEvent, NoEvent, Event 42, -- 5.0 s+ NoEvent]+++evsrc_t18 :: [Event Int]+evsrc_t18 = testSF1 (now 42 >>> once)++evsrc_t18r :: [Event Int]+evsrc_t18r =+ [Event 42, NoEvent, NoEvent, NoEvent, -- 0.0 s+ NoEvent, NoEvent, NoEvent, NoEvent, -- 1.0 s+ NoEvent, NoEvent, NoEvent, NoEvent, -- 2.0 s+ NoEvent, NoEvent, NoEvent, NoEvent, -- 3.0 s+ NoEvent, NoEvent, NoEvent, NoEvent, -- 4.0 s+ NoEvent, NoEvent, NoEvent, NoEvent, -- 5.0 s+ NoEvent]+++evsrc_t19 :: [Event Int]+evsrc_t19 = testSF1 (repeatedly 0.8 42 >>> once)++evsrc_t19r :: [Event Int]+evsrc_t19r =+ [NoEvent, NoEvent, NoEvent, NoEvent, -- 0.0 s+ Event 42, NoEvent, NoEvent, NoEvent, -- 1.0 s+ NoEvent, NoEvent, NoEvent, NoEvent, -- 2.0 s+ NoEvent, NoEvent, NoEvent, NoEvent, -- 3.0 s+ NoEvent, NoEvent, NoEvent, NoEvent, -- 4.0 s+ NoEvent, NoEvent, NoEvent, NoEvent, -- 5.0 s+ NoEvent]+++evsrc_t20 :: [Event Int]+evsrc_t20 = testSF1 (now 42 >>> takeEvents 0)++evsrc_t20r :: [Event Int]+evsrc_t20r =+ [NoEvent, NoEvent, NoEvent, NoEvent, -- 0.0 s+ NoEvent, NoEvent, NoEvent, NoEvent, -- 1.0 s+ NoEvent, NoEvent, NoEvent, NoEvent, -- 2.0 s+ NoEvent, NoEvent, NoEvent, NoEvent, -- 3.0 s+ NoEvent, NoEvent, NoEvent, NoEvent, -- 4.0 s+ NoEvent, NoEvent, NoEvent, NoEvent, -- 5.0 s+ NoEvent]+++evsrc_t21 :: [Event Int]+evsrc_t21 = testSF1 (now 42 >>> takeEvents 1)++evsrc_t21r :: [Event Int]+evsrc_t21r =+ [Event 42, NoEvent, NoEvent, NoEvent, -- 0.0 s+ NoEvent, NoEvent, NoEvent, NoEvent, -- 1.0 s+ NoEvent, NoEvent, NoEvent, NoEvent, -- 2.0 s+ NoEvent, NoEvent, NoEvent, NoEvent, -- 3.0 s+ NoEvent, NoEvent, NoEvent, NoEvent, -- 4.0 s+ NoEvent, NoEvent, NoEvent, NoEvent, -- 5.0 s+ NoEvent]+++evsrc_t22 :: [Event Int]+evsrc_t22 = testSF1 (repeatedly 0.8 42 >>> takeEvents 4)++evsrc_t22r :: [Event Int]+evsrc_t22r =+ [NoEvent, NoEvent, NoEvent, NoEvent, -- 0.0 s+ Event 42, NoEvent, NoEvent, Event 42, -- 1.0 s+ NoEvent, NoEvent, Event 42, NoEvent, -- 2.0 s+ NoEvent, Event 42, NoEvent, NoEvent, -- 3.0 s+ NoEvent, NoEvent, NoEvent, NoEvent, -- 4.0 s+ NoEvent, NoEvent, NoEvent, NoEvent, -- 5.0 s+ NoEvent]+++evsrc_t23 :: [Event Int]+evsrc_t23 = testSF1 (repeatedly 0.2 42 >>> takeEvents 4)++evsrc_t23r :: [Event Int]+evsrc_t23r =+ [NoEvent, Event 42, Event 42, Event 42, -- 0.0 s+ Event 42, NoEvent, NoEvent, NoEvent, -- 1.0 s+ NoEvent, NoEvent, NoEvent, NoEvent, -- 2.0 s+ NoEvent, NoEvent, NoEvent, NoEvent, -- 3.0 s+ NoEvent, NoEvent, NoEvent, NoEvent, -- 4.0 s+ NoEvent, NoEvent, NoEvent, NoEvent, -- 5.0 s+ NoEvent]+++evsrc_t24 :: [Event Int]+evsrc_t24 = testSF1 (now 42 >>> dropEvents 0)++evsrc_t24r :: [Event Int]+evsrc_t24r =+ [Event 42, NoEvent, NoEvent, NoEvent, -- 0.0 s+ NoEvent, NoEvent, NoEvent, NoEvent, -- 1.0 s+ NoEvent, NoEvent, NoEvent, NoEvent, -- 2.0 s+ NoEvent, NoEvent, NoEvent, NoEvent, -- 3.0 s+ NoEvent, NoEvent, NoEvent, NoEvent, -- 4.0 s+ NoEvent, NoEvent, NoEvent, NoEvent, -- 5.0 s+ NoEvent]+++evsrc_t25 :: [Event Int]+evsrc_t25 = testSF1 (now 42 >>> dropEvents 1)++evsrc_t25r :: [Event Int]+evsrc_t25r =+ [NoEvent, NoEvent, NoEvent, NoEvent, -- 0.0 s+ NoEvent, NoEvent, NoEvent, NoEvent, -- 1.0 s+ NoEvent, NoEvent, NoEvent, NoEvent, -- 2.0 s+ NoEvent, NoEvent, NoEvent, NoEvent, -- 3.0 s+ NoEvent, NoEvent, NoEvent, NoEvent, -- 4.0 s+ NoEvent, NoEvent, NoEvent, NoEvent, -- 5.0 s+ NoEvent]+++evsrc_t26 :: [Event Int]+-- Drop 5 events to get rid of the event at 4.0 s which may or may not happen+-- exactly there.+evsrc_t26 = testSF1 (repeatedly 0.8 42 >>> dropEvents 5)++evsrc_t26r :: [Event Int]+evsrc_t26r =+ [NoEvent, NoEvent, NoEvent, NoEvent, -- 0.0 s+ NoEvent, NoEvent, NoEvent, NoEvent, -- 1.0 s+ NoEvent, NoEvent, NoEvent, NoEvent, -- 2.0 s+ NoEvent, NoEvent, NoEvent, NoEvent, -- 3.0 s+ NoEvent, NoEvent, NoEvent, NoEvent, -- 4.0 s+ Event 42, NoEvent, NoEvent, Event 42, -- 5.0 s+ NoEvent]+++evsrc_t27 :: [Event Int]+evsrc_t27 = testSF1 (repeatedly 0.2 42 >>> dropEvents 4)++evsrc_t27r :: [Event Int]+evsrc_t27r =+ [NoEvent, NoEvent, NoEvent, NoEvent, -- 0.0 s+ NoEvent, Event 42, Event 42, Event 42, -- 1.0 s+ Event 42, Event 42, Event 42, Event 42, -- 2.0 s+ Event 42, Event 42, Event 42, Event 42, -- 3.0 s+ Event 42, Event 42, Event 42, Event 42, -- 4.0 s+ Event 42, Event 42, Event 42, Event 42, -- 5.0 s+ Event 42]++++evsrc_t28 :: [(Event Int, Event Int)]+evsrc_t28 = embed (repeatedly 0.5 ()+ >>> accumBy (\n _ -> n + 1) 0+ >>> identity &&& delayEvent 2.0)+ (deltaEncode 0.125 (replicate 50 ()))++evsrc_t28r =+ [ (NoEvent,NoEvent), (NoEvent,NoEvent), -- 0.0 s+ (NoEvent,NoEvent), (NoEvent,NoEvent),+ (Event 1,NoEvent), (NoEvent,NoEvent), -- 0.5 s+ (NoEvent,NoEvent), (NoEvent,NoEvent),+ (Event 2,NoEvent), (NoEvent,NoEvent), -- 1.0 s+ (NoEvent,NoEvent), (NoEvent,NoEvent),+ (Event 3,NoEvent), (NoEvent,NoEvent), -- 1.5 s+ (NoEvent,NoEvent), (NoEvent,NoEvent),+ (Event 4,NoEvent), (NoEvent,NoEvent), -- 2.0 s+ (NoEvent,NoEvent), (NoEvent,NoEvent),+ (Event 5,Event 1), (NoEvent,NoEvent), -- 2.5 s+ (NoEvent,NoEvent), (NoEvent,NoEvent),+ (Event 6,Event 2), (NoEvent,NoEvent), -- 3.0 s+ (NoEvent,NoEvent), (NoEvent,NoEvent),+ (Event 7,Event 3), (NoEvent,NoEvent), -- 3.5 s+ (NoEvent,NoEvent), (NoEvent,NoEvent),+ (Event 8,Event 4), (NoEvent,NoEvent), -- 4.0 s+ (NoEvent,NoEvent), (NoEvent,NoEvent),+ (Event 9,Event 5), (NoEvent,NoEvent), -- 4.5 s+ (NoEvent,NoEvent), (NoEvent,NoEvent),+ (Event 10,Event 6), (NoEvent,NoEvent), -- 5.0 s+ (NoEvent,NoEvent), (NoEvent,NoEvent),+ (Event 11,Event 7), (NoEvent,NoEvent), -- 5.5 s+ (NoEvent,NoEvent), (NoEvent,NoEvent),+ (Event 12,Event 8), (NoEvent,NoEvent) -- 6.0 s+ ]++evsrc_t29 :: [Event [Double]]+evsrc_t29 = embed (time &&& repeatedly 0.5001 ()+ >>> arr (\(t,e) -> e `tag` t)+ >>> delayEventCat 3.0)+ input+ where+ dts = replicate 40 0.1 ++ [2.0] ++ replicate 40 0.1+ input = ((), [(dt, Just ()) | dt <- dts])++{- Resulting input to the delay for reference:+[ NoEvent, NoEvent, NoEvent, NoEvent, NoEvent, -- 0.0 s+ NoEvent, Event 0.6, NoEvent, NoEvent, NoEvent, -- 0.5 s+ NoEvent, Event 1.1, NoEvent, NoEvent, NoEvent, -- 1.0 s+ NoEvent, Event 1.6, NoEvent, NoEvent, NoEvent, -- 1.5 s+ NoEvent, Event 2.1, NoEvent, NoEvent, NoEvent, -- 2.0 s+ NoEvent, Event 2.6, NoEvent, NoEvent, NoEvent, -- 2.5 s+ NoEvent, Event 3.1, NoEvent, NoEvent, NoEvent, -- 3.0 s+ NoEvent, Event 3.6, NoEvent, NoEvent, NoEvent, -- 3.5 s+ NoEvent, -- 4.0 s+ Event 6.0, Event 6.1, NoEvent, NoEvent, NoEvent, -- 6.0 s+ NoEvent, Event 6.6, NoEvent, NoEvent, NoEvent, -- 6.5 s+ NoEvent, Event 7.1, NoEvent, NoEvent, NoEvent, -- 7.0 s+ NoEvent, Event 7.6, NoEvent, NoEvent, NoEvent, -- 7.5 s+ NoEvent, Event 8.1, NoEvent, NoEvent, NoEvent, -- 8.0 s+ NoEvent, Event 8.6, NoEvent, NoEvent, NoEvent, -- 8.5 s+ NoEvent, Event 9.1, NoEvent, NoEvent, NoEvent, -- 9.0 s+ NoEvent, Event 9.6, NoEvent, NoEvent, NoEvent, -- 9.5 s+ NoEvent ] -- 10.0 s+-}++evsrc_t29r =+ [ NoEvent, NoEvent, NoEvent, NoEvent, NoEvent, -- 0.0 s+ NoEvent, NoEvent, NoEvent, NoEvent, NoEvent, -- 0.5 s+ NoEvent, NoEvent, NoEvent, NoEvent, NoEvent, -- 1.0 s+ NoEvent, NoEvent, NoEvent, NoEvent, NoEvent, -- 1.5 s+ NoEvent, NoEvent, NoEvent, NoEvent, NoEvent, -- 2.0 s+ NoEvent, NoEvent, NoEvent, NoEvent, NoEvent, -- 2.5 s+ NoEvent, NoEvent, NoEvent, NoEvent, NoEvent, -- 3.0 s+ NoEvent, Event [0.6], NoEvent, NoEvent, NoEvent, -- 3.5 s+ NoEvent, -- 4.0 s+ Event [1.1, 1.6, 2.1, 2.6], -- 6.0 s+ NoEvent, Event [3.1], NoEvent, NoEvent,+ NoEvent, NoEvent, Event [3.6], NoEvent, NoEvent, -- 6.5 s+ NoEvent, NoEvent, NoEvent, NoEvent, NoEvent, -- 7.0 s+ NoEvent, NoEvent, NoEvent, NoEvent, NoEvent, -- 7.5 s+ NoEvent, NoEvent, NoEvent, NoEvent, NoEvent, -- 8.0 s+ NoEvent, NoEvent, NoEvent, NoEvent, NoEvent, -- 8.5 s+ NoEvent, Event [6.0], Event [6.1], NoEvent, NoEvent, -- 9.0 s+ NoEvent, NoEvent, Event [6.6], NoEvent, NoEvent, -- 9.5 s+ NoEvent -- 10.0 s+ ]++-- "delayEvent" in a feedback loop. Should work like "repeatedly".+evsrc_t30 :: [(Event ())]+evsrc_t30 = embed (now ()+ >>> (loop $+ arr (uncurry lMerge)+ >>> delayEvent 1.0+ >>> arr dup))+ (deltaEncode 0.125 (replicate 50 ()))+++evsrc_t30r :: [(Event ())]+evsrc_t30r =+ [ NoEvent, NoEvent, NoEvent, NoEvent, -- 0.0 s+ NoEvent, NoEvent, NoEvent, NoEvent, -- 0.5 s+ Event (), NoEvent, NoEvent, NoEvent, -- 1.0 s+ NoEvent, NoEvent, NoEvent, NoEvent, -- 1.5 s+ Event (), NoEvent, NoEvent, NoEvent, -- 2.0 s+ NoEvent, NoEvent, NoEvent, NoEvent, -- 2.5 s+ Event (), NoEvent, NoEvent, NoEvent, -- 3.0 s+ NoEvent, NoEvent, NoEvent, NoEvent, -- 3.5 s+ Event (), NoEvent, NoEvent, NoEvent, -- 4.0 s+ NoEvent, NoEvent, NoEvent, NoEvent, -- 4.5 s+ Event (), NoEvent, NoEvent, NoEvent, -- 5.0 s+ NoEvent, NoEvent, NoEvent, NoEvent, -- 5.5 s+ Event (), NoEvent -- 6.0 s+ ]+++evsrc_trs =+ [ evsrc_t0 ~= evsrc_t0r,+ evsrc_t1 ~= evsrc_t1r,+ evsrc_t2 ~= evsrc_t2r,+ evsrc_t3 ~= evsrc_t3r,+ evsrc_t4 ~= evsrc_t4r,+ evsrc_t5 ~= evsrc_t5r,+ evsrc_t6 ~= evsrc_t6r,+ evsrc_t7 ~= evsrc_t7r,+ evsrc_t8 ~= evsrc_t8r,+ evsrc_t9 ~= evsrc_t9r,+ evsrc_t10 ~= evsrc_t10r,+ evsrc_t11 ~= evsrc_t11r,+ evsrc_t12 ~= evsrc_t12r,+ evsrc_t13 ~= evsrc_t13r,+ evsrc_t14 ~= evsrc_t14r,+ evsrc_t15 ~= evsrc_t15r,+ evsrc_t16 ~= evsrc_t16r,+ evsrc_t17 ~= evsrc_t17r,+ evsrc_t18 ~= evsrc_t18r,+ evsrc_t19 ~= evsrc_t19r,+ evsrc_t20 ~= evsrc_t20r,+ evsrc_t21 ~= evsrc_t21r,+ evsrc_t22 ~= evsrc_t22r,+ evsrc_t23 ~= evsrc_t23r,+ evsrc_t24 ~= evsrc_t24r,+ evsrc_t25 ~= evsrc_t25r,+ evsrc_t26 ~= evsrc_t26r,+ evsrc_t27 ~= evsrc_t27r,+ evsrc_t28 ~= evsrc_t28r,+ evsrc_t29 ~= evsrc_t29r,+ evsrc_t30 ~= evsrc_t30r+ ]++evsrc_tr = and evsrc_trs
+ tests/TestsFirstSecond.hs view
@@ -0,0 +1,128 @@+{-# OPTIONS_GHC -fno-warn-tabs #-}+{- $Id: TestsFirstSecond.hs,v 1.2 2003/11/10 21:28:58 antony Exp $+******************************************************************************+* Y A M P A *+* *+* Module: TestsArr *+* Purpose: Test cases for first and second *+* Authors: Antony Courtney and Henrik Nilsson *+* *+* Copyright (c) Yale University, 2003 *+* *+******************************************************************************+-}++module TestsFirstSecond (first_trs, first_tr, second_trs, second_tr) where++import Data.Tuple (swap)++import FRP.Yampa++import TestsCommon++------------------------------------------------------------------------------+-- Test cases for first+------------------------------------------------------------------------------++first_t0 :: [(Int,Double)]+first_t0 = testSF1 (arr dup >>> first (constant 7))+first_t0r :: [(Int,Double)]+first_t0r =+ [(7,0.0), (7,1.0), (7,2.0), (7,3.0), (7,4.0),+ (7,5.0), (7,6.0), (7,7.0), (7,8.0), (7,9.0),+ (7,10.0), (7,11.0), (7,12.0), (7,13.0), (7,14.0),+ (7,15.0), (7,16.0), (7,17.0), (7,18.0), (7,19.0),+ (7,20.0), (7,21.0), (7,22.0), (7,23.0), (7,24.0)]++first_t1 :: [(Int,Double)]+first_t1 = testSF2 (arr dup >>> first (constant 7))+first_t1r :: [(Int,Double)]+first_t1r =+ [(7,0.0), (7,0.0), (7,0.0), (7,0.0), (7,0.0),+ (7,1.0), (7,1.0), (7,1.0), (7,1.0), (7,1.0),+ (7,2.0), (7,2.0), (7,2.0), (7,2.0), (7,2.0),+ (7,3.0), (7,3.0), (7,3.0), (7,3.0), (7,3.0),+ (7,4.0), (7,4.0), (7,4.0), (7,4.0), (7,4.0)]++first_t2 :: [(Double,Double)]+first_t2 = testSF1 (arr dup >>> first (arr (+1)))+first_t2r =+ [(1.0,0.0), (2.0,1.0), (3.0,2.0), (4.0,3.0), (5.0,4.0),+ (6.0,5.0), (7.0,6.0), (8.0,7.0), (9.0,8.0), (10.0,9.0),+ (11.0,10.0), (12.0,11.0), (13.0,12.0), (14.0,13.0), (15.0,14.0),+ (16.0,15.0), (17.0,16.0), (18.0,17.0), (19.0,18.0), (20.0,19.0),+ (21.0,20.0), (22.0,21.0), (23.0,22.0), (24.0,23.0), (25.0,24.0)]++first_t3 :: [(Double,Double)]+first_t3 = testSF2 (arr dup >>> first (arr (+1)))+first_t3r =+ [(1.0,0.0), (1.0,0.0), (1.0,0.0), (1.0,0.0), (1.0,0.0),+ (2.0,1.0), (2.0,1.0), (2.0,1.0), (2.0,1.0), (2.0,1.0),+ (3.0,2.0), (3.0,2.0), (3.0,2.0), (3.0,2.0), (3.0,2.0),+ (4.0,3.0), (4.0,3.0), (4.0,3.0), (4.0,3.0), (4.0,3.0),+ (5.0,4.0), (5.0,4.0), (5.0,4.0), (5.0,4.0), (5.0,4.0)]++first_t4 :: [(Double,Double)]+first_t4 = testSF1 (arr dup >>> first integral)+first_t4r =+ [(0.0,0.0), (0.0,1.0), (0.25,2.0), (0.75,3.0), (1.5,4.0),+ (2.5,5.0), (3.75,6.0), (5.25,7.0), (7.0,8.0), (9.0,9.0),+ (11.25,10.0), (13.75,11.0), (16.5,12.0), (19.5,13.0), (22.75,14.0),+ (26.25,15.0), (30.0,16.0), (34.0,17.0), (38.25,18.0), (42.75,19.0),+ (47.5,20.0), (52.5,21.0), (57.75,22.0), (63.25,23.0), (69.0,24.0)]++first_t5 :: [(Double,Double)]+first_t5 = testSF2 (arr dup >>> first integral)+first_t5r =+ [(0.0,0.0), (0.0,0.0), (0.0,0.0), (0.0,0.0), (0.0,0.0),+ (0.0,1.0), (0.25,1.0), (0.5,1.0), (0.75,1.0), (1.0,1.0),+ (1.25,2.0), (1.75,2.0), (2.25,2.0), (2.75,2.0), (3.25,2.0),+ (3.75,3.0), (4.5,3.0), (5.25,3.0), (6.0,3.0), (6.75,3.0),+ (7.5,4.0), (8.5,4.0), (9.5,4.0), (10.5,4.0), (11.5,4.0)]++first_trs =+ [ first_t0 ~= first_t0r,+ first_t1 ~= first_t1r,+ first_t2 ~= first_t2r,+ first_t3 ~= first_t3r,+ first_t4 ~= first_t4r,+ first_t5 ~= first_t5r+ ]++first_tr = and first_trs+++------------------------------------------------------------------------------+-- Test cases for second+------------------------------------------------------------------------------++-- These should mirror the test cases for first.++second_t0 :: [(Int,Double)]+second_t0 = testSF1 (arr dup >>> second (constant 7) >>> arr swap)++second_t1 :: [(Int,Double)]+second_t1 = testSF2 (arr dup >>> second (constant 7) >>> arr swap)++second_t2 :: [(Double,Double)]+second_t2 = testSF1 (arr dup >>> second (arr (+1)) >>> arr swap)++second_t3 :: [(Double,Double)]+second_t3 = testSF2 (arr dup >>> second (arr (+1)) >>> arr swap)++second_t4 :: [(Double,Double)]+second_t4 = testSF1 (arr dup >>> second integral >>> arr swap)++second_t5 :: [(Double,Double)]+second_t5 = testSF2 (arr dup >>> second integral >>> arr swap)++second_trs =+ [ second_t0 ~= first_t0r,+ second_t1 ~= first_t1r,+ second_t2 ~= first_t2r,+ second_t3 ~= first_t3r,+ second_t4 ~= first_t4r,+ second_t5 ~= first_t5r+ ]++second_tr = and second_trs
+ tests/TestsKSwitch.hs view
@@ -0,0 +1,129 @@+{-# OPTIONS_GHC -fno-warn-tabs #-}+{- $Id: TestsKSwitch.hs,v 1.2 2003/11/10 21:28:58 antony Exp $+******************************************************************************+* Y A M P A *+* *+* Module: TestsKSwitch *+* Purpose: Test cases for kSwitch and dkSwitch *+* Authors: Antony Courtney and Henrik Nilsson *+* *+* Copyright (c) Yale University, 2003 *+* *+******************************************************************************+-}++module TestsKSwitch (kswitch_tr, kswitch_trs) where++import FRP.Yampa++import TestsCommon++------------------------------------------------------------------------------+-- Test cases for kSwitch and dkSwitch+------------------------------------------------------------------------------++kswitch_inp1 = deltaEncode 0.1 [0.0, 0.5 ..]++whenSndGE :: Ord b => b -> c -> SF (a, b) (Event c)+whenSndGE b c = arr snd >>> arr (>= b) >>> edge >>> arr (`tag` c)+++kswitch_t0 :: [Double]+kswitch_t0 = take 20 $ embed sf kswitch_inp1+ where+ sf =+ kSwitch integral (whenSndGE 0.2 (-1.0)) $ \sf1 x ->+ kSwitch (integral >>> arr (+x)) (whenSndGE 1.0 (1.0)) $ \_ _ ->+ sf1++kswitch_t0r =+ [ 0.00, 0.00, 0.05, 0.15, -1.00,+ -0.80, -0.55, -0.25, 0.10, 0.50,+ 0.95, 0.30, 0.85, 1.45, 2.10,+ 2.80, 3.55, 4.35, 5.20, 6.10]+++kswitch_t1 :: [Double]+kswitch_t1 = take 20 $ embed sf kswitch_inp1+ where+ sf =+ dkSwitch integral (whenSndGE 0.2 (-1.0)) $ \sf1 x ->+ dkSwitch (integral >>> arr (+x)) (whenSndGE 1.0 (1.0)) $ \_ _ ->+ sf1++kswitch_t1r =+ [ 0.00, 0.00, 0.05, 0.15, 0.30,+ -0.80, -0.55, -0.25, 0.10, 0.50,+ 0.95, 1.45, 0.85, 1.45, 2.10,+ 2.80, 3.55, 4.35, 5.20, 6.10]+++kswitch_t2 :: [Double]+kswitch_t2 = take 20 $ embed sf kswitch_inp1+ where+ sf =+ kSwitch integral (now (-1.0)) $ \sf1 x ->+ kSwitch (integral >>> arr (+x)) (whenSndGE 1.0 (1.0)) $ \_ _ ->+ sf1++kswitch_t2r =+ [-1.00, -1.00, -0.95, -0.85, -0.70,+ -0.50, -0.25, 0.05, 0.40, 0.80,+ 0.00, 0.50, 1.05, 1.65, 2.30,+ 3.00, 3.75, 4.55, 5.40, 6.30]+++kswitch_t3 :: [Double]+kswitch_t3 = take 20 $ embed sf kswitch_inp1+ where+ sf =+ dkSwitch integral (now (-1.0)) $ \sf1 x ->+ dkSwitch (integral >>> arr (+x)) (whenSndGE 1.0 (1.0)) $ \_ _ ->+ sf1++kswitch_t3r =+ [ 0.00, -1.00, -0.95, -0.85, -0.70,+ -0.50, -0.25, 0.05, 0.40, 0.80,+ 1.25, 0.50, 1.05, 1.65, 2.30,+ 3.00, 3.75, 4.55, 5.40, 6.30]+++-- The correct strictness properties of dkSwitch are crucial here.+-- kSwitch does not work.+kswitch_t4 = take 40 $+ embed (loop $+ dkSwitch sf (sfe 0.55 (-1.0)) $ \sf1 x ->+ dkSwitch (sf >>> arr2 (+x)) (sfe 0.05 8.0) $ \sf2 y ->+ dkSwitch sf1 (sfe 2.0 (-2.0)) $ \_ z ->+ sf2 >>> arr2 (+(y + z))+ )+ (deltaEncode 0.1 (repeat ()))+ where+ sf :: SF (a, Double) (Double, Double)+ sf = constant 1.0 >>> integral >>> arr dup++ sfe :: Double -> Double -> SF ((a, Double), b) (Event Double)+ sfe x e = arr fst >>> whenSndGE x e++ arr2 f = arr (\(x,y) -> (f x, f y))++kswitch_t4r =+ [ 0.0, 0.1, 0.2, 0.3, 0.4,+ 0.5, 0.6, -0.9, -0.8, -0.7,+ -0.6, -0.5, -0.4, -0.3, -0.2,+ -0.1, 0.0, 0.1, 0.7, 0.8,+ 0.9, 1.0, 1.1, 1.2, 1.3,+ 1.4, 1.5, 1.6, 1.7, 1.8,+ 1.9, 2.0, 6.2, 6.3, 6.4,+ 6.5, 6.6, 6.7, 6.8, 6.9]+++kswitch_trs =+ [ kswitch_t0 ~= kswitch_t0r,+ kswitch_t1 ~= kswitch_t1r,+ kswitch_t2 ~= kswitch_t2r,+ kswitch_t3 ~= kswitch_t3r,+ kswitch_t4 ~= kswitch_t4r+ ]++kswitch_tr = and kswitch_trs
+ tests/TestsLaws.hs view
@@ -0,0 +1,90 @@+{-# OPTIONS_GHC -fno-warn-tabs #-}+{- $Id: TestsLaws.hs,v 1.2 2003/11/10 21:28:58 antony Exp $+******************************************************************************+* Y A M P A *+* *+* Module: TestsLaws *+* Purpose: Test cases based on the arrow laws *+* Authors: Antony Courtney and Henrik Nilsson *+* *+* Copyright (c) Yale University, 2003 *+* *+******************************************************************************+-}++module TestsLaws (laws_trs, laws_tr) where++import FRP.Yampa++import TestsCommon++------------------------------------------------------------------------------+-- Test cases based on the arrow laws+------------------------------------------------------------------------------++-- For a description of the laws, see e.g. Ross Paterson: Embedding a Class of+-- Domain-Specific Languages in a Functional Language.+-- Only a very rudimentary sanity check. Obviously not intended to "prove"+-- this implementation indeed do respect the laws.++laws_t0_lhs :: [Double]+laws_t0_lhs = testSF1 (arr id >>> integral)+laws_t0_rhs :: [Double]+laws_t0_rhs = testSF1 (integral)++laws_t1_lhs :: [Double]+laws_t1_lhs = testSF1 (integral >>> arr id)+laws_t1_rhs :: [Double]+laws_t1_rhs = testSF1 (integral)++laws_t2_lhs :: [Double]+laws_t2_lhs = testSF1 ((integral >>> arr (*0.5)) >>> integral)+laws_t2_rhs :: [Double]+laws_t2_rhs = testSF1 (integral >>> (arr (*0.5) >>> integral))++laws_t3_lhs :: [Double]+laws_t3_lhs = testSF1 (arr ((*2.5) . (+3.0)))+laws_t3_rhs :: [Double]+laws_t3_rhs = testSF1 (arr (+3.0) >>> arr (*2.5))++laws_t4_lhs :: [(Double, Double)]+laws_t4_lhs = testSF1 (arr dup >>> first (arr (*2.5)))+laws_t4_rhs :: [(Double, Double)]+laws_t4_rhs = testSF1 (arr dup >>> arr ((*2.5) *** id))++laws_t5_lhs :: [(Double, Double)]+laws_t5_lhs = testSF1 (arr dup >>> (first (integral >>> arr (+3.0))))+laws_t5_rhs :: [(Double, Double)]+laws_t5_rhs = testSF1 (arr dup >>> (first integral >>> first (arr (+3.0))))++laws_t6_lhs :: [(Double, Double)]+laws_t6_lhs = testSF1 (arr dup >>> (first integral >>> arr (id *** (+3.0))))+laws_t6_rhs :: [(Double, Double)]+laws_t6_rhs = testSF1 (arr dup >>> (arr (id *** (+3.0)) >>> first integral))++laws_t7_lhs :: [Double]+laws_t7_lhs = testSF1 (arr dup >>> (first integral >>> arr fst))+laws_t7_rhs :: [Double]+laws_t7_rhs = testSF1 (arr dup >>> (arr fst >>> integral))++laws_t8_lhs :: [(Double, (Double, ()))]+laws_t8_lhs = testSF1 (arr (\x -> ((x,x),()))+ >>> (first (first integral) >>> arr assoc))+laws_t8_rhs :: [(Double, (Double, ()))]+laws_t8_rhs = testSF1 (arr (\x -> ((x,x),()))+ >>> (arr assoc >>> first integral))+++laws_trs =+ [ laws_t0_lhs ~= laws_t0_rhs,+ laws_t1_lhs ~= laws_t1_rhs,+ laws_t2_lhs ~= laws_t2_rhs,+ laws_t3_lhs ~= laws_t3_rhs,+ laws_t4_lhs ~= laws_t4_rhs,+ laws_t5_lhs ~= laws_t5_rhs,+ laws_t6_lhs ~= laws_t6_rhs,+ laws_t7_lhs ~= laws_t7_rhs,+ laws_t8_lhs ~= laws_t8_rhs+ ]++laws_tr = and laws_trs
+ tests/TestsLoop.hs view
@@ -0,0 +1,207 @@+{-# OPTIONS_GHC -fno-warn-tabs #-}+{- $Id: TestsLoop.hs,v 1.6 2003/11/10 21:28:58 antony Exp $+******************************************************************************+* Y A M P A *+* *+* Module: TestsLoop *+* Purpose: Test cases for loop *+* Authors: Antony Courtney and Henrik Nilsson *+* *+* Copyright (c) Yale University, 2003 *+* *+******************************************************************************+-}++module TestsLoop (loop_trs, loop_tr, loop_st0, loop_st0r,+ loop_st1, loop_st1r) where++import FRP.Yampa++import TestsCommon++------------------------------------------------------------------------------+-- Test cases for loop+------------------------------------------------------------------------------++loop_acc :: SF (Double, Double) (Double, Double)+loop_acc = arr (\(x, y)->(x+y, x+y))++loop_t0 :: [Double]+loop_t0 = testSF1 (loop (constant (42.0, 43.0)))+loop_t0r =+ [42.0, 42.0, 42.0, 42.0, 42.0, 42.0, 42.0, 42.0, 42.0, 42.0,+ 42.0, 42.0, 42.0, 42.0, 42.0, 42.0, 42.0, 42.0, 42.0, 42.0,+ 42.0, 42.0, 42.0, 42.0, 42.0]++loop_t1 :: [Double]+loop_t1 = testSF1 (loop identity)+loop_t1r =+ [0.0, 1.0, 2.0, 3.0, 4.0, 5.0, 6.0, 7.0, 8.0, 9.0,+ 10.0, 11.0, 12.0, 13.0, 14.0, 15.0, 16.0, 17.0, 18.0, 19.0,+ 20.0, 21.0, 22.0, 23.0, 24.0]++loop_t2 :: [Time]+loop_t2 = testSF1 (loop (first localTime))+loop_t2r =+ [0.0, 0.25, 0.5, 0.75, 1.0,+ 1.25, 1.5, 1.75, 2.0, 2.25,+ 2.5, 2.75, 3.0, 3.25, 3.5,+ 3.75, 4.0, 4.25, 4.5, 4.75,+ 5.0, 5.25, 5.5, 5.75, 6.0]++-- AC, 10-March-2002: I think this is the simplest test that will+-- fail with AltST.+loop_t3 :: [Time]+loop_t3 = testSF1 (loop (second (iPre 0)))+loop_t3r =+ [0.0, 1.0, 2.0, 3.0, 4.0,+ 5.0, 6.0, 7.0, 8.0, 9.0,+ 10.0, 11.0, 12.0, 13.0, 14.0,+ 15.0, 16.0, 17.0, 18.0, 19.0,+ 20.0, 21.0, 22.0, 23.0, 24.0]++loop_t4 :: [Double]+loop_t4 = testSF1 (loop (second (iPre 0) >>> loop_acc))+loop_t4r =+ [0.0, 1.0, 3.0, 6.0, 10.0,+ 15.0, 21.0, 28.0, 36.0, 45.0,+ 55.0, 66.0, 78.0, 91.0, 105.0,+ 120.0, 136.0, 153.0, 171.0, 190.0,+ 210.0, 231.0, 253.0, 276.0, 300.0]++loop_t5 :: [Double]+loop_t5 = testSF2 (loop (second (iPre 0) >>> loop_acc))+loop_t5r =+ [0.0, 0.0, 0.0, 0.0, 0.0,+ 1.0, 2.0, 3.0, 4.0, 5.0,+ 7.0, 9.0, 11.0, 13.0, 15.0,+ 18.0, 21.0, 24.0, 27.0, 30.0,+ 34.0, 38.0, 42.0, 46.0, 50.0]++loop_t6 :: [Double]+loop_t6 = testSF1 (loop (iPre (0,0) >>> first localTime >>> loop_acc))+loop_t6r =+ [0.0, 0.25, 0.75, 1.5, 2.5,+ 3.75, 5.25, 7.0, 9.0, 11.25,+ 13.75, 16.5, 19.5, 22.75, 26.25,+ 30.0, 34.0, 38.25, 42.75, 47.5,+ 52.5, 57.75, 63.25, 69.0, 75.0]++loop_t7 :: [Double]+loop_t7 = testSF1 (loop (loop_acc >>> second (iPre 0)))+loop_t7r = loop_t4r++loop_t8 :: [Double]+loop_t8 = testSF2 (loop (loop_acc >>> second (iPre 0)))+loop_t8r = loop_t5r++loop_t9 :: [Double]+loop_t9 = testSF1 (loop (first localTime >>> loop_acc >>> iPre (0,0)))+loop_t9r =+ [0.0, 0.0, 0.25, 0.75, 1.5,+ 2.5, 3.75, 5.25, 7.0, 9.0,+ 11.25, 13.75, 16.5, 19.5, 22.75,+ 26.25, 30.0, 34.0, 38.25, 42.75,+ 47.5, 52.5, 57.75, 63.25, 69.0]++loop_t10 :: [Double]+loop_t10 = testSF1 (loop (loop_acc >>> second (iPre 0) >>> identity))+loop_t10r = loop_t4r++loop_t11 :: [Double]+loop_t11 = testSF2 (loop (loop_acc >>> second (iPre 0) >>> identity))+loop_t11r = loop_t5r++loop_t12 :: [Double]+loop_t12 = testSF1 (loop (first localTime+ >>> loop_acc+ >>> iPre (0,0)+ >>> identity))+loop_t12r = loop_t9r++-- Computation of approximation to exp 0, exp 1, ..., exp 5 by integration.+-- Values as given by using exp directly:+-- 1.0, 2.71828, 7.38906, 20.0855, 54.5981, 148.413+loop_t13 :: [Double]+loop_t13 =+ let+ es = embed (loop (second integral >>> arr (\(_, x) -> (x + 1, x + 1))))+ (deltaEncode 0.001 (repeat ()))+ in+ [es!!0, es!!1000, es!!2000, es!!3000, es!!4000, es!!5000]+loop_t13r = [1.0,2.71692, 7.38167, 20.05544, 54.48911, 148.04276]++loop_t14 :: [Double]+loop_t14 =+ let+ es = embed (loop (arr (\(_, x) -> (x + 1, x + 1)) >>> second integral))+ (deltaEncode 0.001 (repeat ()))+ in+ [es!!0, es!!1000, es!!2000, es!!3000, es!!4000, es!!5000]+loop_t14r = loop_t13r++loop_t15 :: [Double]+loop_t15 =+ let+ es = embed (loop (arr (\(_, x) -> (x + 1, x + 1))+ >>> second integral+ >>> identity))+ (deltaEncode 0.001 (repeat ()))+ in+ [es!!0, es!!1000, es!!2000, es!!3000, es!!4000, es!!5000]+loop_t15r = loop_t13r++-- A generator for factorial: The least-fixed point of this function is+-- the factorial function.++factGen f n = if (n==0) then 1 else n*f(n-1)++-- Can we use loop to construct a fixed point?+loop_t16 :: [Int]+loop_t16 = testSF1 (loop $ arr (\ (_,f) -> (f 4,factGen f)))+loop_t16r =+ [24,24,24,24,24,24,24,24,24,24,24,24,24,24,24,24,24,24,24,24,24,24,24,24,24]++-- A simple loop test taken from MiniYampa:+-- This results in pulling on the fed-back output during evaluation, because+-- switch is strict in its input sample:+loop_t17 :: [Double]+loop_t17 = testSF1 (loop $ second $ (switch identity (const (arr fst))) >>> arr (\x -> (x,noEvent)) >>> (iPre (25, noEvent)))+loop_t17r =+ [0.0,1.0,2.0,3.0,4.0,5.0,6.0,7.0,8.0,9.0,10.0,11.0,12.0,13.0,14.0,15.0,+ 16.0,17.0,18.0,19.0,20.0,21.0,22.0,23.0,24.0]++loop_trs =+ [ loop_t0 ~= loop_t0r,+ loop_t1 ~= loop_t1r,+ loop_t2 ~= loop_t2r,+ loop_t3 ~= loop_t3r,+ loop_t4 ~= loop_t4r,+ loop_t5 ~= loop_t5r,+ loop_t6 ~= loop_t6r,+ loop_t7 ~= loop_t7r,+ loop_t8 ~= loop_t8r,+ loop_t9 ~= loop_t9r,+ loop_t10 ~= loop_t10r,+ loop_t11 ~= loop_t11r,+ loop_t12 ~= loop_t12r,+ loop_t13 ~= loop_t13r,+ loop_t14 ~= loop_t14r,+ loop_t15 ~= loop_t15r,+ loop_t16 ~= loop_t16r,+ loop_t17 ~= loop_t17r+ ]++loop_tr = and loop_trs++loop_st0 = testSFSpaceLeak 2000000+ (loop (second (iPre 0) >>> loop_acc))+loop_st0r = 9.999995e11++-- A simple loop test taken from MiniYampa:+-- This results in pulling on the fed-back output during evaluation, because+-- switch is strict in its input sample:+loop_st1 :: Double+loop_st1 = testSFSpaceLeak 2000000+ (loop $ second $ (switch identity (const (arr fst))) >>> arr (\x -> (x + x + x + x + x + x + x,noEvent)) >>> (iPre (25, noEvent)))+loop_st1r = 999999.5
+ tests/TestsLoopIntegral.hs view
@@ -0,0 +1,105 @@+{-# OPTIONS_GHC -fno-warn-tabs #-}+{- $Id: TestsLoopIntegral.hs,v 1.2 2003/11/10 21:28:58 antony Exp $+******************************************************************************+* A F R P *+* *+* Module: TestsLoopIntegral *+* Purpose: Test cases for loopIntegral *+* Authors: Antony Courtney and Henrik Nilsson *+* *+* Copyright (c) Yale University, 2003 *+* *+******************************************************************************+-}++module TestsLoopIntegral (loopIntegral_tr, loopIntegral_trs) where++import FRP.Yampa++import TestsCommon++------------------------------------------------------------------------------+-- Test cases for loopIntegral+------------------------------------------------------------------------------++-- Computation of approximation to exp 0, exp 1, ..., exp 5 by integration.+-- Values as given by using exp directly:+-- 1.0, 2.71828, 7.38906, 20.0855, 54.5981, 148.413+loopIntegral_t0 =+ let+ es = embed (loopIntegral (arr (\(_, x) -> (x + 1, x + 1))))+ (deltaEncode 0.001 (repeat ()))+ in+ [es!!0, es!!1000, es!!2000, es!!3000, es!!4000, es!!5000]+loopIntegral_t0r :: [Double]+loopIntegral_t0r = [1.0,2.71692,7.38167,20.05544,54.48911,148.04276]+++-- Test case with a time varying signal transformer inside the loop.+-- Starting at position 0 [m], accelerate by 1.0 [m/s^2] until position+-- exceeds 2.0 [m]. Then accelerate by -1.0 [m/s^2] until position gets+-- below 0.0 [m]. Then accelerate at 1.0 [m/s^2] again. And so on.++type Position = Double+type Velocity = Double+type Acceleration = Double++posCntrl :: SF b Position+posCntrl = loopIntegral posCntrlNR+ where+ posCntrlNR :: SF (b, Velocity) (Position, Acceleration)+ posCntrlNR =+ arr snd -- Get the velocity.+ >>> integral -- This integral gives us the position.+ >>> arr (\x -> (x,x))+ >>>+ (second $+ arr (\x -> (x,x))+ >>>+ (first $+ arr (>=2.0)+ >>> edge+ >>> (arr (fmap (const (constant (-1.0))))))+ >>>+ (second $+ arr (< 0.0)+ >>> edge+ >>> (arr (fmap (const (constant 1.0)))))+ >>> arr (\(e1,e2) -> e1 `lMerge` e2)+ >>> arr (\e -> ((), e))+ >>> rSwitch (constant 1.0))+++loopIntegral_t1 = take 250 (embed posCntrl (deltaEncode 0.1 (repeat ())))++-- Result only partially verified. But the sign of the acceleration changes+-- at roughly the right points.+loopIntegral_t1r :: [Double]+loopIntegral_t1r =+ [0.0,0.0,0.01,0.03,0.06,0.1,0.15,0.21,0.28,0.36,0.45,0.55,0.66,0.78,0.91,+ 1.05,1.2,1.36,1.53,1.71,1.9,2.1,2.31,2.51,2.7,2.88,3.05,3.21,3.36,3.5,+ 3.63,3.75,3.86,3.96,4.05,4.13,4.2,4.26,4.31,4.35,4.38,4.4,4.41,4.41,4.4,+ 4.38,4.35,4.31,4.26,4.2,4.13,4.05,3.96,3.86,3.75,3.63,3.5,3.36,3.21,3.05,+ 2.88,2.7,2.51,2.31,2.1,1.88,1.65,1.41,1.16,0.9,0.63,0.35,0.06,-0.24,+ -0.55,-0.85,-1.14,-1.42,-1.69,-1.95,-2.2,-2.44,-2.67,-2.89,-3.1,-3.3,+ -3.49,-3.67,-3.84,-4.0,-4.15,-4.29,-4.42,-4.54,-4.65,-4.75,-4.84,-4.92,+ -4.99,-5.05,-5.1,-5.14,-5.17,-5.19,-5.2,-5.2,-5.19,-5.17,-5.14,-5.1,+ -5.05,-4.99,-4.92,-4.84,-4.75,-4.65,-4.54,-4.42,-4.29,-4.15,-4.0,-3.84,+ -3.67,-3.49,-3.3,-3.1,-2.89,-2.67,-2.44,-2.2,-1.95,-1.69,-1.42,-1.14,+ -0.85,-0.55,-0.24,0.08,0.41,0.75,1.1,1.46,1.83,2.21,2.6,2.98,3.35,3.71,+ 4.06,4.4,4.73,5.05,5.36,5.66,5.95,6.23,6.5,6.76,7.01,7.25,7.48,7.7,7.91,+ 8.11,8.3,8.48,8.65,8.81,8.96,9.1,9.23,9.35,9.46,9.56,9.65,9.73,9.8,9.86,+ 9.91,9.95,9.98,10.0,10.01,10.01,10.0,9.98,9.95,9.91,9.86,9.8,9.73,9.65,+ 9.56,9.46,9.35,9.23,9.1,8.96,8.81,8.65,8.48,8.3,8.11,7.91,7.7,7.48,7.25,+ 7.01,6.76,6.5,6.23,5.95,5.66,5.36,5.05,4.73,4.4,4.06,3.71,3.35,2.98,2.6,+ 2.21,1.81,1.4,0.98,0.55,0.11,-0.34,-0.80,-1.25,-1.69,-2.12,-2.54,-2.95,+ -3.35,-3.74,-4.12,-4.49,-4.85,-5.2,-5.54,-5.87,-6.19,-6.5,-6.8,-7.09,+ -7.37,-7.64,-7.9]+++loopIntegral_trs =+ [ loopIntegral_t0 ~= loopIntegral_t0r,+ loopIntegral_t1 ~= loopIntegral_t1r+ ]++loopIntegral_tr = and loopIntegral_trs
+ tests/TestsLoopLaws.hs view
@@ -0,0 +1,110 @@+{-# OPTIONS_GHC -fno-warn-tabs #-}+{- $Id: TestsLoopLaws.hs,v 1.2 2003/11/10 21:28:58 antony Exp $+******************************************************************************+* Y A M P A *+* *+* Module: TestsLoopLaws *+* Purpose: Test cases based on the arrow laws for loop *+* Authors: Antony Courtney and Henrik Nilsson *+* *+* Copyright (c) Yale University, 2003 *+* *+******************************************************************************+-}++module TestsLoopLaws (looplaws_trs, looplaws_tr) where++import Data.Tuple(swap)++import FRP.Yampa++import TestsCommon++------------------------------------------------------------------------------+-- Test cases based on the arrow laws for loop+------------------------------------------------------------------------------++-- For a description of the laws, see Ross Paterson: Embedding a Class of+-- Domain-Specific Languages in a Functional Language.+-- Only a very rudimentary sanity check. Obviously not intended to "prove"+-- this implementation indeed do respect the laws.++simple_loop :: ((a,c) -> (b,c)) -> (a -> b)+simple_loop f a = b+ where+ (b, c) = f (a, c)+++-- Left tightening+looplaws_t0_f = second integral >>> arr swap+looplaws_t0_h :: Fractional a => SF a a+looplaws_t0_h = arr (+10.0)+looplaws_t0_lhs :: [Double]+looplaws_t0_lhs = testSF1 (loop (first looplaws_t0_h >>> looplaws_t0_f))+looplaws_t0_rhs :: [Double]+looplaws_t0_rhs = testSF1 (looplaws_t0_h >>> loop looplaws_t0_f)+++-- Right tightening+looplaws_t1_f = second integral >>> arr swap+looplaws_t1_h :: Fractional a => SF a a+looplaws_t1_h = arr (+10.0)+looplaws_t1_lhs :: [Double]+looplaws_t1_lhs = testSF1 (loop (looplaws_t1_f >>> first looplaws_t1_h))+looplaws_t1_rhs :: [Double]+looplaws_t1_rhs = testSF1 (loop looplaws_t1_f >>> looplaws_t1_h)+++-- Sliding+-- Used to work with only signature t2_f :: Fractional a -> SF a a+looplaws_t2_f :: SF (Double, Double) (Double, Double)+looplaws_t2_f = integral+looplaws_t2_k = id *** (+42.0)+looplaws_t2_lhs :: [Double]+looplaws_t2_lhs = testSF1 (loop (looplaws_t2_f >>> arr looplaws_t2_k))+looplaws_t2_rhs :: [Double]+looplaws_t2_rhs = testSF1 (loop (arr looplaws_t2_k >>> looplaws_t2_f))+++-- Vanishing+-- The lazy pattern matching (~) is necessary to avoid a black hole in the+-- RHS due to premature forcing of tuples. As far as I can tell, loop is+-- as lazy as it can be, and this problem could not have been solved by+-- "fixing" the loop definition.+looplaws_t3_f = second integral+ >>> first (arr swap)+ >>> arr (\ ~((a,b),c) -> ((a,c),b))+looplaws_t3_lhs :: [Double]+looplaws_t3_lhs = testSF1 (loop (loop looplaws_t3_f))+looplaws_t3_rhs :: [Double]+looplaws_t3_rhs = testSF1 (loop (arr assocInv >>> looplaws_t3_f >>> arr assoc))+++-- Superposing+looplaws_t4_f = second integral >>> arr swap+looplaws_t4_lhs :: [(Double,Double)]+looplaws_t4_lhs = testSF1 (arr dup >>> (second (loop looplaws_t4_f)))+looplaws_t4_rhs :: [(Double, Double)]+looplaws_t4_rhs = testSF1 (arr dup >>> (loop (arr assoc+ >>> second looplaws_t4_f+ >>> arr assocInv)))+++-- Extension+looplaws_t5_f = \(a,c) -> (take 5 c, a : c)+looplaws_t5_lhs :: [[Double]]+looplaws_t5_lhs = testSF1 (loop (arr looplaws_t5_f))+looplaws_t5_rhs :: [[Double]]+looplaws_t5_rhs = testSF1 (arr (simple_loop looplaws_t5_f))+++looplaws_trs =+ [ looplaws_t0_lhs ~= looplaws_t0_rhs,+ looplaws_t1_lhs ~= looplaws_t1_rhs,+ looplaws_t2_lhs ~= looplaws_t2_rhs,+ looplaws_t3_lhs ~= looplaws_t3_rhs,+ looplaws_t4_lhs ~= looplaws_t4_rhs,+ looplaws_t5_lhs ~= looplaws_t5_rhs+ ]++looplaws_tr = and looplaws_trs
+ tests/TestsLoopPre.hs view
@@ -0,0 +1,63 @@+{-# OPTIONS_GHC -fno-warn-tabs #-}+{- $Id: TestsLoopPre.hs,v 1.2 2003/11/10 21:28:58 antony Exp $+******************************************************************************+* Y A M P A *+* *+* Module: TestsLoopPre *+* Purpose: Test cases for loopPre *+* Authors: Antony Courtney and Henrik Nilsson *+* *+* Copyright (c) Yale University, 2003 *+* *+******************************************************************************+-}++module TestsLoopPre (loopPre_tr, loopPre_trs) where++import FRP.Yampa++import TestsCommon++------------------------------------------------------------------------------+-- Test cases for loopPre+------------------------------------------------------------------------------++loop_acc :: SF (Double, Double) (Double, Double)+loop_acc = arr (\(x, y)->(x+y, x+y))++-- This kind of test will fail for infinitesimal delay!+loopPre_t0 = testSF1 (loopPre 0 loop_acc)+loopPre_t0r =+ [0.0,1.0,3.0,6.0,10.0,15.0,21.0,28.0,36.0,45.0,55.0,66.0,78.0,91.0,+ 105.0,120.0,136.0,153.0,171.0,190.0,210.0,231.0,253.0,276.0,300.0]++loopPre_t1 = testSF2 (loopPre 0 loop_acc)+loopPre_t1r =+ [0.0,0.0,0.0,0.0,0.0,1.0,2.0,3.0,4.0,5.0,7.0,9.0,11.0,13.0,15.0,18.0,+ 21.0,24.0,27.0,30.0,34.0,38.0,42.0,46.0,50.0]++-- This kind of test will fail for infinitesimal delay!+loopPre_t2 = testSF1 (loopPre False (arr (dup . not . snd)))+loopPre_t2r =+ [True,False,True,False,True,False,True,False,True,False,True,False,+ True,False,True,False,True,False,True,False,True,False,True,False,True]++loopPre_t3 = testSF1 (loopPre 0 (first localTime))+loopPre_t3r =+ [0.0,0.25,0.5,0.75,1.0,1.25,1.5,1.75,2.0,2.25,2.5,2.75,3.0,3.25,3.5,3.75,+ 4.0,4.25,4.5,4.75,5.0,5.25,5.5,5.75,6.0]++loopPre_t4 = testSF1 (loopPre 0 (first localTime >>> loop_acc))+loopPre_t4r =+ [0.0,0.25,0.75,1.5,2.5,3.75,5.25,7.0,9.0,11.25,13.75,16.5,19.5,22.75,+ 26.25,30.0,34.0,38.25,42.75,47.5,52.5,57.75,63.25,69.0,75.0]++loopPre_trs =+ [ loopPre_t0 ~= loopPre_t0r,+ loopPre_t1 ~= loopPre_t1r,+ loopPre_t2 ~= loopPre_t2r,+ loopPre_t3 ~= loopPre_t3r,+ loopPre_t4 ~= loopPre_t4r+ ]++loopPre_tr = and loopPre_trs
+ tests/TestsPSwitch.hs view
@@ -0,0 +1,325 @@+{-# OPTIONS_GHC -fno-warn-tabs #-}+{- $Id: TestsPSwitch.hs,v 1.2 2003/11/10 21:28:58 antony Exp $+******************************************************************************+* Y A M P A *+* *+* Module: TestsPSwitch *+* Purpose: Test cases for pSwitchB and dpSwitchB *+* Authors: Antony Courtney and Henrik Nilsson *+* *+* Copyright (c) Yale University, 2003 *+* *+******************************************************************************+-}++module TestsPSwitch (+ pswitch_tr,+ pswitch_trs,+ pswitch_st0,+ pswitch_st0r,+ pswitch_st1,+ pswitch_st1r+) where++import Data.List (findIndex)++import FRP.Yampa++import TestsCommon++------------------------------------------------------------------------------+-- Test cases for pSwitchB and dpSwitchB+------------------------------------------------------------------------------++pswitch_inp1 = deltaEncode 0.1 [0.0, 0.5 ..]++whenFstGE :: Ord a => a -> c -> SF (a, b) (Event c)+whenFstGE a c = arr fst >>> arr (>= a) >>> edge >>> arr (`tag` c)++pswitch_t0 :: [[Double]]+pswitch_t0 = take 20 $ embed sf pswitch_inp1+ where+ sf =+ pSwitchB [] (whenFstGE 1.25 10.0) $ \sfs x ->+ pSwitchB (integral:sfs) (whenFstGE 3.75 10.0) $ \sfs x ->+ pSwitchB ((integral>>>arr(+x)):sfs)(whenFstGE 5.25 20.0) $ \sfs x->+ pSwitchB ((integral>>>arr(+x)):sfs)(whenFstGE 7.25 20.0) $ \sfs _->+ parB (take 2 sfs)++pswitch_t0r =+ [[], -- 0.0+ [], -- 0.5+ [], -- 1.0+ [0.0], -- 1.5+ [0.15], -- 2.0+ [0.35], -- 2.5+ [0.60], -- 3.0+ [0.90], -- 3.5+ [10.00, 1.25], -- 4.0+ [10.40, 1.65], -- 4.5+ [10.85, 2.10], -- 5.0+ [20.00, 11.35, 2.60], -- 5.5+ [20.55, 11.90, 3.15], -- 6.0+ [21.15, 12.50, 3.75], -- 6.5+ [21.80, 13.15, 4.40], -- 7.0+ [22.50, 13.85], -- 7.5+ [23.25, 14.60], -- 8.0+ [24.05, 15.40], -- 8.5+ [24.90, 16.25], -- 9.0+ [25.80, 17.15]] -- 9.5+++pswitch_t1 :: [[Double]]+pswitch_t1 = take 20 $ embed sf pswitch_inp1+ where+ sf =+ dpSwitchB [] (whenFstGE 1.25 10.0) $ \sfs x ->+ dpSwitchB (integral:sfs) (whenFstGE 3.75 10.0) $ \sfs x ->+ dpSwitchB ((integral>>>arr(+x)):sfs)(whenFstGE 5.25 20.0)$ \sfs x->+ dpSwitchB ((integral>>>arr(+x)):sfs)(whenFstGE 7.25 20.0)$ \sfs _->+ parB (take 2 sfs)+++pswitch_t1r =+ [[], -- 0.0+ [], -- 0.5+ [], -- 1.0+ [], -- 1.5+ [0.15], -- 2.0+ [0.35], -- 2.5+ [0.60], -- 3.0+ [0.90], -- 3.5+ [1.25], -- 4.0+ [10.40, 1.65], -- 4.5+ [10.85, 2.10], -- 5.0+ [11.35, 2.60], -- 5.5+ [20.55, 11.90, 3.15], -- 6.0+ [21.15, 12.50, 3.75], -- 6.5+ [21.80, 13.15, 4.40], -- 7.0+ [22.50, 13.85, 5.10], -- 7.5+ [23.25, 14.60], -- 8.0+ [24.05, 15.40], -- 8.5+ [24.90, 16.25], -- 9.0+ [25.80, 17.15]] -- 9.5+++pswitch_t2 :: [[Double]]+pswitch_t2 = take 20 $ embed sf pswitch_inp1+ where+ sf =+ pSwitchB [] (now 10.0) $ \sfs x ->+ pSwitchB (integral:sfs) (whenFstGE 3.75 10.0) $ \sfs x ->+ pSwitchB ((integral>>>arr(+x)):sfs)(whenFstGE 5.25 20.0) $ \sfs x->+ pSwitchB ((integral>>>arr(+x)):sfs)(now 20.0) $ \sfs _->+ parB (take 2 sfs)++pswitch_t2r =+ [[0.00], -- 0.0+ [0.00], -- 0.5+ [0.05], -- 1.0+ [0.15], -- 1.5+ [0.30], -- 2.0+ [0.50], -- 2.5+ [0.75], -- 3.0+ [1.05], -- 3.5+ [10.00, 1.40], -- 4.0+ [10.40, 1.80], -- 4.5+ [10.85, 2.25], -- 5.0+ [20.00, 11.35], -- 5.5+ [20.55, 11.90], -- 6.0+ [21.15, 12.50], -- 6.5+ [21.80, 13.15], -- 7.0+ [22.50, 13.85], -- 7.5+ [23.25, 14.60], -- 8.0+ [24.05, 15.40], -- 8.5+ [24.90, 16.25], -- 9.0+ [25.80, 17.15]] -- 9.5+++pswitch_t3 :: [[Double]]+pswitch_t3 = take 20 $ embed sf pswitch_inp1+ where+ sf =+ dpSwitchB [] (now 10.0) $ \sfs x ->+ dpSwitchB (integral:sfs) (whenFstGE 3.75 10.0) $ \sfs x ->+ dpSwitchB ((integral>>>arr(+x)):sfs)(whenFstGE 5.25 20.0)$ \sfs x->+ dpSwitchB ((integral>>>arr(+x)):sfs) (now 20.0) $ \sfs _->+ parB (take 2 sfs)++pswitch_t3r =+ [[], -- 0.0+ [0.00], -- 0.5+ [0.05], -- 1.0+ [0.15], -- 1.5+ [0.30], -- 2.0+ [0.50], -- 2.5+ [0.75], -- 3.0+ [1.05], -- 3.5+ [1.40], -- 4.0+ [10.40, 1.80], -- 4.5+ [10.85, 2.25], -- 5.0+ [11.35, 2.75], -- 5.5+ [20.55, 11.90], -- 6.0+ [21.15, 12.50], -- 6.5+ [21.80, 13.15], -- 7.0+ [22.50, 13.85], -- 7.5+ [23.25, 14.60], -- 8.0+ [24.05, 15.40], -- 8.5+ [24.90, 16.25], -- 9.0+ [25.80, 17.15]] -- 9.5+++-- Starts three "ramps" with different phase. As soon as one exceeds a+-- threshold, it's restarted, while the others are left alone. The+-- observaton of the output is done via the loop (rather than the directly+-- from the outputs of the signal functions in the collection), thus the+-- use of a delayed switch is essential.++pswitch_ramp :: Double -> SF a Double+pswitch_ramp phase = constant 2.0 >>> integral >>> arr (+phase)++-- We assume that only one signal function will reach the limit at a time.+pswitch_limit :: Double -> SF ((a, [Double]), b) (Event Int)+pswitch_limit x = arr (snd . fst) >>> arr (findIndex (>=x)) >>> edgeJust++pswitch_t4 :: [[Double]]+pswitch_t4 = take 30 $ embed (loop sf) (deltaEncode 0.1 (repeat ()))+ where+ sf :: SF (a, [Double]) ([Double],[Double])+ sf = dpSwitchB [pswitch_ramp 0.0, pswitch_ramp 1.0, pswitch_ramp 2.0]+ (pswitch_limit 2.99)+ pswitch_t4rec+ >>> arr dup++pswitch_t4rec :: [SF (a, [Double]) Double]+ -> Int+ -> SF (a, [Double]) [Double]+pswitch_t4rec sfs n =+ dpSwitchB (take n sfs ++ [pswitch_ramp 0.0] ++ drop (n+1) sfs)+ (pswitch_limit 2.99)+ pswitch_t4rec++pswitch_t4r =+ [[0.0, 1.0, 2.0],+ [0.2, 1.2, 2.2],+ [0.4, 1.4, 2.4],+ [0.6, 1.6, 2.6],+ [0.8, 1.8, 2.8],+ [1.0, 2.0, 3.0],+ [1.2, 2.2, 0.2],+ [1.4, 2.4, 0.4],+ [1.6, 2.6, 0.6],+ [1.8, 2.8, 0.8],+ [2.0, 3.0, 1.0],+ [2.2, 0.2, 1.2],+ [2.4, 0.4, 1.4],+ [2.6, 0.6, 1.6],+ [2.8, 0.8, 1.8],+ [3.0, 1.0, 2.0],+ [0.2, 1.2, 2.2],+ [0.4, 1.4, 2.4],+ [0.6, 1.6, 2.6],+ [0.8, 1.8, 2.8],+ [1.0, 2.0, 3.0],+ [1.2, 2.2, 0.2],+ [1.4, 2.4, 0.4],+ [1.6, 2.6, 0.6],+ [1.8, 2.8, 0.8],+ [2.0, 3.0, 1.0],+ [2.2, 0.2, 1.2],+ [2.4, 0.4, 1.4],+ [2.6, 0.6, 1.6],+ [2.8, 0.8, 1.8]]+++-- Variation of the test above, with direct observation (not via loop) and+-- immediate switch.++-- We assume that only one signal function will reach the limit at a time.+pswitch_limit2 :: Double -> SF (a, [Double]) (Event Int)+pswitch_limit2 x = arr snd >>> arr (findIndex (>=x)) >>> edgeJust++pswitch_t5 :: [([Double], Double)]+pswitch_t5 = take 30 $ embed (loop sf) (deltaEncode 0.1 (repeat ()))+ where+ sf :: SF (a, [Double]) (([Double], Double), [Double])+ sf = ((pSwitchB [pswitch_ramp 0.0, pswitch_ramp 1.0, pswitch_ramp 2.0]+ (pswitch_limit2 2.99)+ pswitch_t5rec)+ &&& (arr snd >>> arr sum))+ >>> arr (\(xs, y) -> ((xs, y), xs))++pswitch_t5rec :: [SF (a, [Double]) Double]+ -> Int+ -> SF (a, [Double]) [Double]+pswitch_t5rec sfs n =+ pSwitchB (take n sfs ++ [pswitch_ramp 0.0] ++ drop (n+1) sfs)+ (pswitch_limit2 2.99)+ pswitch_t5rec++pswitch_t5r =+ [([0.0, 1.0, 2.0], 3.0),+ ([0.2, 1.2, 2.2], 3.6),+ ([0.4, 1.4, 2.4], 4.2),+ ([0.6, 1.6, 2.6], 4.8),+ ([0.8, 1.8, 2.8], 5.4),+ ([1.0, 2.0, 0.0], 3.0),+ ([1.2, 2.2, 0.2], 3.6),+ ([1.4, 2.4, 0.4], 4.2),+ ([1.6, 2.6, 0.6], 4.8),+ ([1.8, 2.8, 0.8], 5.4),+ ([2.0, 0.0, 1.0], 3.0),+ ([2.2, 0.2, 1.2], 3.6),+ ([2.4, 0.4, 1.4], 4.2),+ ([2.6, 0.6, 1.6], 4.8),+ ([2.8, 0.8, 1.8], 5.4),+ ([0.0, 1.0, 2.0], 3.0),+ ([0.2, 1.2, 2.2], 3.6),+ ([0.4, 1.4, 2.4], 4.2),+ ([0.6, 1.6, 2.6], 4.8),+ ([0.8, 1.8, 2.8], 5.4),+ ([1.0, 2.0, 0.0], 3.0),+ ([1.2, 2.2, 0.2], 3.6),+ ([1.4, 2.4, 0.4], 4.2),+ ([1.6, 2.6, 0.6], 4.8),+ ([1.8, 2.8, 0.8], 5.4),+ ([2.0, 0.0, 1.0], 3.0),+ ([2.2, 0.2, 1.2], 3.6),+ ([2.4, 0.4, 1.4], 4.2),+ ([2.6, 0.6, 1.6], 4.8),+ ([2.8, 0.8, 1.8], 5.4)]+++pswitch_trs =+ [ pswitch_t0 ~= pswitch_t0r,+ pswitch_t1 ~= pswitch_t1r,+ pswitch_t2 ~= pswitch_t2r,+ pswitch_t3 ~= pswitch_t3r,+ pswitch_t4 ~= pswitch_t4r,+ pswitch_t5 ~= pswitch_t5r+ ]++pswitch_tr = and pswitch_trs+++pswitch_st0 = testSFSpaceLeak 1000000 (loop sf)+ where+ sf :: SF (a, [Double]) ([Double],[Double])+ sf = dpSwitchB [pswitch_ramp 0.0, pswitch_ramp 1.0, pswitch_ramp 2.0]+ (pswitch_limit 2.99)+ pswitch_t4rec+ >>> arr dup++pswitch_st0r = [1.5,2.5,0.5]+++pswitch_st1 = testSFSpaceLeak 1000000 (loop sf)+ where+ sf :: SF (a, [Double]) (([Double], Double), [Double])+ sf = ((pSwitchB [pswitch_ramp 0.0, pswitch_ramp 1.0, pswitch_ramp 2.0]+ (pswitch_limit2 2.99)+ pswitch_t5rec)+ &&& (arr snd >>> arr sum))+ >>> arr (\(xs, y) -> ((xs, y), xs))++pswitch_st1r = ([1.5,2.5,0.5],4.5)
+ tests/TestsPre.hs view
@@ -0,0 +1,209 @@+{-# OPTIONS_GHC -fno-warn-tabs #-}+{- $Id: TestsDelay.hs,v 1.2 2003/11/10 21:28:58 antony Exp $+******************************************************************************+* Y A M P A *+* *+* Module: TestsPre *+* Purpose: Test cases for pre and (derived) combinators *+* that (semantically) involves a pre. *+* Authors: Antony Courtney and Henrik Nilsson *+* *+* Copyright (c) Yale University, 2003 *+* Copyright (c) University of Nottingham, 2005 *+* *+******************************************************************************+-}++module TestsPre (pre_tr, pre_trs) where++import FRP.Yampa++import TestsCommon++------------------------------------------------------------------------------+-- Test cases for pre and related combinators+------------------------------------------------------------------------------++pre_t0 = testSF1 (iPre 17)+pre_t0r =+ [17.0,0.0,1.0,2.0,3.0,4.0,5.0,6.0,7.0,8.0,9.0,10.0,11.0,12.0,13.0,14.0,+ 15.0,16.0,17.0,18.0,19.0,20.0,21.0,22.0,23.0]++pre_t1 = testSF2 (iPre 17)+pre_t1r =+ [17.0,0.0,0.0,0.0,0.0,0.0,1.0,1.0,1.0,1.0,1.0,2.0,2.0,2.0,2.0,2.0,+ 3.0,3.0,3.0,3.0,3.0,4.0,4.0,4.0,4.0]++pre_t2 = testSF1 (time+ >>> arr (\t -> sin (0.5 * t * pi + pi))+ >>> loop (arr (\(x1,x2) -> let x' = max x1 x2 in (x',x'))+ >>> second (iPre 0.0)))++pre_t2r =+ take 25+ (let xs = [ sin (0.5 * t * pi + pi) | t <- [0.0, 0.25 ..] ]+ in tail (scanl max 0 xs))+++-- This is a (somewhat strange) way of doing a counter that+-- stops after reaching a threshold. Note that the ingoing event+-- is *control dependent* on the output of the counter, so+-- "dHold" really has to have the capability of delivering an+-- output without looking at the current input at all.+pre_t3, pre_t3r :: [Int]+pre_t3 = take 50 (embed sf (deltaEncode 0.25 (repeat ())))+ where+ sf = repeatedly 1.0 ()+ >>> (loop $+ arr (\(e,c) -> (e `tag` (c + 1)) `gate` (c < 10))+ >>> dHold 0+ >>> arr dup)+pre_t3r = [0,0,0,0, -- 0s+ 0,1,1,1, -- 1s+ 1,2,2,2, -- 2s+ 2,3,3,3, -- 3s+ 3,4,4,4, -- 4s+ 4,5,5,5, -- 5s+ 5,6,6,6, -- 6s+ 6,7,7,7, -- 7s+ 7,8,8,8, -- 8s+ 8,9,9,9, -- 9s+ 9,10,10,10, -- 10s+ 10,10,10,10, -- 11s+ 10,10] -- 12s++-- Version of the above that tests that thigs still work OK also if+-- there is an initial event.+pre_t4, pre_t4r :: [Int]+pre_t4 = take 50 (embed sf (deltaEncode 0.25 (repeat ())))+ where+ sf = (now () &&& repeatedly 1.0 ()) >>> arr (uncurry lMerge)+ >>> (loop $+ arr (\(e,c) -> (e `tag` (c + 1)) `gate` (c < 10))+ >>> dHold 0+ >>> arr dup)+pre_t4r = [0,1,1,1, -- 0s+ 1,2,2,2, -- 1s+ 2,3,3,3, -- 2s+ 3,4,4,4, -- 3s+ 4,5,5,5, -- 4s+ 5,6,6,6, -- 5s+ 6,7,7,7, -- 6s+ 7,8,8,8, -- 7s+ 8,9,9,9, -- 8s+ 9,10,10,10, -- 9s+ 10,10,10,10, -- 10s+ 10,10,10,10, -- 11s+ 10,10] -- 12s+++-- Similar test to "pre_t3" above but for dAccumHold.+pre_t5, pre_t5r :: [Int]+pre_t5 = take 50 (embed sf (deltaEncode 0.25 (repeat ())))+ where+ sf = repeatedly 1.0 ()+ >>> (loop $+ arr (\(e,c) -> (e `tag` (+1)) `gate` (c < 10))+ >>> dAccumHold 0+ >>> arr dup)+pre_t5r = [0,0,0,0, -- 0s+ 0,1,1,1, -- 1s+ 1,2,2,2, -- 2s+ 2,3,3,3, -- 3s+ 3,4,4,4, -- 4s+ 4,5,5,5, -- 5s+ 5,6,6,6, -- 6s+ 6,7,7,7, -- 7s+ 7,8,8,8, -- 8s+ 8,9,9,9, -- 9s+ 9,10,10,10, -- 10s+ 10,10,10,10, -- 11s+ 10,10] -- 12s+++-- Similar test to "pre_t4" above but for dAccumHold.+pre_t6, pre_t6r :: [Int]+pre_t6 = take 50 (embed sf (deltaEncode 0.25 (repeat ())))+ where+ sf = (now () &&& repeatedly 1.0 ()) >>> arr (uncurry lMerge)+ >>> (loop $+ arr (\(e,c) -> (e `tag` (+1)) `gate` (c < 10))+ >>> dAccumHold 0+ >>> arr dup)+pre_t6r = [0,1,1,1, -- 0s+ 1,2,2,2, -- 1s+ 2,3,3,3, -- 2s+ 3,4,4,4, -- 3s+ 4,5,5,5, -- 4s+ 5,6,6,6, -- 5s+ 6,7,7,7, -- 6s+ 7,8,8,8, -- 7s+ 8,9,9,9, -- 8s+ 9,10,10,10, -- 9s+ 10,10,10,10, -- 10s+ 10,10,10,10, -- 11s+ 10,10] -- 12s+++-- Similar test to "pre_t3" above but for dAccumHoldBy.+pre_t7, pre_t7r :: [Int]+pre_t7 = take 50 (embed sf (deltaEncode 0.25 (repeat ())))+ where+ sf = repeatedly 1.0 ()+ >>> (loop $+ arr (\(e,c) -> e `gate` (c < 10))+ >>> dAccumHoldBy (\c _ -> c + 1) 0+ >>> arr dup)+pre_t7r = [0,0,0,0, -- 0s+ 0,1,1,1, -- 1s+ 1,2,2,2, -- 2s+ 2,3,3,3, -- 3s+ 3,4,4,4, -- 4s+ 4,5,5,5, -- 5s+ 5,6,6,6, -- 6s+ 6,7,7,7, -- 7s+ 7,8,8,8, -- 8s+ 8,9,9,9, -- 9s+ 9,10,10,10, -- 10s+ 10,10,10,10, -- 11s+ 10,10] -- 12s+++-- Similar test to "pre_t4" above but for dAccumHoldBy.+pre_t8, pre_t8r :: [Int]+pre_t8 = take 50 (embed sf (deltaEncode 0.25 (repeat ())))+ where+ sf = (now () &&& repeatedly 1.0 ()) >>> arr (uncurry lMerge)+ >>> (loop $+ arr (\(e,c) -> e `gate` (c < 10))+ >>> dAccumHoldBy (\c _ -> c + 1) 0+ >>> arr dup)+pre_t8r = [0,1,1,1, -- 0s+ 1,2,2,2, -- 1s+ 2,3,3,3, -- 2s+ 3,4,4,4, -- 3s+ 4,5,5,5, -- 4s+ 5,6,6,6, -- 5s+ 6,7,7,7, -- 6s+ 7,8,8,8, -- 7s+ 8,9,9,9, -- 8s+ 9,10,10,10, -- 9s+ 10,10,10,10, -- 10s+ 10,10,10,10, -- 11s+ 10,10] -- 12s++++pre_trs =+ [ pre_t0 ~= pre_t0r,+ pre_t1 ~= pre_t1r,+ pre_t2 ~= pre_t2r,+ pre_t3 == pre_t3r,+ pre_t4 == pre_t4r,+ pre_t5 == pre_t5r,+ pre_t6 == pre_t6r,+ pre_t7 == pre_t7r,+ pre_t8 == pre_t8r+ ]++pre_tr = and pre_trs
+ tests/TestsRPSwitch.hs view
@@ -0,0 +1,246 @@+{-# OPTIONS_GHC -fno-warn-tabs #-}+{- $Id: TestsRPSwitch.hs,v 1.2 2003/11/10 21:28:58 antony Exp $+******************************************************************************+* Y A M P A *+* *+* Module: TestsRPSwitch *+* Purpose: Test cases for rpSwitchB and drpSwitchB *+* Authors: Antony Courtney and Henrik Nilsson *+* *+* Copyright (c) Yale University, 2003 *+* *+******************************************************************************+-}++module TestsRPSwitch (+ rpswitch_tr,+ rpswitch_trs,+ rpswitch_st0,+ rpswitch_st0r+) where++import Data.Maybe (fromJust)+import Data.List (findIndex)++import FRP.Yampa++import TestsCommon++------------------------------------------------------------------------------+-- Test cases for rpSwitchB and drpSwitchB+------------------------------------------------------------------------------++rpswitch_inp1 = (fromJust (head delta_inp), zip (repeat 1.0) (tail delta_inp))+ where+ delta_inp =+ [Just (1.0, NoEvent), Nothing, Nothing,+ Just (2.0, Event (integral:)), Just (3.0, NoEvent), Nothing,+ Just (4.0, NoEvent), Nothing, Nothing,+ Just (5.0, Event ((integral >>> arr (+100.0)):)),+ Just (6.0, NoEvent), Nothing,+ Just (7.0, NoEvent), Nothing, Nothing,+ Just (8.0, Event tail), Just (9.0, NoEvent), Nothing]+ ++ repeat Nothing+++-- This input contains exaples of "continuos switching", i.e. the same+-- switching event ocurring during a a few contiguous time steps.+-- It also starts with an immediate switch.+rpswitch_inp2 = (fromJust (head delta_inp), zip (repeat 1.0) (tail delta_inp))+ where+ delta_inp =+ [Just (1.0, Event (integral:)),+ Just (1.0, NoEvent), Nothing,+ Just (2.0, Event ((integral >>> arr(+100.0)):)), Nothing, Nothing,+ Just (3.0, Event ((integral >>> arr(+200.0)):)), Nothing, Nothing,+ Just (4.0, NoEvent), Nothing, Nothing,+ Just (5.0, Event ((arr (*3)):)),+ Just (5.0, NoEvent), Nothing,+ Just (6.0, Event tail), Just (7.0, Event ((arr (*7)):)),+ Just (8.0, Event (take 2)),+ Just (9.0, NoEvent), Nothing]+ ++ repeat Nothing+++rpswitch_t0 :: [[Double]]+rpswitch_t0 = take 20 $ embed (rpSwitchB []) rpswitch_inp1++rpswitch_t0r =+ [[], -- 0 s+ [], -- 1 s+ [], -- 2 s+ [0.0], -- 3 s+ [2.0], -- 4 s+ [5.0], -- 5 s+ [8.0], -- 6 s+ [12.0], -- 7 s+ [16.0], -- 8 s+ [100.0, 20.0], -- 9 s+ [105.0, 25.0], -- 10 s+ [111.0, 31.0], -- 11 s+ [117.0, 37.0], -- 12 s+ [124.0, 44.0], -- 13 s+ [131.0, 51.0], -- 14 s+ [58.0], -- 15 s+ [66.0], -- 16 s+ [75.0], -- 17 s+ [84.0], -- 18 s+ [93.0]] -- 19 s+++rpswitch_t1 :: [[Double]]+rpswitch_t1 = take 20 $ embed (drpSwitchB []) rpswitch_inp1++rpswitch_t1r =+ [[], -- 0 s+ [], -- 1 s+ [], -- 2 s+ [], -- 3 s+ [2.0], -- 4 s+ [5.0], -- 5 s+ [8.0], -- 6 s+ [12.0], -- 7 s+ [16.0], -- 8 s+ [20.0] , -- 9 s+ [105.0, 25.0], -- 10 s+ [111.0, 31.0], -- 11 s+ [117.0, 37.0], -- 12 s+ [124.0, 44.0], -- 13 s+ [131.0, 51.0], -- 14 s+ [138.0, 58.0], -- 15 s+ [66.0], -- 16 s+ [75.0], -- 17 s+ [84.0], -- 18 s+ [93.0]] -- 19 s+++rpswitch_t2 :: [[Double]]+rpswitch_t2 = take 20 $ embed (rpSwitchB []) rpswitch_inp2++rpswitch_t2r =+ [[0.0], -- 0 s+ [1.0], -- 1 s+ [2.0], -- 2 s+ [100.0, 3.0], -- 3 s+ [100.0, 102.0, 5.0], -- 4 s+ [100.0, 102.0, 104.0, 7.0], -- 5 s+ [200.0, 102.0, 104.0, 106.0, 9.0], -- 6 s+ [200.0, 203.0, 105.0, 107.0, 109.0, 12.0], -- 7 s+ [200.0, 203.0, 206.0, 108.0, 110.0, 112.0, 15.0], -- 8 s+ [203.0, 206.0, 209.0, 111.0, 113.0, 115.0, 18.0], -- 9 s+ [207.0, 210.0, 213.0, 115.0, 117.0, 119.0, 22.0], -- 10 s+ [211.0, 214.0, 217.0, 119.0, 121.0, 123.0, 26.0], -- 11 s+ [15.0, 215.0, 218.0, 221.0, 123.0, 125.0, 127.0, 30.0], -- 12 s+ [15.0, 220.0, 223.0, 226.0, 128.0, 130.0, 132.0, 35.0], -- 13 s+ [15.0, 225.0, 228.0, 231.0, 133.0, 135.0, 137.0, 40.0], -- 14 s+ [230.0, 233.0, 236.0, 138.0, 140.0, 142.0, 45.0], -- 15 s+ [49.0, 236.0, 239.0, 242.0, 144.0, 146.0, 148.0, 51.0], -- 16 s+ [56.0, 243.0], -- 17 s+ [63.0, 251.0], -- 18 s+ [63.0, 260.0]] -- 19 s+++rpswitch_t3 :: [[Double]]+rpswitch_t3 = take 20 $ embed (drpSwitchB []) rpswitch_inp2++rpswitch_t3r =+ [[], -- 0 s+ [1.0], -- 1 s+ [2.0], -- 2 s+ [3.0], -- 3 s+ [102.0, 5.0], -- 4 s+ [102.0, 104.0, 7.0], -- 5 s+ [102.0, 104.0, 106.0, 9.0], -- 6 s+ [203.0, 105.0, 107.0, 109.0, 12.0], -- 7 s+ [203.0, 206.0, 108.0, 110.0, 112.0, 15.0], -- 8 s+ [203.0, 206.0, 209.0, 111.0, 113.0, 115.0, 18.0], -- 9 s+ [207.0, 210.0, 213.0, 115.0, 117.0, 119.0, 22.0], -- 10 s+ [211.0, 214.0, 217.0, 119.0, 121.0, 123.0, 26.0], -- 11 s+ [215.0, 218.0, 221.0, 123.0, 125.0, 127.0, 30.0], -- 12 s+ [15.0, 220.0, 223.0, 226.0, 128.0, 130.0, 132.0, 35.0], -- 13 s+ [15.0, 225.0, 228.0, 231.0, 133.0, 135.0, 137.0, 40.0], -- 14 s+ [18.0, 230.0, 233.0, 236.0, 138.0, 140.0, 142.0, 45.0], -- 15 s+ [236.0, 239.0, 242.0, 144.0, 146.0, 148.0, 51.0], -- 16 s+ [56.0, 243.0, 246.0, 249.0, 151.0, 153.0, 155.0, 58.0], -- 17 s+ [63.0, 251.0], -- 18 s+ [63.0, 260.0]] -- 19 s+++-- Starts three "ramps" with different phase. As soon as one exceeds a+-- threshold, it's restarted, while the others are left alone. The observaton+-- of the output is done via a loop, thus the use of a delayed switch is+-- essential.++rpswitch_ramp :: Double -> SF a Double+rpswitch_ramp phase = constant 2.0 >>> integral >>> arr (+phase)++-- We assume that only one signal function will reach the limit at a time.+rpswitch_limit :: Double -> SF [Double] (Event ([SF a Double]->[SF a Double]))+rpswitch_limit x = arr (findIndex (>=x)) >>> edgeJust >>> arr (fmap restart)+ where+ restart n = \sfs -> take n sfs ++ [rpswitch_ramp 0.0] ++ drop (n+1) sfs++rpswitch_t4 :: [[Double]]+rpswitch_t4 = take 30 $ embed (loop sf) (deltaEncode 0.1 (repeat ()))+ where+ sf :: SF (a, [Double]) ([Double],[Double])+ sf = (second (rpswitch_limit 2.99)+ >>> drpSwitchB [rpswitch_ramp 0.0,+ rpswitch_ramp 1.0,+ rpswitch_ramp 2.0])+ >>> arr dup++rpswitch_t4r =+ [[0.0, 1.0, 2.0],+ [0.2, 1.2, 2.2],+ [0.4, 1.4, 2.4],+ [0.6, 1.6, 2.6],+ [0.8, 1.8, 2.8],+ [1.0, 2.0, 3.0],+ [1.2, 2.2, 0.2],+ [1.4, 2.4, 0.4],+ [1.6, 2.6, 0.6],+ [1.8, 2.8, 0.8],+ [2.0, 3.0, 1.0],+ [2.2, 0.2, 1.2],+ [2.4, 0.4, 1.4],+ [2.6, 0.6, 1.6],+ [2.8, 0.8, 1.8],+ [3.0, 1.0, 2.0],+ [0.2, 1.2, 2.2],+ [0.4, 1.4, 2.4],+ [0.6, 1.6, 2.6],+ [0.8, 1.8, 2.8],+ [1.0, 2.0, 3.0],+ [1.2, 2.2, 0.2],+ [1.4, 2.4, 0.4],+ [1.6, 2.6, 0.6],+ [1.8, 2.8, 0.8],+ [2.0, 3.0, 1.0],+ [2.2, 0.2, 1.2],+ [2.4, 0.4, 1.4],+ [2.6, 0.6, 1.6],+ [2.8, 0.8, 1.8]]+++rpswitch_trs =+ [ rpswitch_t0 ~= rpswitch_t0r,+ rpswitch_t1 ~= rpswitch_t1r,+ rpswitch_t2 ~= rpswitch_t2r,+ rpswitch_t3 ~= rpswitch_t3r,+ rpswitch_t4 ~= rpswitch_t4r+ ]++rpswitch_tr = and rpswitch_trs+++rpswitch_st0 = testSFSpaceLeak 1000000 (loop sf)+ where+ sf :: SF (a, [Double]) ([Double],[Double])+ sf = (second (rpswitch_limit 2.99)+ >>> drpSwitchB [rpswitch_ramp 0.0,+ rpswitch_ramp 1.0,+ rpswitch_ramp 2.0])+ >>> arr dup++rpswitch_st0r = [1.5,2.5,0.5]
+ tests/TestsRSwitch.hs view
@@ -0,0 +1,144 @@+{-# OPTIONS_GHC -fno-warn-tabs #-}+{- $Id: TestsRSwitch.hs,v 1.2 2003/11/10 21:28:58 antony Exp $+******************************************************************************+* Y A M P A *+* *+* Module: TestsRSwitch *+* Purpose: Test cases for rSwitch and drSwitch *+* Authors: Antony Courtney and Henrik Nilsson *+* *+* Copyright (c) Yale University, 2003 *+* *+******************************************************************************+-}++module TestsRSwitch (+ rswitch_tr,+ rswitch_trs,+ rswitch_st0,+ rswitch_st0r+) where++import Data.Maybe (fromJust)++import FRP.Yampa++import TestsCommon++------------------------------------------------------------------------------+-- Test cases for rSwitch and drSwitch+------------------------------------------------------------------------------++rswitch_inp1 = (fromJust (head delta_inp), zip (repeat 1.0) (tail delta_inp))+ where+ delta_inp =+ [Just (1.0, NoEvent), Nothing, Nothing,+ Just (2.0, Event (arr (*3))), Just (3.0, NoEvent), Nothing,+ Just (4.0, NoEvent), Nothing, Nothing,+ Just (5.0, Event integral),+ Just (6.0, NoEvent), Nothing,+ Just (7.0, NoEvent), Nothing, Nothing,+ Just (8.0, Event (arr (*7))), Just (9.0, NoEvent), Nothing]+ ++ repeat Nothing+++-- This input contains exaples of "continuos switching", i.e. the same+-- switching event ocurring during a a few contiguous time steps.+-- It also starts with an immediate switch.+rswitch_inp2 = (fromJust (head delta_inp), zip (repeat 1.0) (tail delta_inp))+ where+ delta_inp =+ [Just (1.0, Event integral),+ Just (1.0, NoEvent), Nothing,+ Just (2.0, Event (arr (*2))), Nothing, Nothing,+ Just (3.0, Event integral), Nothing, Nothing,+ Just (4.0, NoEvent), Nothing, Nothing,+ Just (5.0, Event integral),+ Just (5.0, NoEvent), Nothing,+ Just (6.0, Event (arr (*3))), Just (7.0, Event (arr (*4))),+ Just (8.0, Event integral),+ Just (9.0, NoEvent), Nothing]+ ++ repeat Nothing+++rswitch_t0 = take 20 $ embed (rSwitch (arr (+3))) rswitch_inp1++-- Integration using rectangle rule assumed.+rswitch_t0r :: [Double]+rswitch_t0r =+ [4.0, 4.0, 4.0, 6.0, 9.0,+ 9.0, 12.0, 12.0, 12.0, 0.0,+ 5.0, 11.0, 17.0, 24.0, 31.0,+ 56.0, 63.0, 63.0, 63.0, 63.0]+++rswitch_t1 = take 20 $ embed (rSwitch integral) rswitch_inp1++-- Integration using rectangle rule assumed.+rswitch_t1r :: [Double]+rswitch_t1r =+ [0.0, 1.0, 2.0, 6.0, 9.0,+ 9.0, 12.0, 12.0, 12.0, 0.0,+ 5.0, 11.0, 17.0, 24.0, 31.0,+ 56.0, 63.0, 63.0, 63.0, 63.0]++rswitch_t2 = take 20 $ embed (rSwitch (arr (+100))) rswitch_inp2++-- Integration using rectangle rule assumed.+rswitch_t2r :: [Double]+rswitch_t2r =+ [0.0, 1.0, 2.0, 4.0, 4.0,+ 4.0, 0.0, 0.0, 0.0, 3.0,+ 7.0, 11.0, 0.0, 5.0, 10.0,+ 18.0, 28.0, 0.0, 8.0, 17.0]+++rswitch_t3 = take 20 $ embed (drSwitch (arr (+100))) rswitch_inp2++-- Integration using rectangle rule assumed.+rswitch_t3r :: [Double]+rswitch_t3r =+ [101.0, 1.0, 2.0, 3.0, 4.0,+ 4.0, 6.0, 3.0, 3.0, 3.0,+ 7.0, 11.0, 15.0, 5.0, 10.0,+ 15.0, 21.0, 32.0, 8.0, 17.0]+++rswitch_sawTooth :: SF a Double+rswitch_sawTooth =+ loop (second (arr (>=5.0)+ >>> edge+ >>> arr (`tag` ramp))+ >>> drSwitch ramp+ >>> arr dup)+ where+ ramp :: SF a Double+ ramp = constant 1.0 >>> integral++rswitch_inp3 = deltaEncode 0.5 (repeat 0.0)++rswitch_t4 = take 40 $ embed rswitch_sawTooth rswitch_inp3++rswitch_t4r =+ [0.0, 0.5, 1.0, 1.5, 2.0,+ 2.5, 3.0, 3.5, 4.0, 4.5,+ 5.0, 0.5, 1.0, 1.5, 2.0,+ 2.5, 3.0, 3.5, 4.0, 4.5,+ 5.0, 0.5, 1.0, 1.5, 2.0,+ 2.5, 3.0, 3.5, 4.0, 4.5,+ 5.0, 0.5, 1.0, 1.5, 2.0,+ 2.5, 3.0, 3.5, 4.0, 4.5]++rswitch_trs =+ [ rswitch_t0 ~= rswitch_t0r,+ rswitch_t1 ~= rswitch_t1r,+ rswitch_t2 ~= rswitch_t2r,+ rswitch_t3 ~= rswitch_t3r,+ rswitch_t4 ~= rswitch_t4r+ ]++rswitch_tr = and rswitch_trs+++rswitch_st0 = testSFSpaceLeak 2000000 rswitch_sawTooth+rswitch_st0r = 4.75
+ tests/TestsReact.hs view
@@ -0,0 +1,71 @@+{-# OPTIONS_GHC -fno-warn-tabs #-}+{- $Id: TestsReact.hs,v 1.2 2003/11/10 21:28:58 antony Exp $+******************************************************************************+* Y A M P A *+* *+* Module: TestsReact *+* Purpose: Test cases for reactimation *+* Authors: Antony Courtney and Henrik Nilsson *+* *+* Copyright (c) Yale University, 2003 *+* *+******************************************************************************+-}++module TestsReact (react_tr, react_trs) where++import System.IO.Unsafe (unsafePerformIO)+import Data.IORef (newIORef, writeIORef, readIORef)++import FRP.Yampa++import TestsCommon++------------------------------------------------------------------------------+-- Test cases for reactimation+------------------------------------------------------------------------------++react_t0 :: [(Double, Double)]+react_t0 = unsafePerformIO $ do+ countr <- newIORef undefined+ inputr <- newIORef undefined+ outputsr <- newIORef []+ let init = do+ writeIORef countr 1+ let input0 = 0.0+ writeIORef inputr input0+ return input0+ sense _ = do+ count <- readIORef countr+ if count >= 5 then do+ writeIORef countr 1+ input <- readIORef inputr+ let input' = input + 0.5+ writeIORef inputr input'+ return (0.1, Just input')+ else do+ writeIORef countr (count + 1)+ return (0.1, Nothing)+ actuate _ output = do+ outputs <- readIORef outputsr+ writeIORef outputsr (output : outputs)+ input <- readIORef inputr+ return (input > 5.0)+ reactimate init sense actuate (arr dup >>> second integral)+ outputs <- readIORef outputsr+ return (take 25 (reverse outputs))+++react_t0r :: [(Double, Double)]+react_t0r = [+ (0.0,0.00), (0.0,0.00), (0.0,0.00), (0.0,0.00), (0.0,0.00),+ (0.5,0.00), (0.5,0.05), (0.5,0.10), (0.5,0.15), (0.5,0.20),+ (1.0,0.25), (1.0,0.35), (1.0,0.45), (1.0,0.55), (1.0,0.65),+ (1.5,0.75), (1.5,0.90), (1.5,1.05), (1.5,1.20), (1.5,1.35),+ (2.0,1.50), (2.0,1.70), (2.0,1.90), (2.0,2.10), (2.0,2.30)]+++react_trs = [ react_t0 ~= react_t0r ]+++react_tr = and react_trs
+ tests/TestsSscan.hs view
@@ -0,0 +1,473 @@+{-# OPTIONS_GHC -fno-warn-tabs #-}+{- $Id$+******************************************************************************+* Y A M P A *+* *+* Module: TestsSscan *+* Purpose: Test cases for pre sscan *+* Authors: Antony Courtney and Henrik Nilsson *+* *+* Copyright (c) Yale University, 2003 *+* Copyright (c) University of Nottingham, 2005 *+* *+******************************************************************************+-}++module TestsSscan (sscan_tr, sscan_trs) where++import FRP.Yampa++import TestsCommon++------------------------------------------------------------------------------+-- Test cases sscan+------------------------------------------------------------------------------++-- pre and iPre in terms of sscan+pre_sscan :: SF a a+pre_sscan = sscanPrim f uninit uninit+ where+ f c a = Just (a, c)+ uninit = error "pre_sscan: Uninitialized pre operator."++iPre_sscan :: a -> SF a a+iPre_sscan = (--> pre_sscan)+++sscan_t0, sscan_t0r :: [Double]+sscan_t0 = testSF1 (iPre_sscan 17)+sscan_t0r =+ [17.0,0.0,1.0,2.0,3.0,4.0,5.0,6.0,7.0,8.0,9.0,10.0,11.0,12.0,13.0,14.0,+ 15.0,16.0,17.0,18.0,19.0,20.0,21.0,22.0,23.0]+++sscan_t1, sscan_t1r :: [Double]+sscan_t1 = testSF2 (iPre_sscan 17)+sscan_t1r =+ [17.0,0.0,0.0,0.0,0.0,0.0,1.0,1.0,1.0,1.0,1.0,2.0,2.0,2.0,2.0,2.0,+ 3.0,3.0,3.0,3.0,3.0,4.0,4.0,4.0,4.0]+++sscan_t2, sscan_t2r :: [Double]+sscan_t2 = testSF1 (time+ >>> arr (\t -> sin (0.5 * t * pi + pi))+ >>> loop (arr (\(x1,x2) -> let x' = max x1 x2 in (x',x'))+ >>> second (iPre_sscan 0.0)))+sscan_t2r =+ take 25+ (let xs = [ sin (0.5 * t * pi + pi) | t <- [0.0, 0.25 ..] ]+ in tail (scanl max 0 xs))++++sscan_t3, sscan_t3r :: [Double]+sscan_t3 = testSF1 (time+ >>> arr (\t -> sin (0.5 * t * pi + pi))+ >>> sscan max 0.0)++sscan_t3r =+ take 25+ (let xs = [ sin (0.5 * t * pi + pi) | t <- [0.0, 0.25 ..] ]+ in tail (scanl max 0 xs))+++hold_sscan :: a -> SF (Event a) a+hold_sscan a = sscanPrim f () a+ where+ f _ NoEvent = Nothing+ f _ (Event a) = Just ((), a)+++dHold_sscan :: a -> SF (Event a) a+dHold_sscan a = hold_sscan a >>> iPre_sscan a+++-- This is a (somewhat strange) way of doing a counter that+-- stops after reaching a threshold. Note that the ingoing event+-- is *control dependent* on the output of the counter, so+-- "dHold" really has to have the capability of delivering an+-- output without looking at the current input at all.+sscan_t4, sscan_t4r :: [Int]+sscan_t4 = take 50 (embed sf (deltaEncode 0.25 (repeat ())))+ where+ sf = repeatedly 1.0 ()+ >>> (loop $+ arr (\(e,c) -> (e `tag` (c + 1)) `gate` (c < 10))+ >>> dHold_sscan 0+ >>> arr dup)+sscan_t4r = [0,0,0,0, -- 0s+ 0,1,1,1, -- 1s+ 1,2,2,2, -- 2s+ 2,3,3,3, -- 3s+ 3,4,4,4, -- 4s+ 4,5,5,5, -- 5s+ 5,6,6,6, -- 6s+ 6,7,7,7, -- 7s+ 7,8,8,8, -- 8s+ 8,9,9,9, -- 9s+ 9,10,10,10, -- 10s+ 10,10,10,10, -- 11s+ 10,10] -- 12s++-- Version of the above that tests that thigs still work OK also if+-- there is an initial event.+sscan_t5, sscan_t5r :: [Int]+sscan_t5 = take 50 (embed sf (deltaEncode 0.25 (repeat ())))+ where+ sf = (now () &&& repeatedly 1.0 ()) >>> arr (uncurry lMerge)+ >>> (loop $+ arr (\(e,c) -> (e `tag` (c + 1)) `gate` (c < 10))+ >>> dHold_sscan 0+ >>> arr dup)+sscan_t5r = [0,1,1,1, -- 0s+ 1,2,2,2, -- 1s+ 2,3,3,3, -- 2s+ 3,4,4,4, -- 3s+ 4,5,5,5, -- 4s+ 5,6,6,6, -- 5s+ 6,7,7,7, -- 6s+ 7,8,8,8, -- 7s+ 8,9,9,9, -- 8s+ 9,10,10,10, -- 9s+ 10,10,10,10, -- 10s+ 10,10,10,10, -- 11s+ 10,10] -- 12s+++-- Version of the sscan_t4 in terms of sscan+sscan_t6, sscan_t6r :: [Int]+sscan_t6 = take 50 (embed sf (deltaEncode 0.25 (repeat ())))+ where+ sf = repeatedly 1.0 () >>> (sscanPrim f 0 0)++ f c NoEvent = Nothing+ f c (Event _) | c < 10 = Just (c', c')+ | otherwise = Nothing+ where+ c' = c + 1+++sscan_t6r = [0,0,0,0, -- 0s+ 1,1,1,1, -- 1s+ 2,2,2,2, -- 2s+ 3,3,3,3, -- 3s+ 4,4,4,4, -- 4s+ 5,5,5,5, -- 5s+ 6,6,6,6, -- 6s+ 7,7,7,7, -- 7s+ 8,8,8,8, -- 8s+ 9,9,9,9, -- 9s+ 10,10,10,10, -- 10s+ 10,10,10,10, -- 11s+ 10,10] -- 12s++-- Version of sscan_t5 directly in terms of sscan.+sscan_t7, sscan_t7r :: [Int]+sscan_t7 = take 50 (embed sf (deltaEncode 0.25 (repeat ())))+ where+ sf = (now () &&& repeatedly 1.0 ()) >>> arr (uncurry lMerge)+ >>> (sscanPrim f 0 0)++ f c NoEvent = Nothing+ f c (Event _) | c < 10 = Just (c', c')+ | otherwise = Nothing+ where+ c' = c + 1+++sscan_t7r = [1,1,1,1, -- 0s+ 2,2,2,2, -- 1s+ 3,3,3,3, -- 2s+ 4,4,4,4, -- 3s+ 5,5,5,5, -- 4s+ 6,6,6,6, -- 5s+ 7,7,7,7, -- 6s+ 8,8,8,8, -- 7s+ 9,9,9,9, -- 8s+ 10,10,10,10, -- 9s+ 10,10,10,10, -- 10s+ 10,10,10,10, -- 11s+ 10,10] -- 12s+++edge_sscan :: SF Bool (Event ())+edge_sscan = sscanPrim f 2 NoEvent+ where+ f 0 False = Nothing+ f 0 True = Just (1, Event ())+ f 1 False = Just (0, NoEvent)+ f 1 True = Just (2, NoEvent)+ f 2 False = Just (0, NoEvent)+ f 2 True = Nothing+++sscan_t8 :: [Event ()]+sscan_t8 = testSF1 (localTime >>> arr (>=0) >>> edge_sscan)++sscan_t8r =+ [NoEvent, NoEvent, NoEvent, NoEvent, -- 0.0 s+ NoEvent, NoEvent, NoEvent, NoEvent, -- 1.0 s+ NoEvent, NoEvent, NoEvent, NoEvent, -- 2.0 s+ NoEvent, NoEvent, NoEvent, NoEvent, -- 3.0 s+ NoEvent, NoEvent, NoEvent, NoEvent, -- 4.0 s+ NoEvent, NoEvent, NoEvent, NoEvent, -- 5.0 s+ NoEvent]+++sscan_t9 :: [Event ()]+sscan_t9 = testSF1 (localTime >>> arr (>=4.26) >>> edge_sscan)++sscan_t9r =+ [NoEvent, NoEvent, NoEvent, NoEvent, -- 0.0 s+ NoEvent, NoEvent, NoEvent, NoEvent, -- 1.0 s+ NoEvent, NoEvent, NoEvent, NoEvent, -- 2.0 s+ NoEvent, NoEvent, NoEvent, NoEvent, -- 3.0 s+ NoEvent, NoEvent, Event (), NoEvent, -- 4.0 s+ NoEvent, NoEvent, NoEvent, NoEvent, -- 5.0 s+ NoEvent]+++edgeBy_sscan :: (a -> a -> Maybe b) -> a -> SF a (Event b)+edgeBy_sscan f a = sscanPrim g a NoEvent+ where+ g a_prev a = Just (a, maybeToEvent (f a_prev a))+++-- Raising edge detector.+sscan_isEdge False False = Nothing+sscan_isEdge False True = Just ()+sscan_isEdge True True = Nothing+sscan_isEdge True False = Nothing+++sscan_t10 :: [Event ()]+sscan_t10 = testSF1 (localTime+ >>> arr (>=0)+ >>> edgeBy_sscan sscan_isEdge False)++sscan_t10r =+ [Event (), NoEvent, NoEvent, NoEvent, -- 0.0 s+ NoEvent, NoEvent, NoEvent, NoEvent, -- 1.0 s+ NoEvent, NoEvent, NoEvent, NoEvent, -- 2.0 s+ NoEvent, NoEvent, NoEvent, NoEvent, -- 3.0 s+ NoEvent, NoEvent, NoEvent, NoEvent, -- 4.0 s+ NoEvent, NoEvent, NoEvent, NoEvent, -- 5.0 s+ NoEvent]++sscan_t11 :: [Event ()]+sscan_t11 = testSF1 (localTime+ >>> arr (>=4.26)+ >>> edgeBy_sscan sscan_isEdge False)++sscan_t11r =+ [NoEvent, NoEvent, NoEvent, NoEvent, -- 0.0 s+ NoEvent, NoEvent, NoEvent, NoEvent, -- 1.0 s+ NoEvent, NoEvent, NoEvent, NoEvent, -- 2.0 s+ NoEvent, NoEvent, NoEvent, NoEvent, -- 3.0 s+ NoEvent, NoEvent, Event (), NoEvent, -- 4.0 s+ NoEvent, NoEvent, NoEvent, NoEvent, -- 5.0 s+ NoEvent]++-- Raising and falling edge detector.+sscan_isEdge2 False False = Nothing+sscan_isEdge2 False True = Just True+sscan_isEdge2 True True = Nothing+sscan_isEdge2 True False = Just False++sscan_t12 :: [Event Bool]+sscan_t12 = testSF1 (localTime+ >>> arr (\t -> t >=2.01 && t <= 4.51)+ >>> edgeBy_sscan sscan_isEdge2 True)++sscan_t12r =+ [Event False, NoEvent, NoEvent, NoEvent, -- 0.0 s+ NoEvent, NoEvent, NoEvent, NoEvent, -- 1.0 s+ NoEvent, Event True, NoEvent, NoEvent, -- 2.0 s+ NoEvent, NoEvent, NoEvent, NoEvent, -- 3.0 s+ NoEvent, NoEvent, NoEvent, Event False, -- 4.0 s+ NoEvent, NoEvent, NoEvent, NoEvent, -- 5.0 s+ NoEvent]++++smaximum_sscan :: Ord a => SF a a+smaximum_sscan =+ switch (identity &&& now () >>> arr (\(a,e) -> (a, e `tag` a)))+ (\a0 -> sscanPrim (\c a -> if a > c+ then (Just (a,a))+ else Nothing)+ a0 a0)+++sscan_t13, sscan_t13r :: [Double]+sscan_t13 = take 100 (embed sf (deltaEncode 0.1 (repeat ())))+ where+ sf = time+ >>> arr (\t -> (t + 1) * cos (pi * t + pi))+ >>> smaximum_sscan++sscan_t13r =+ take 100+ (let xs = [ (t + 1) * cos (pi * t + pi) | t <- [0.0, 0.1 ..] ]+ in tail (scanl max (-100) xs))+++-- Some tests of signal functions that may be implemented using sscan+-- internally and their combinations with other sscan-based signal+-- functions and event processors.++sscan_t14, sscan_t14r :: [Event Int]+sscan_t14 = take 100 (embed sf (deltaEncode 0.1 (repeat ())))+ where+ sf :: SF () (Event Int)+ sf = time >>> arr (\t -> sin (2 * t))+ >>> arr (>0)+ >>> edge+ >>> arr (`tag` (+1))+ >>> accum 0++sscan_t14r =+ [NoEvent,Event 1,NoEvent,NoEvent,NoEvent,+ NoEvent,NoEvent,NoEvent,NoEvent,NoEvent,+ NoEvent,NoEvent,NoEvent,NoEvent,NoEvent,+ NoEvent,NoEvent,NoEvent,NoEvent,NoEvent,+ NoEvent,NoEvent,NoEvent,NoEvent,NoEvent,+ NoEvent,NoEvent,NoEvent,NoEvent,NoEvent,+ NoEvent,NoEvent,Event 2,NoEvent,NoEvent,+ NoEvent,NoEvent,NoEvent,NoEvent,NoEvent,+ NoEvent,NoEvent,NoEvent,NoEvent,NoEvent,+ NoEvent,NoEvent,NoEvent,NoEvent,NoEvent,+ NoEvent,NoEvent,NoEvent,NoEvent,NoEvent,+ NoEvent,NoEvent,NoEvent,NoEvent,NoEvent,+ NoEvent,NoEvent,NoEvent,Event 3,NoEvent,+ NoEvent,NoEvent,NoEvent,NoEvent,NoEvent,+ NoEvent,NoEvent,NoEvent,NoEvent,NoEvent,+ NoEvent,NoEvent,NoEvent,NoEvent,NoEvent,+ NoEvent,NoEvent,NoEvent,NoEvent,NoEvent,+ NoEvent,NoEvent,NoEvent,NoEvent,NoEvent,+ NoEvent,NoEvent,NoEvent,NoEvent,NoEvent,+ Event 4,NoEvent,NoEvent,NoEvent,NoEvent]++sscan_t15, sscan_t15r :: [Int]+sscan_t15 = take 100 (embed sf (deltaEncode 0.1 (repeat ())))+ where+ sf :: SF () Int+ sf = time >>> arr (\t -> sin (2 * t))+ >>> arr (>0)+ >>> edge+ >>> arr (`tag` (+1))+ >>> accumHold 0++sscan_t15r =+ [0,1,1,1,1,1,1,1,1,1,+ 1,1,1,1,1,1,1,1,1,1,+ 1,1,1,1,1,1,1,1,1,1,+ 1,1,2,2,2,2,2,2,2,2,+ 2,2,2,2,2,2,2,2,2,2,+ 2,2,2,2,2,2,2,2,2,2,+ 2,2,2,3,3,3,3,3,3,3,+ 3,3,3,3,3,3,3,3,3,3,+ 3,3,3,3,3,3,3,3,3,3,+ 3,3,3,3,3,4,4,4,4,4]++sscan_t16, sscan_t16r :: [Int]+sscan_t16 = take 100 (embed sf (deltaEncode 0.1 (repeat ())))+ where+ sf :: SF () Int+ sf = time >>> arr (\t -> sin (2 * t))+ >>> arr (>0)+ >>> edge+ >>> arr (`tag` (+1))+ >>> dAccumHold 0++sscan_t16r =+ [0,0,1,1,1,1,1,1,1,1,+ 1,1,1,1,1,1,1,1,1,1,+ 1,1,1,1,1,1,1,1,1,1,+ 1,1,1,2,2,2,2,2,2,2,+ 2,2,2,2,2,2,2,2,2,2,+ 2,2,2,2,2,2,2,2,2,2,+ 2,2,2,2,3,3,3,3,3,3,+ 3,3,3,3,3,3,3,3,3,3,+ 3,3,3,3,3,3,3,3,3,3,+ 3,3,3,3,3,3,4,4,4,4]++sscan_t17, sscan_t17r :: [Event Int]+sscan_t17 = take 100 (embed sf (deltaEncode 0.1 (repeat ())))+ where+ sf :: SF () (Event Int)+ sf = time >>> arr (\t -> sin (2 * t))+ >>> arr (>0)+ >>> iPre False+ >>> edge+ >>> arr (`tag` (+1))+ >>> accum 0++sscan_t17r =+ [NoEvent,NoEvent,Event 1,NoEvent,NoEvent,+ NoEvent,NoEvent,NoEvent,NoEvent,NoEvent,+ NoEvent,NoEvent,NoEvent,NoEvent,NoEvent,+ NoEvent,NoEvent,NoEvent,NoEvent,NoEvent,+ NoEvent,NoEvent,NoEvent,NoEvent,NoEvent,+ NoEvent,NoEvent,NoEvent,NoEvent,NoEvent,+ NoEvent,NoEvent,NoEvent,Event 2,NoEvent,+ NoEvent,NoEvent,NoEvent,NoEvent,NoEvent,+ NoEvent,NoEvent,NoEvent,NoEvent,NoEvent,+ NoEvent,NoEvent,NoEvent,NoEvent,NoEvent,+ NoEvent,NoEvent,NoEvent,NoEvent,NoEvent,+ NoEvent,NoEvent,NoEvent,NoEvent,NoEvent,+ NoEvent,NoEvent,NoEvent,NoEvent,Event 3,+ NoEvent,NoEvent,NoEvent,NoEvent,NoEvent,+ NoEvent,NoEvent,NoEvent,NoEvent,NoEvent,+ NoEvent,NoEvent,NoEvent,NoEvent,NoEvent,+ NoEvent,NoEvent,NoEvent,NoEvent,NoEvent,+ NoEvent,NoEvent,NoEvent,NoEvent,NoEvent,+ NoEvent,NoEvent,NoEvent,NoEvent,NoEvent,+ NoEvent,Event 4,NoEvent,NoEvent,NoEvent]++sscan_t18, sscan_t18r :: [Int]+sscan_t18 = take 100 (embed sf (deltaEncode 0.1 (repeat ())))+ where+ sf :: SF () Int+ sf = time >>> arr (\t -> sin (2 * t))+ >>> arr (>0)+ >>> iPre False+ >>> edge+ >>> arr (`tag` (+1))+ >>> accumHold 0++sscan_t18r =+ [0,0,1,1,1,1,1,1,1,1,+ 1,1,1,1,1,1,1,1,1,1,+ 1,1,1,1,1,1,1,1,1,1,+ 1,1,1,2,2,2,2,2,2,2,+ 2,2,2,2,2,2,2,2,2,2,+ 2,2,2,2,2,2,2,2,2,2,+ 2,2,2,2,3,3,3,3,3,3,+ 3,3,3,3,3,3,3,3,3,3,+ 3,3,3,3,3,3,3,3,3,3,+ 3,3,3,3,3,3,4,4,4,4]++sscan_trs =+ [ sscan_t0 ~= sscan_t0r,+ sscan_t1 ~= sscan_t1r,+ sscan_t2 ~= sscan_t2r,+ sscan_t3 ~= sscan_t3r,+ sscan_t4 == sscan_t4r,+ sscan_t5 == sscan_t5r,+ sscan_t6 == sscan_t6r,+ sscan_t7 == sscan_t7r,+ sscan_t8 == sscan_t8r,+ sscan_t9 == sscan_t9r,+ sscan_t10 == sscan_t10r,+ sscan_t11 == sscan_t11r,+ sscan_t12 == sscan_t12r,+ sscan_t13 ~= sscan_t13r,+ sscan_t14 ~= sscan_t14r,+ sscan_t15 ~= sscan_t15r,+ sscan_t16 ~= sscan_t16r,+ sscan_t17 ~= sscan_t17r,+ sscan_t18 ~= sscan_t18r+ ]++sscan_tr = and sscan_trs
+ tests/TestsSwitch.hs view
@@ -0,0 +1,214 @@+{-# OPTIONS_GHC -fno-warn-tabs #-}+{- $Id: TestsSwitch.hs,v 1.2 2003/11/10 21:28:58 antony Exp $+******************************************************************************+* Y A M P A *+* *+* Module: TestsSwitch *+* Purpose: Test cases for switch *+* Authors: Antony Courtney and Henrik Nilsson *+* *+* Copyright (c) Yale University, 2003 *+* *+******************************************************************************+-}+module TestsSwitch (switch_tr, switch_trs) where++import FRP.Yampa+import FRP.Yampa.EventS++import TestsCommon++------------------------------------------------------------------------------+-- Test cases for switch and dSwitch+------------------------------------------------------------------------------++switch_inp1 = deltaEncode 1.0 $+ [1.0, 1.0, 1.0,+ 2.0,+ 3.0, 3.0,+ 4.0, 4.0, 4.0,+ 5.0,+ 6.0, 6.0,+ 7.0, 7.0, 7.0,+ 8.0]+ ++ repeat 9.0++switch_t0 = take 18 $+ embed (switch switch_t0a $ \x ->+ switch (switch_t0b x) $ \x ->+ switch (switch_t0c x) $ \x ->+ switch (switch_t0c x) $ \x ->+ switch (switch_t0d x) $ \x ->+ switch (switch_t0e x) $ \x ->+ switch (switch_t0e x) $+ switch_t0final)+ switch_inp1++switch_t0a :: SF Double (Double, Event Int)+switch_t0a = localTime+ >>> arr dup+ >>> second (arr (>= 3.0) >>> edge >>> arr (`tag` 17))++switch_t0b :: Int -> SF Double (Double, Event Int)+switch_t0b x = localTime+ >>> arr dup+ >>> second (arr (>= 3.0) >>> edge >>> arr (`tag` (23 + x)))++-- This should raise an event IMMEDIATELY: no time should pass.+switch_t0c :: Num b => b -> SF a (a, Event b)+switch_t0c x = arr dup >>> second (now (x + 1))++switch_t0d x = (arr (+ (fromIntegral x))) &&& (arr (>= 7.0) >>> edge)++-- This should raise an event IMMEDIATELY: no time should pass.+switch_t0e :: b -> SF a (a, Event a)+switch_t0e _ = arr dup >>> second snap++switch_t0final :: Double -> SF Double Double+switch_t0final x = arr (+x)++switch_t0r =+ [0.0, 1.0, 2.0, -- switch_t0a+ 0.0, 1.0, 2.0, -- switch_t0b+ 46.0, 46.0, 46.0, 47.0, 48.0, 48.0, -- switch_t0d+ 14.0, 14.0, 14.0, 15.0, 16.0, 16.0 -- switch_t0final+ ]+++switch_t1 = take 32 $ embed (switch_t1rec 42.0) switch_inp1++-- Outputs current input, local time, and the value of the initializing+-- argument until some time has passed (determined by integrating a constant),+-- at which point an event occurs.+switch_t1a :: Double -> SF Double ((Double,Double,Double), Event ())+switch_t1a x = (arr dup >>> second localTime >>> arr (\(a,t) -> (a,t,x)))+ &&& (constant 0.5+ >>> integral+ >>> (arr (>= (2.0 :: Double)) -- Used to work with no sig.+ >>> edge))++-- This should raise an event IMMEDIATELY: no time should pass.+switch_t1b :: b -> SF a ((Double,Double,Double), Event a)+switch_t1b _ = constant (-999.0,-999.0,-999.0) &&& snap++switch_t1rec :: Double -> SF Double (Double,Double,Double)+switch_t1rec x =+ switch (switch_t1a x) $ \x ->+ switch (switch_t1b x) $ \x ->+ switch (switch_t1b x) $+ switch_t1rec++switch_t1r =+ [(1.0,0.0,42.0), (1.0,1.0,42.0), (1.0,2.0,42.0), (2.0,3.0,42.0),+ (3.0,0.0,3.0), (3.0,1.0,3.0), (4.0,2.0,3.0), (4.0,3.0,3.0),+ (4.0,0.0,4.0), (5.0,1.0,4.0), (6.0,2.0,4.0), (6.0,3.0,4.0),+ (7.0,0.0,7.0), (7.0,1.0,7.0), (7.0,2.0,7.0), (8.0,3.0,7.0),+ (9.0,0.0,9.0), (9.0,1.0,9.0), (9.0,2.0,9.0), (9.0,3.0,9.0),+ (9.0,0.0,9.0), (9.0,1.0,9.0), (9.0,2.0,9.0), (9.0,3.0,9.0),+ (9.0,0.0,9.0), (9.0,1.0,9.0), (9.0,2.0,9.0), (9.0,3.0,9.0),+ (9.0,0.0,9.0), (9.0,1.0,9.0), (9.0,2.0,9.0), (9.0,3.0,9.0)]++switch_t2 = take 18 $+ embed (dSwitch switch_t0a $ \x ->+ dSwitch (switch_t0b x) $ \x ->+ dSwitch (switch_t0c x) $ \x ->+ dSwitch (switch_t0c x) $ \x ->+ dSwitch (switch_t0d x) $ \x ->+ dSwitch (switch_t0e x) $ \x ->+ dSwitch (switch_t0e x) $+ switch_t0final)+ switch_inp1++switch_t2r =+ [0.0, 1.0, 2.0, -- switch_t0a+ 3.0, 1.0, 2.0, -- switch_t0b+ 3.0, 46.0, 46.0, 47.0, 48.0, 48.0, -- switch_t0d+ 49.0, 14.0, 14.0, 15.0, 16.0, 16.0 -- switch_t0final+ ]+++switch_t3 = take 32 $ embed (switch_t3rec 42.0) switch_inp1++switch_t3rec :: Double -> SF Double (Double,Double,Double)+switch_t3rec x =+ dSwitch (switch_t1a x) $ \x ->+ dSwitch (switch_t1b x) $ \x ->+ dSwitch (switch_t1b x) $+ switch_t3rec++switch_t3r =+ [(1.0,0.0,42.0), (1.0,1.0,42.0), (1.0,2.0,42.0), (2.0,3.0,42.0),+ (3.0,4.0,42.0), (3.0,1.0,3.0), (4.0,2.0,3.0), (4.0,3.0,3.0),+ (4.0,4.0,3.0), (5.0,1.0,4.0), (6.0,2.0,4.0), (6.0,3.0,4.0),+ (7.0,4.0,4.0), (7.0,1.0,7.0), (7.0,2.0,7.0), (8.0,3.0,7.0),+ (9.0,4.0,7.0), (9.0,1.0,9.0), (9.0,2.0,9.0), (9.0,3.0,9.0),+ (9.0,4.0,9.0), (9.0,1.0,9.0), (9.0,2.0,9.0), (9.0,3.0,9.0),+ (9.0,4.0,9.0), (9.0,1.0,9.0), (9.0,2.0,9.0), (9.0,3.0,9.0),+ (9.0,4.0,9.0), (9.0,1.0,9.0), (9.0,2.0,9.0), (9.0,3.0,9.0)]+++-- The correct strictness properties of dSwitch are crucial here.+-- switch does not work.+switch_t4 = take 25 $+ embed (loop $+ dSwitch switch_t4a $ \_ ->+ dSwitch switch_t4a $ \_ ->+ dSwitch switch_t4a $ \_ ->+ switch_t4final+ )+ (deltaEncode 1.0 (repeat ()))+++switch_t4a :: SF (a, Double) ((Double, Double), Event ())+switch_t4a = (constant 1.0 >>> integral >>> arr dup)+ &&& (arr (\ (_, x) -> x >= 5.0) >>> edge)++switch_t4final :: SF (a, Double) (Double, Double)+switch_t4final = constant 0.1 >>> integral >>> arr dup++switch_t4r =+ [0.0, 1.0, 2.0, 3.0, 4.0, -- switch_t4a+ 5.0, 1.0, 2.0, 3.0, 4.0, -- switch_t4a+ 5.0, 1.0, 2.0, 3.0, 4.0, -- switch_t4a+ 5.0, 0.1, 0.2, 0.3, 0.4, 0.5, 0.6, 0.7, 0.8, 0.9 -- switch_t4final+ ]+++impulseIntegral2 :: VectorSpace a s => SF (a, Event a) a+impulseIntegral2 =+ switch (first integral >>> arr (\(a, ea) -> (a, fmap (^+^ a) ea)))+ impulseIntegral2'+ where+ impulseIntegral2' :: VectorSpace a s => a -> SF (a, Event a) a+ impulseIntegral2' a =+ switch ((integral >>> arr (^+^ a)) *** notYet+ >>> arr (\(a, ea) -> (a, fmap (^+^ a) ea)))+ impulseIntegral2'++switch_t5 :: [Double]+switch_t5 = take 50 $ embed impulseIntegral2+ (deltaEncode 0.1 (zip (repeat 1.0) evSeq))+ where+ evSeq = replicate 9 NoEvent ++ [Event 10.0]+ ++ replicate 9 NoEvent ++ [Event (-10.0)]+ ++ evSeq++switch_t5r =+ [ 0.0, 0.1, 0.2, 0.3, 0.4, 0.5, 0.6, 0.7, 0.8, 10.9,+ 11.0, 11.1, 11.2, 11.3, 11.4, 11.5, 11.6, 11.7, 11.8, 1.9,+ 2.0, 2.1, 2.2, 2.3, 2.4, 2.5, 2.6, 2.7, 2.8, 12.9,+ 13.0, 13.1, 13.2, 13.3, 13.4, 13.5, 13.6, 13.7, 13.8, 3.9,+ 4.0, 4.1, 4.2, 4.3, 4.4, 4.5, 4.6, 4.7, 4.8, 14.9]+++switch_trs =+ [ switch_t0 ~= switch_t0r,+ switch_t1 ~= switch_t1r,+ switch_t2 ~= switch_t2r,+ switch_t3 ~= switch_t3r,+ switch_t4 ~= switch_t4r,+ switch_t5 ~= switch_t5r+ ]++switch_tr = and switch_trs+
+ tests/TestsTask.hs view
@@ -0,0 +1,232 @@+{-# OPTIONS_GHC -fno-warn-tabs #-}+{- $Id: TestsTask.hs,v 1.2 2003/11/10 21:28:58 antony Exp $+******************************************************************************+* Y A M P A *+* *+* Module: TestsTask *+* Purpose: Test cases for tasks (Task) *+* Authors: Antony Courtney and Henrik Nilsson *+* *+* Copyright (c) Yale University, 2003 *+* *+******************************************************************************+-}++-- Very rudimentary testing of Task.++module TestsTask (task_tr, task_trs) where++import Control.Monad (when, forever)+import FRP.Yampa+import FRP.Yampa.Task++import TestsCommon++------------------------------------------------------------------------------+-- Test cases for tasks (Task)+------------------------------------------------------------------------------++task_t0 = testSF1 (runTask (do+ mkTask (localTime+ &&&(localTime >>> arr (>=5.0) >>> edge))+ x <- snapT+ return (x * 2.0))+ )++task_t0r =+ [Left 0.0, Left 0.25, Left 0.5, Left 0.75, Left 1.0,+ Left 1.25, Left 1.5, Left 1.75, Left 2.0, Left 2.25,+ Left 2.5, Left 2.75, Left 3.0, Left 3.25, Left 3.5,+ Left 3.75, Left 4.0, Left 4.25, Left 4.5, Left 4.75,+ Right 40.0, Right 40.0, Right 40.0, Right 40.0, Right 40.0]+++task_t1 = testSF1 (runTask (do+ mkTask (localTime+ &&& (localTime>>>arr (>=5.0) >>> edge))+ return () -- No time should pass!+ return () -- No Time should pass!+ snapT -- No time should pass!+ snapT -- No time should pass!+ x <- snapT+ return (x * 2.0))+ )+++task_t2 = testSF1 (runTask (do+ sleepT 1.51 42.0+ x <- snapT+ y <- snapT+ sleepT 1.51 x+ if x == y then+ sleepT 1.51 (x * 2)+ else+ sleepT 0.51 (x * 3)+ )+ )++task_t2r =+ [Left 42.0, Left 42.0, Left 42.0, Left 42.0, -- 0.0 s+ Left 42.0, Left 42.0, Left 42.0, Left 7.0, -- 1.0 s+ Left 7.0, Left 7.0, Left 7.0, Left 7.0, -- 2.0 s+ Left 7.0, Left 7.0, Left 14.0, Left 14.0, -- 3.0 s+ Left 14.0, Left 14.0, Left 14.0, Left 14.0, -- 4.0 s+ Left 14.0, Right (), Right (), Right (), -- 5.0 s+ Right ()]+++task_t3 = testSF1 (runTask (do+ c <- sawtooth `timeOut` 3.49+ case c of+ Nothing -> sleepT 1.51 (-10.0)+ Just x -> sleepT 1.51 x+ )+ )+ where+ sawtooth =+ forever ((mkTask (constant 2.0 >>> integral &&& never))+ `timeOut` 1.5)++task_t3r :: [Either Double ()]+task_t3r =+ [Left 0.0, Left 0.5, Left 1.0, Left 1.5, -- 0.0 s+ Left 2.0, Left 2.5, Left 0.0, Left 0.5, -- 1.0 s+ Left 1.0, Left 1.5, Left 2.0, Left 2.5, -- 2.0 s+ Left 0.0, Left 0.5, Left (-10.0), Left (-10.0), -- 3.0 s+ Left (-10.0), Left (-10.0), Left (-10.0), Left (-10.0), -- 4.0 s+ Left (-10.0), Right (), Right (), Right (), -- 5.0 s+ Right ()]+++task_t4 = testSF1 (runTask (do+ c <- sawtooth `timeOut` 3.49+ case c of+ Nothing -> sleepT 1.51 (-10.0)+ Just x -> sleepT 1.51 x+ )+ )+ where+ sawtooth = do+ for 1 (+1) (<=2)+ ((mkTask (constant 2.0 >>> integral &&& never))+ `timeOut` 1.5)+ return (-42.0)++task_t4r :: [Either Double ()]+task_t4r =+ [Left 0.0, Left 0.5, Left 1.0, Left 1.5, -- 0.0 s+ Left 2.0, Left 2.5, Left 0.0, Left 0.5, -- 1.0 s+ Left 1.0, Left 1.5, Left 2.0, Left 2.5, -- 2.0 s+ Left (-42.0), Left (-42.0), Left (-42.0), Left (-42.0), -- 3.0 s+ Left (-42.0), Left (-42.0), Left (-42.0), Right (), -- 4.0 s+ Right (), Right (), Right (), Right (), -- 5.0 s+ Right ()]+++task_t5 = testSF1 (runTask (do+ x<-(sawtoothCycle>>snapT) `repeatUntil` (>=20.0)+ y<-snapT+ return (x == y)+ )+ )+ where+ sawtoothCycle = mkTask (constant 2.0 >>> integral &&& after 1.5 ())++task_t5r :: [Either Double Bool]+task_t5r =+ [Left 0.0, Left 0.5, Left 1.0, Left 1.5, -- 0.0 s, 0 - 3+ Left 2.0, Left 2.5, Left 0.0, Left 0.5, -- 1.0 s, 4 - 7+ Left 1.0, Left 1.5, Left 2.0, Left 2.5, -- 2.0 s, 8 - 11+ Left 0.0, Left 0.5, Left 1.0, Left 1.5, -- 3.0 s, 12 - 15+ Left 2.0, Left 2.5, Left 0.0, Left 0.5, -- 4.0 s, 16 - 19,+ Left 1.0, Left 1.5, Left 2.0, Left 2.5, -- 5.0 s, 20 - 23+ Right True]+++task_t6 = testSF1 $ runTask $+ do+ x <- ((sawtoothCycle >> snapT) `repeatUntil` (>=20.0))+ `abortWhen` (localTime >>> arr (>=3.51) >>> edge)+ y <- snapT+ return (x,y)+ where+ sawtoothCycle = mkTask (constant 2.0 >>> integral &&& after 1.5 ())++task_t6r :: [Either Double (Either Double (), Double)]+task_t6r =+ [Left 0.0, Left 0.5, Left 1.0, Left 1.5, -- 0.0 s, 0 - 3+ Left 2.0, Left 2.5, Left 0.0, Left 0.5, -- 1.0 s, 4 - 7+ Left 1.0, Left 1.5, Left 2.0, Left 2.5, -- 2.0 s, 8 - 11+ Left 0.0, Left 0.5, Left 1.0, Right (Right (),15.0), -- 3.0 s, 12 - 15+ Right (Right (),15.0), Right (Right (),15.0), -- 4.0 s, 16, 17+ Right (Right (),15.0), Right (Right (),15.0), -- 4.5 s, 18, 19+ Right (Right (),15.0), Right (Right (),15.0), -- 5.0 s, 20, 21+ Right (Right (),15.0), Right (Right (),15.0), -- 5.5 s, 22, 23+ Right (Right (),15.0)]++task_t7 = testSF1 $ runTask $+ do+ x <- ((sawtoothCycle >> snapT) `repeatUntil` (>=20.0))+ `abortWhen` (localTime >>> arr (>=5.75) >>> edge)+ y <- snapT+ return (x,y)+ where+ sawtoothCycle = mkTask (constant 2.0 >>> integral &&& after 1.5 ())++task_t7r :: [Either Double (Either Double (), Double)]+task_t7r =+ [Left 0.0, Left 0.5, Left 1.0, Left 1.5, -- 0.0 s, 0 - 3+ Left 2.0, Left 2.5, Left 0.0, Left 0.5, -- 1.0 s, 4 - 7+ Left 1.0, Left 1.5, Left 2.0, Left 2.5, -- 2.0 s, 8 - 11+ Left 0.0, Left 0.5, Left 1.0, Left 1.5, -- 3.0 s, 12 - 15+ Left 2.0, Left 2.5, Left 0.0, Left 0.5, -- 4.0 s, 16 - 19+ Left 1.0, Left 1.5, Left 2.0, Right (Right (),23.0), -- 5.0 s, 20 - 23+ Right (Right (),23.0)]++task_t8 = testSF1 $ runTask $+ do+ x <- ((sawtoothCycle >> snapT) `repeatUntil` (>=20.0))+ `abortWhen` (localTime >>> arr (>=5.76) >>> edge)+ y <- snapT+ return (x,y)+ where+ sawtoothCycle = mkTask (constant 2.0 >>> integral &&& after 1.5 ())++-- Since abortWhen uses lMergeEvent, the terminating event of the task+-- gets priority over the aborting event.+task_t8r :: [Either Double (Either Double (), Double)]+task_t8r =+ [Left 0.0, Left 0.5, Left 1.0, Left 1.5, -- 0.0 s, 0 - 3+ Left 2.0, Left 2.5, Left 0.0, Left 0.5, -- 1.0 s, 4 - 7+ Left 1.0, Left 1.5, Left 2.0, Left 2.5, -- 2.0 s, 8 - 11+ Left 0.0, Left 0.5, Left 1.0, Left 1.5, -- 3.0 s, 12 - 15+ Left 2.0, Left 2.5, Left 0.0, Left 0.5, -- 4.0 s, 16 - 19+ Left 1.0, Left 1.5, Left 2.0, Left 2.5, -- 5.0 s, 20 - 23+ Right (Left 24.0,24.0)]++task_trs =+ [ task_t0 ~= task_t0r,+ task_t1 ~= task_t0r, -- Intentionally! task_t0 = task_t1!+ task_t2 ~= task_t2r,+ task_t3 ~= task_t3r,+ task_t4 ~= task_t4r,+ task_t5 ~= task_t5r,+ task_t6 ~= task_t6r,+ task_t7 ~= task_t7r,+ task_t8 ~= task_t8r+ ]++task_tr = and task_trs++-- | Repeat m until result satisfies the predicate p+repeatUntil :: Monad m => m a -> (a -> Bool) -> m a+m `repeatUntil` p = m >>= \x -> if not (p x) then repeatUntil m p else return x++-- | C-style for-loop.+--+-- Example:+--+-- >>> 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+
+ tests/TestsUtils.hs view
@@ -0,0 +1,372 @@+{-# OPTIONS_GHC -fno-warn-tabs #-}+{- $Id: TestsUtils.hs,v 1.2 2003/11/10 21:28:58 antony Exp $+******************************************************************************+* Y A M P A *+* *+* Module: TestsUtils *+* Purpose: Test cases for utilities (Utilities) *+* Authors: Antony Courtney and Henrik Nilsson *+* *+* Copyright (c) Yale University, 2003 *+* *+******************************************************************************+-}++-- Not really intended to test all definitions in the utilities module.++module TestsUtils (utils_tr, utils_trs) where++import FRP.Yampa+import FRP.Yampa.Conditional+import FRP.Yampa.EventS+import FRP.Yampa.Hybrid+import FRP.Yampa.Switches++import TestsCommon++------------------------------------------------------------------------------+-- Test cases for utilities (Utils)+------------------------------------------------------------------------------++-- Should re-order these test cases to reflect the order in Utils+-- at some point.++utils_inp1 = deltaEncode 1.0 $+ [NoEvent, NoEvent, Event 1.0, NoEvent,+ Event 2.0, NoEvent, NoEvent, NoEvent,+ Event 3.0, Event 4.0, Event 4.0, NoEvent,+ Event 0.0, NoEvent, NoEvent, NoEvent]+ ++ repeat NoEvent+++utils_inp2 = deltaEncode 1.0 $+ [Event 1.0, NoEvent, NoEvent, NoEvent,+ Event 2.0, NoEvent, NoEvent, NoEvent,+ Event 3.0, Event 4.0, Event 4.0, NoEvent,+ Event 0.0, NoEvent, NoEvent, NoEvent]+ ++ repeat NoEvent+++utils_t0 :: [Double]+utils_t0 = take 16 $ embed (dHold 99.99) utils_inp1++utils_t0r =+ [99.99, 99.99, 99.99, 1.0,+ 1.0, 2.0, 2.0, 2.0,+ 2.0, 3.0, 4.0, 4.0,+ 4.0, 0.0, 0.0, 0.0]++utils_t1 :: [Double]+utils_t1 = take 16 $ embed (dHold 99.99) utils_inp2++utils_t1r =+ [99.99, 1.0, 1.0, 1.0,+ 1.0, 2.0, 2.0, 2.0,+ 2.0, 3.0, 4.0, 4.0,+ 4.0, 0.0, 0.0, 0.0]+++utils_inp3 = deltaEncode 1.0 $+ [Nothing, Nothing, Just 1.0, Just 2.0, Just 3.0,+ Just 4.0, Nothing, Nothing, Nothing, Just 3.0,+ Just 2.0, Nothing, Just 1.0, Just 0.0, Just 1.0,+ Just 2.0, Just 3.0, Nothing, Nothing, Just 4.0]+ ++ repeat Nothing++utils_inp4 = deltaEncode 1.0 $+ [Just 0.0, Nothing, Just 1.0, Just 2.0, Just 3.0,+ Just 4.0, Nothing, Nothing, Nothing, Just 3.0,+ Just 2.0, Nothing, Just 1.0, Just 0.0, Just 1.0,+ Just 2.0, Just 3.0, Nothing, Nothing, Just 4.0]+ ++ repeat Nothing+++utils_t2 :: [Double]+utils_t2 = take 25 $ embed (dTrackAndHold 99.99) utils_inp3++utils_t2r =+ [99.99, 99.99, 99.99, 1.0, 2.0,+ 3.0, 4.0, 4.0, 4.0, 4.0,+ 3.0, 2.0, 2.0, 1.0, 0.0,+ 1.0, 2.0, 3.0, 3.0, 3.0,+ 4.0, 4.0, 4.0, 4.0, 4.0]++utils_t3 :: [Double]+utils_t3 = take 25 $ embed (dTrackAndHold 99.99) utils_inp4++utils_t3r =+ [99.99, 0.0, 0.0, 1.0, 2.0,+ 3.0, 4.0, 4.0, 4.0, 4.0,+ 3.0, 2.0, 2.0, 1.0, 0.0,+ 1.0, 2.0, 3.0, 3.0, 3.0,+ 4.0, 4.0, 4.0, 4.0, 4.0]+++utils_t4 :: [Event Int]+utils_t4 = take 16 $ embed count utils_inp1++utils_t4r :: [Event Int]+utils_t4r =+ [NoEvent, NoEvent, Event 1, NoEvent,+ Event 2, NoEvent, NoEvent, NoEvent,+ Event 3, Event 4, Event 5, NoEvent,+ Event 6, NoEvent, NoEvent, NoEvent]+++utils_t5 :: [Event Int]+utils_t5 = take 16 $ embed count utils_inp2++utils_t5r :: [Event Int]+utils_t5r =+ [Event 1, NoEvent, NoEvent, NoEvent,+ Event 2, NoEvent, NoEvent, NoEvent,+ Event 3, Event 4, Event 5, NoEvent,+ Event 6, NoEvent, NoEvent, NoEvent]+++dynDelayLine :: a -> SF (a, Event Bool) a+dynDelayLine a0 =+ second (arr (fmap (\p -> if p then addDelay else delDelay)))+ >>> loop (arr (\((a, e), as) -> (a:as, e))+ >>> rpSwitchZ [iPre a0]+ >>> arr (\as -> (last as, init as)))+ where+ addDelay ds = ds ++ [last ds]++ delDelay [d] = [d]+ delDelay ds = init ds++utils_t6 :: [Int]+utils_t6 = take 200 $ embed (dynDelayLine 0)+ (deltaEncode 0.1 (zip [1..] evSeq))+ where+ evSeq = NoEvent : Event True : NoEvent : NoEvent : Event True :+ NoEvent : NoEvent : Event False : evSeq++utils_t6r =+ [0,1,1,2,3,3,4,6,7,8,8,9,10,10,11,13,14,15,15,16,17,17,18,20,21,22,22,23,+ 24,24,25,27,28,29,29,30,31,31,32,34,35,36,36,37,38,38,39,41,42,43,43,44,+ 45,45,46,48,49,50,50,51,52,52,53,55,56,57,57,58,59,59,60,62,63,64,64,65,+ 66,66,67,69,70,71,71,72,73,73,74,76,77,78,78,79,80,80,81,83,84,85,85,86,+ 87,87,88,90,91,92,92,93,94,94,95,97,98,99,99,100,101,101,102,104,105,106,+ 106,107,108,108,109,111,112,113,113,114,115,115,116,118,119,120,120,121,+ 122,122,123,125,126,127,127,128,129,129,130,132,133,134,134,135,136,136,+ 137,139,140,141,141,142,143,143,144,146,147,148,148,149,150,150,151,153,+ 154,155,155,156,157,157,158,160,161,162,162,163,164,164,165,167,168,169,+ 169,170,171,171,172,174]++utils_t7 :: [Double]+utils_t7 = take 50 $ embed impulseIntegral+ (deltaEncode 0.1 (zip (repeat 1.0) evSeq))+ where+ evSeq = replicate 9 NoEvent ++ [Event 10.0]+ ++ replicate 9 NoEvent ++ [Event (-10.0)]+ ++ evSeq++utils_t7r =+ [ 0.0, 0.1, 0.2, 0.3, 0.4, 0.5, 0.6, 0.7, 0.8, 10.9,+ 11.0, 11.1, 11.2, 11.3, 11.4, 11.5, 11.6, 11.7, 11.8, 1.9,+ 2.0, 2.1, 2.2, 2.3, 2.4, 2.5, 2.6, 2.7, 2.8, 12.9,+ 13.0, 13.1, 13.2, 13.3, 13.4, 13.5, 13.6, 13.7, 13.8, 3.9,+ 4.0, 4.1, 4.2, 4.3, 4.4, 4.5, 4.6, 4.7, 4.8, 14.9]+++utils_t8 :: [Double]+utils_t8 = take 50 $ embed (provided (even . floor) integral (constant (-1)))+ (deltaEncode 0.1 input)+ where+ input = replicate 10 1+ ++ replicate 10 2+ ++ replicate 10 3+ ++ replicate 10 4+ ++ input++utils_t8r =+ [-1.0, -1.0, -1.0, -1.0, -1.0, -1.0, -1.0, -1.0, -1.0, -1.0,+ 0.0, 0.2, 0.4, 0.6, 0.8, 1.0, 1.2, 1.4, 1.6, 1.8,+ -1.0, -1.0, -1.0, -1.0, -1.0, -1.0, -1.0, -1.0, -1.0, -1.0,+ 0.0, 0.4, 0.8, 1.2, 1.6, 2.0, 2.4, 2.8, 3.2, 3.6,+ -1.0, -1.0, -1.0, -1.0, -1.0, -1.0, -1.0, -1.0, -1.0, -1.0]+++utils_t9 :: [Double]+utils_t9 = take 50 $ embed (provided (odd . floor) integral (constant (-1)))+ (deltaEncode 0.1 input)+ where+ input = replicate 10 1+ ++ replicate 10 2+ ++ replicate 10 3+ ++ replicate 10 4+ ++ input++utils_t9r =+ [ 0.0, 0.1, 0.2, 0.3, 0.4, 0.5, 0.6, 0.7, 0.8, 0.9,+ -1.0, -1.0, -1.0, -1.0, -1.0, -1.0, -1.0, -1.0, -1.0, -1.0,+ 0.0, 0.3, 0.6, 0.9, 1.2, 1.5, 1.8, 2.1, 2.4, 2.7,+ -1.0, -1.0, -1.0, -1.0, -1.0, -1.0, -1.0, -1.0, -1.0, -1.0,+ 0.0, 0.1, 0.2, 0.3, 0.4, 0.5, 0.6, 0.7, 0.8, 0.9]+++utils_t10 :: [Event Double]+utils_t10 = testSF1 snap++utils_t10r =+ [Event 0.0, NoEvent, NoEvent, NoEvent, -- 0.0 s+ NoEvent, NoEvent, NoEvent, NoEvent, -- 1.0 s+ NoEvent, NoEvent, NoEvent, NoEvent, -- 2.0 s+ NoEvent, NoEvent, NoEvent, NoEvent, -- 3.0 s+ NoEvent, NoEvent, NoEvent, NoEvent, -- 4.0 s+ NoEvent, NoEvent, NoEvent, NoEvent, -- 5.0 s+ NoEvent]+++utils_t11 :: [Event Double]+utils_t11 = testSF1 (snapAfter 2.6)++utils_t11r =+ [NoEvent, NoEvent, NoEvent, NoEvent, -- 0.0 s+ NoEvent, NoEvent, NoEvent, NoEvent, -- 1.0 s+ NoEvent, NoEvent, NoEvent, Event 11.0, -- 2.0 s+ NoEvent, NoEvent, NoEvent, NoEvent, -- 3.0 s+ NoEvent, NoEvent, NoEvent, NoEvent, -- 4.0 s+ NoEvent, NoEvent, NoEvent, NoEvent, -- 5.0 s+ NoEvent]+++utils_t12 :: [Event Double]+utils_t12 = testSF1 (sample 0.99)++utils_t12r =+ [NoEvent, NoEvent, NoEvent, NoEvent, -- 0.0 s+ Event 4.0, NoEvent, NoEvent, NoEvent, -- 1.0 s+ Event 8.0, NoEvent, NoEvent, NoEvent, -- 2.0 s+ Event 12.0, NoEvent, NoEvent, NoEvent, -- 3.0 s+ Event 16.0, NoEvent, NoEvent, NoEvent, -- 4.0 s+ Event 20.0, NoEvent, NoEvent, NoEvent, -- 5.0 s+ Event 24.0]+++utils_t13 :: [Event ()]+utils_t13 = testSF1 (recur (after 0.99 ()))++utils_t13r =+ [NoEvent, NoEvent, NoEvent, NoEvent, -- 0.0 s+ Event (), NoEvent, NoEvent, NoEvent, -- 1.0 s+ Event (), NoEvent, NoEvent, NoEvent, -- 2.0 s+ Event (), NoEvent, NoEvent, NoEvent, -- 3.0 s+ Event (), NoEvent, NoEvent, NoEvent, -- 4.0 s+ Event (), NoEvent, NoEvent, NoEvent, -- 5.0 s+ Event ()]+++utils_t14 :: [Event Int]+utils_t14 = testSF1 (after 1.0 1 `andThen` now 2 `andThen` after 2.0 3)++utils_t14r =+ [NoEvent, NoEvent, NoEvent, NoEvent, -- 0.0 s+ Event 1, NoEvent, NoEvent, NoEvent, -- 1.0 s+ NoEvent, NoEvent, NoEvent, NoEvent, -- 2.0 s+ Event 3, NoEvent, NoEvent, NoEvent, -- 3.0 s+ NoEvent, NoEvent, NoEvent, NoEvent, -- 4.0 s+ NoEvent, NoEvent, NoEvent, NoEvent, -- 5.0 s+ NoEvent]++utils_t15 = take 50 (embed (time >>> sampleWindow 5 0.5)+ (deltaEncode 0.125 (repeat ())))++utils_t15r =+ [ NoEvent, NoEvent, NoEvent, NoEvent, -- 0.0 s+ Event [0.5], NoEvent, NoEvent, NoEvent, -- 0.5 s+ Event [0.5,1.0], NoEvent, NoEvent, NoEvent, -- 1.0 s+ Event [0.5,1.0,1.5], NoEvent, NoEvent, NoEvent, -- 1.5 s+ Event [0.5,1.0,1.5,2.0], NoEvent, NoEvent, NoEvent, -- 2.0 s+ Event [0.5,1.0,1.5,2.0,2.5], NoEvent, NoEvent, NoEvent, -- 2.5 s+ Event [1.0,1.5,2.0,2.5,3.0], NoEvent, NoEvent, NoEvent, -- 3.0 s+ Event [1.5,2.0,2.5,3.0,3.5], NoEvent, NoEvent, NoEvent, -- 3.5 s+ Event [2.0,2.5,3.0,3.5,4.0], NoEvent, NoEvent, NoEvent, -- 4.0 s+ Event [2.5,3.0,3.5,4.0,4.5], NoEvent, NoEvent, NoEvent, -- 4.5 s+ Event [3.0,3.5,4.0,4.5,5.0], NoEvent, NoEvent, NoEvent, -- 5.0 s+ Event [3.5,4.0,4.5,5.0,5.5], NoEvent, NoEvent, NoEvent, -- 5.5 s+ Event [4.0,4.5,5.0,5.5,6.0], NoEvent -- 6.0 s+ ]+++{-+-- Not robust+utils_t16 = take 50 (embed (time >>> sampleWindow 5 0.5) input)+ where+ input = ((), [(dt, Just ()) | dt <- dts])++ dts = replicate 15 0.1+ ++ [1.0, 1.0]+ ++ replicate 15 0.1+ ++ [2.0]+ ++ replicate 10 0.1++utils_t16r =+ [ NoEvent, NoEvent, NoEvent, NoEvent, NoEvent, -- 0.0+ NoEvent, Event [0.6], NoEvent, NoEvent, NoEvent, -- 0.5+ NoEvent, Event [0.6, 1.1], NoEvent, NoEvent, NoEvent, -- 1.0+ NoEvent, -- 1.5+ Event [0.6,1.1,2.5,2.5,2.5], -- 2.5+ Event [2.5,2.5,2.5,3.5,3.5], NoEvent, NoEvent, NoEvent, NoEvent, -- 3.5+ NoEvent, Event [2.5,2.5,3.5,3.5,4.1], NoEvent, NoEvent, NoEvent, -- 4.0+ NoEvent, Event [2.5,3.5,3.5,4.1,4.6], NoEvent, NoEvent, NoEvent, -- 4.5+ NoEvent, -- 5.0+ Event [7.0,7.0,7.0,7.0,7.0], NoEvent, NoEvent, NoEvent, NoEvent, -- 7.0+ NoEvent, Event [7.0,7.0,7.0,7.0,7.6], NoEvent, NoEvent, NoEvent, -- 7.5+ NoEvent -- 8.0+ ]+-}++utils_t16 = take 50 (embed (time >>> sampleWindow 5 0.4999) input)+ where+ input = ((), [(dt, Just ()) | dt <- dts])++ dts = replicate 15 0.1+ ++ [1.0, 1.0]+ ++ replicate 15 0.1+ ++ [2.0]+ ++ replicate 10 0.1++utils_t16r =+ [ NoEvent, NoEvent, NoEvent, NoEvent, NoEvent, -- 0.0+ Event [0.5], NoEvent, NoEvent, NoEvent, NoEvent, -- 0.5+ Event [0.5, 1.0], NoEvent, NoEvent, NoEvent, NoEvent, -- 1.0+ Event [0.5, 1.0, 1.5], -- 1.5+ Event [0.5, 1.0, 1.5, 2.5, 2.5], -- 2.5+ Event [1.5, 2.5, 2.5, 3.5, 3.5], NoEvent, NoEvent, NoEvent, -- 3.5+ NoEvent,+ Event [2.5, 2.5, 3.5, 3.5, 4.0], NoEvent, NoEvent, NoEvent, -- 4.0+ NoEvent,+ Event [2.5, 3.5, 3.5, 4.0, 4.5], NoEvent, NoEvent, NoEvent, -- 4.5+ NoEvent,+ Event [3.5, 3.5, 4.0, 4.5, 5.0], -- 5.0+ Event [5.0, 7.0, 7.0, 7.0, 7.0], NoEvent, NoEvent, NoEvent, -- 7.0+ NoEvent,+ Event [7.0, 7.0, 7.0, 7.0, 7.5], NoEvent, NoEvent, NoEvent, -- 7.5+ NoEvent,+ Event [7.0, 7.0, 7.0, 7.5, 8.0] -- 8.0+ ]++utils_trs =+ [ utils_t0 ~= utils_t0r,+ utils_t1 ~= utils_t1r,+ utils_t2 ~= utils_t2r,+ utils_t3 ~= utils_t3r,+ utils_t4 ~= utils_t4r,+ utils_t5 ~= utils_t5r,+ utils_t6 ~= utils_t6r,+ utils_t7 ~= utils_t7r,+ utils_t8 ~= utils_t8r,+ utils_t9 ~= utils_t9r,+ utils_t10 ~= utils_t10r,+ utils_t11 ~= utils_t11r,+ utils_t12 ~= utils_t12r,+ utils_t13 ~= utils_t13r,+ utils_t14 ~= utils_t14r,+ utils_t15 ~= utils_t15r,+ utils_t16 ~= utils_t16r+ ]++utils_tr = and utils_trs
+ tests/TestsWFG.hs view
@@ -0,0 +1,103 @@+{-# OPTIONS_GHC -fno-warn-tabs #-}+{- $Id: TestsWFG.hs,v 1.2 2003/11/10 21:28:58 antony Exp $+******************************************************************************+* Y A M P A *+* *+* Module: TestsWFG *+* Purpose: Test cases for wave-form generation *+* Authors: Antony Courtney and Henrik Nilsson *+* *+* Copyright (c) Yale University, 2003 *+* *+******************************************************************************+-}++module TestsWFG (wfg_tr, wfg_trs) where++import FRP.Yampa++import TestsCommon++------------------------------------------------------------------------------+-- Test cases for wave-form generation+------------------------------------------------------------------------------++wfg_inp1 = deltaEncode 1.0 $+ [NoEvent, NoEvent, Event 1.0, NoEvent,+ Event 2.0, NoEvent, NoEvent, NoEvent,+ Event 3.0, Event 4.0, Event 4.0, NoEvent,+ Event 0.0, NoEvent, NoEvent, NoEvent]+ ++ repeat NoEvent+++wfg_inp2 = deltaEncode 1.0 $+ [Event 1.0, NoEvent, NoEvent, NoEvent,+ Event 2.0, NoEvent, NoEvent, NoEvent,+ Event 3.0, Event 4.0, Event 4.0, NoEvent,+ Event 0.0, NoEvent, NoEvent, NoEvent]+ ++ repeat NoEvent+++wfg_t0 :: [Double]+wfg_t0 = take 16 $ embed (hold 99.99) wfg_inp1++wfg_t0r =+ [99.99, 99.99, 1.0, 1.0,+ 2.0, 2.0, 2.0, 2.0,+ 3.0, 4.0, 4.0, 4.0,+ 0.0, 0.0, 0.0, 0.0]++wfg_t1 :: [Double]+wfg_t1 = take 16 $ embed (hold 99.99) wfg_inp2++wfg_t1r =+ [1.0, 1.0, 1.0, 1.0,+ 2.0, 2.0, 2.0, 2.0,+ 3.0, 4.0, 4.0, 4.0,+ 0.0, 0.0, 0.0, 0.0]++wfg_inp3 = deltaEncode 1.0 $+ [Nothing, Nothing, Just 1.0, Just 2.0, Just 3.0,+ Just 4.0, Nothing, Nothing, Nothing, Just 3.0,+ Just 2.0, Nothing, Just 1.0, Just 0.0, Just 1.0,+ Just 2.0, Just 3.0, Nothing, Nothing, Just 4.0]+ ++ repeat Nothing++wfg_inp4 = deltaEncode 1.0 $+ [Just 0.0, Nothing, Just 1.0, Just 2.0, Just 3.0,+ Just 4.0, Nothing, Nothing, Nothing, Just 3.0,+ Just 2.0, Nothing, Just 1.0, Just 0.0, Just 1.0,+ Just 2.0, Just 3.0, Nothing, Nothing, Just 4.0]+ ++ repeat Nothing+++wfg_t2 :: [Double]+wfg_t2 = take 25 $ embed (trackAndHold 99.99) wfg_inp3++wfg_t2r =+ [99.99, 99.99, 1.0, 2.0, 3.0,+ 4.0, 4.0, 4.0, 4.0, 3.0,+ 2.0, 2.0, 1.0, 0.0, 1.0,+ 2.0, 3.0, 3.0, 3.0, 4.0,+ 4.0, 4.0, 4.0, 4.0, 4.0]+++wfg_t3 :: [Double]+wfg_t3 = take 25 $ embed (trackAndHold 99.99) wfg_inp4++wfg_t3r =+ [0.0, 0.0, 1.0, 2.0, 3.0,+ 4.0, 4.0, 4.0, 4.0, 3.0,+ 2.0, 2.0, 1.0, 0.0, 1.0,+ 2.0, 3.0, 3.0, 3.0, 4.0,+ 4.0, 4.0, 4.0, 4.0, 4.0]+++wfg_trs =+ [ wfg_t0 ~= wfg_t0r,+ wfg_t1 ~= wfg_t1r,+ wfg_t2 ~= wfg_t2r,+ wfg_t3 ~= wfg_t3r+ ]++wfg_tr = and wfg_trs
tests/YampaQC.hs view
@@ -36,8 +36,7 @@ tests :: TestTree tests = testGroup "Yampa QC properties"- [ testProperty "SF based on (**2) equal to SF on (^2))" prop_arr_law1- , testProperty "Identity" prop_arr_id+ [ testProperty "Identity" prop_arr_id , testProperty "Arrow Naturality" prop_arr_naturality , testProperty "Naturality" prop_arr_naturality , testProperty "Basic > Identity (1)" prop_basic_identity_1@@ -95,10 +94,6 @@ -- * Yampa laws -- ** Arrow laws-prop_arr_law1 =- forAll myStream (evalT $ prop_always_equal (arr (**2)) (arr (^2)))- where myStream :: Gen (SignalSampleStream Float)- myStream = uniDistStream prop_arr_id = forAll myStream (evalT $ prop_always_equal (arr id) identity)
+ tests/testYampaMain.hs view
@@ -0,0 +1,78 @@+{-# OPTIONS_GHC -fno-warn-tabs #-}+{- $Id: testYampaMain.hs,v 1.9 2003/11/10 21:28:58 antony Exp $+******************************************************************************+* Y A M P A *+* *+* Module: testYampaMain *+* Purpose: Main driver routine for running tests. *+* Authors: Henrik Nilsson and Antony Courtney *+* *+* Copyright (c) Yale University, 2003 *+* *+******************************************************************************+-}+module Main where++import Tests++import Control.Monad (when)+import System.Environment (getArgs, getProgName)+import System.Exit (exitWith, ExitCode(..))+import System.IO++-- main = runTests+-- main = runSpaceTests++data TestFlags = TestFlags { tReg :: Bool -- run regression tests+ , tSpace :: Bool -- run space tests+ , tHelp :: Bool -- print usage and exit+ }++defFlags = TestFlags { tReg = False, tSpace = False, tHelp = False}+allFlags = TestFlags { tReg = True, tSpace = True, tHelp = False}++parseArgs :: TestFlags -> [String] -> Either TestFlags String+parseArgs flags [] = Left flags+parseArgs flags (arg:args) =+ case arg of+ "-r" -> parseArgs (flags {tReg = True}) args+ "-s" -> parseArgs (flags {tSpace = True}) args+ "-h" -> parseArgs (flags {tHelp = True}) args+ _ -> Right ("invalid argument: " ++ arg)++usage :: String -> Maybe String -> IO ()+usage pname mbEmsg = do+ case mbEmsg of+ (Just emsg) -> hPutStrLn stderr (pname ++ ": " ++ emsg)+ _ -> return ()+ hPutStrLn stderr ("usage: " ++ pname ++ " [-r] [-s] [-h]")+ hPutStrLn stderr "\t-s run space tests"+ hPutStrLn stderr "\t-r run regression tests"+ hPutStrLn stderr "\t-h print this help message"+ hPutStrLn stderr "(no arguments runs all tests.)"++main :: IO ()+main = do+ pname <- getProgName+ args <- getArgs+ let eFlags = if (length args) < 1+ then Left allFlags+ else parseArgs defFlags args+ case eFlags of+ Right emsg -> usage pname (Just emsg)+ Left tFlags ->+ if tHelp tFlags+ then usage pname Nothing+ else do+ -- Run regresion tests, check if passed+ t <- if tReg tFlags+ then runRegTests+ else return True+ -- Run space tests+ when (tSpace tFlags)+ runSpaceTests+ -- Communicate if all tests have passed+ let exitCode = if t then ExitSuccess else (ExitFailure 1)+ exitWith exitCode++
yampa-test.cabal view
@@ -1,6 +1,45 @@-name: yampa-test-version: 0.13.3-synopsis: Testing library for Yampa.+-- Copyright (c) 2017, Ivan Perez+--+-- All rights reserved.+--+-- Redistribution and use in source and binary forms, with or without+-- modification, are permitted provided that the following conditions are met:+--+-- * Redistributions of source code must retain the above copyright notice,+-- this list of conditions and the following disclaimer.+--+-- * Redistributions in binary form must reproduce the above copyright+-- notice, this list of conditions and the following disclaimer in the+-- documentation and/or other materials provided with the distribution.+--+-- * Neither the name of Ivan Perez nor the names of other contributors may+-- be used to endorse or promote products derived from this software+-- without specific prior written permission.+--+-- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"+-- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE+-- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE+-- ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE+-- LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR+-- CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF+-- SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS+-- INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN+-- CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)+-- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE+-- POSSIBILITY OF SUCH DAMAGE.+cabal-version: >= 1.10+build-type: Simple++name: yampa-test+version: 0.13.4+author: Ivan Perez+maintainer: ivan.perez@keera.co.uk+homepage: http://github.com/ivanperez-keera/Yampa+license: BSD3+license-file: LICENSE+-- copyright+category: Testing+synopsis: Testing library for Yampa. description: Testing and debugging library for Yampa. .@@ -15,44 +54,118 @@ A detailed explanation of these ideas is included in the ICFP 2017 paper <https://dl.acm.org/citation.cfm?id=3110246 Testing and Debugging Functional Reactive Programming>. -homepage: http://github.com/ivanperez-keera/Yampa-license: BSD3-license-file: LICENSE-author: Ivan Perez-maintainer: ivan.perez@keera.co.uk--- copyright:-category: Testing-build-type: Simple-extra-source-files: CHANGELOG+extra-source-files:+ CHANGELOG -cabal-version: >=1.10 +source-repository head+ type: git+ location: git://github.com/ivanperez-keera/Yampa.git+ subdir: yampa-test+++-- You can disable the regression test suite with -f-test-regression+flag test-regression+ description: Enable regression test suite+ default: True+ manual: True++ library- exposed-modules: FRP.Yampa.Debug- FRP.Yampa.LTLFuture- FRP.Yampa.LTLPast- FRP.Yampa.Stream- FRP.Yampa.QuickCheck- build-depends: base >=4 && <5,- Yampa >= 0.13.3 && < 0.14,- QuickCheck,- normaldistribution- hs-source-dirs: src- default-language: Haskell2010+ exposed-modules:+ FRP.Yampa.Debug+ FRP.Yampa.LTLFuture+ FRP.Yampa.LTLPast+ FRP.Yampa.QuickCheck+ FRP.Yampa.Stream + build-depends:+ base >= 4 && < 5+ , normaldistribution+ , QuickCheck+ , Yampa >= 0.13.4 && < 0.14++ default-language:+ Haskell2010++ hs-source-dirs:+ src++ test-suite yampa-quicheck- type: exitcode-stdio-1.0- main-is: YampaQC.hs- ghc-options: -Wall- default-language: Haskell2010+ type:+ exitcode-stdio-1.0 - hs-source-dirs: tests+ main-is:+ YampaQC.hs+ build-depends:- base < 5,- random,- Cabal >= 1.19,- QuickCheck,- tasty,- tasty-quickcheck,- Yampa,- yampa-test+ base < 5+ , Cabal >= 1.19+ , QuickCheck+ , random+ , tasty+ , tasty-quickcheck+ , Yampa+ , yampa-test++ default-language:+ Haskell2010++ hs-source-dirs:+ tests++ ghc-options:+ -Wall+++test-suite regression+ type:+ exitcode-stdio-1.0++ main-is:+ testYampaMain.hs++ other-modules:+ Tests+ TestsAccum+ TestsArr+ TestsBasicSF+ TestsCOC+ TestsCommon+ TestsComp+ TestsDelay+ TestsDer+ TestsEmbed+ TestsEvSrc+ TestsFirstSecond+ TestsKSwitch+ TestsLaws+ TestsLoop+ TestsLoopIntegral+ TestsLoopLaws+ TestsLoopPre+ TestsPre+ TestsPSwitch+ TestsReact+ TestsRPSwitch+ TestsRSwitch+ TestsSscan+ TestsSwitch+ TestsTask+ TestsUtils+ TestsWFG++ default-language:+ Haskell2010++ hs-source-dirs:+ tests++ if !flag(test-regression)+ buildable:+ False+ else+ build-depends:+ base+ , Yampa