{-# OPTIONS_GHC -fno-warn-tabs #-}
{- $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 *
* University of Nottingham, 2005 *
* *
******************************************************************************
-}
module AFRPTestsAccum (
accum_tr,
accum_trs,
accum_st0,
accum_st0r,
accum_st1,
accum_st1r
) where
import Data.Maybe (fromJust)
import FRP.Yampa
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_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