yampa-test-0.13.5: tests/Test/FRP/Yampa/Scan.hs
-- |
-- Description : Test cases for signal functions using scan
-- Copyright : Yale University, 2003
-- Authors : Antony Courtney and Henrik Nilsson
module Test.FRP.Yampa.Scan
( tests
)
where
import Test.QuickCheck
import Test.Tasty (TestTree, testGroup)
import Test.Tasty.QuickCheck (testProperty)
import FRP.Yampa as Yampa
import TestsCommon
tests :: TestTree
tests = testGroup "Regression tests for FRP.Yampa.Scan"
[ testProperty "scan (3, fixed)" (property $ sscan_t3 ~= sscan_t3r)
, testProperty "scan (0, fixed)" (property $ sscan_t0 ~= sscan_t0r)
, testProperty "scan (1, fixed)" (property $ sscan_t1 ~= sscan_t1r)
, testProperty "scan (2, fixed)" (property $ sscan_t2 ~= sscan_t2r)
, testProperty "scan (4, fixed)" (property $ sscan_t4 == sscan_t4r)
, testProperty "scan (5, fixed)" (property $ sscan_t5 == sscan_t5r)
, testProperty "scan (6, fixed)" (property $ sscan_t6 == sscan_t6r)
, testProperty "scan (7, fixed)" (property $ sscan_t7 == sscan_t7r)
, testProperty "scan (8, fixed)" (property $ sscan_t8 == sscan_t8r)
, testProperty "scan (9, fixed)" (property $ sscan_t9 == sscan_t9r)
, testProperty "scan (10, fixed)" (property $ sscan_t10 == sscan_t10r)
, testProperty "scan (11, fixed)" (property $ sscan_t11 == sscan_t11r)
, testProperty "scan (12, fixed)" (property $ sscan_t12 == sscan_t12r)
, testProperty "scan (13, fixed)" (property $ sscan_t13 ~= sscan_t13r)
, testProperty "scan (14, fixed)" (property $ sscan_t14 ~= sscan_t14r)
, testProperty "scan (15, fixed)" (property $ sscan_t15 ~= sscan_t15r)
, testProperty "scan (16, fixed)" (property $ sscan_t16 ~= sscan_t16r)
, testProperty "scan (17, fixed)" (property $ sscan_t17 ~= sscan_t17r)
, testProperty "scan (18, fixed)" (property $ sscan_t18 ~= sscan_t18r)
]
-- ** Simple, stateful signal processing
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))
-- 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))
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
]