Yampa-0.11: tests/AFRPTestsPSwitch.hs
{-# OPTIONS_GHC -fno-warn-tabs #-}
{- $Id: AFRPTestsPSwitch.hs,v 1.2 2003/11/10 21:28:58 antony Exp $
******************************************************************************
* A F R P *
* *
* Module: AFRPTestsPSwitch *
* Purpose: Test cases for pSwitchB and dpSwitchB *
* Authors: Antony Courtney and Henrik Nilsson *
* *
* Copyright (c) Yale University, 2003 *
* *
******************************************************************************
-}
module AFRPTestsPSwitch (
pswitch_tr,
pswitch_trs,
pswitch_st0,
pswitch_st0r,
pswitch_st1,
pswitch_st1r
) where
import Data.List (findIndex)
import FRP.Yampa
import AFRPTestsCommon
------------------------------------------------------------------------------
-- 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)