{- $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 FRP.Yampa.Internals (Event(NoEvent, Event))

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

