Yampa-0.9.1.1: tests/AFRPTestsAccum.hs
{- $Id: AFRPTestsAccum.hs,v 1.2 2003/11/10 21:28:58 antony Exp $
******************************************************************************
* A F R P *
* *
* Module: AFRPTestsAccum *
* Purpose: Test cases for accumulators *
* Authors: Antony Courtney and Henrik Nilsson *
* *
* Copyright (c) Yale University, 2003 *
* *
******************************************************************************
-}
module AFRPTestsAccum (
accum_tr,
accum_trs,
accum_st0,
accum_st0r,
accum_st1,
accum_st1r
) where
import Maybe (fromJust)
import AFRP
import AFRPInternals (Event(NoEvent, Event))
import AFRPTestsCommon
------------------------------------------------------------------------------
-- 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_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_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_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