Yampa-0.11: tests/AFRPTestsSwitch.hs
{-# OPTIONS_GHC -fno-warn-tabs #-}
{- $Id: AFRPTestsSwitch.hs,v 1.2 2003/11/10 21:28:58 antony Exp $
******************************************************************************
* A F R P *
* *
* Module: AFRPTestsSwitch *
* Purpose: Test cases for switch *
* Authors: Antony Courtney and Henrik Nilsson *
* *
* Copyright (c) Yale University, 2003 *
* *
******************************************************************************
-}
module AFRPTestsSwitch (switch_tr, switch_trs) where
import FRP.Yampa
import FRP.Yampa.EventS
import AFRPTestsCommon
------------------------------------------------------------------------------
-- 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