-- |
-- Description : Test cases for hybrid signal functions
-- Copyright   : (c) Antony Courtney and Henrik Nilsson, Yale University, 2003-2004
-- Authors     : Antony Courtney and Henrik Nilsson
module Test.FRP.Yampa.Hybrid
    ( tests
    )
  where

import Data.Maybe (fromJust)
import Data.Tuple (swap)

import Test.QuickCheck
import Test.QuickCheck.Function
import Test.Tasty (TestTree, testGroup)
import Test.Tasty.QuickCheck (testProperty)

import FRP.Yampa as Yampa
import FRP.Yampa.Hybrid as Yampa

import FRP.Yampa.LTLFuture (evalT, TPred (Next, Always, SP))
import FRP.Yampa.QuickCheck (uniDistStream, uniDistStreamMaxDT)
import FRP.Yampa.Stream

import TestsCommon

tests :: TestTree
tests = testGroup "Regression tests for FRP.Yampa.Hybrid"
  [ testProperty "hold (0, fixed)"          (property $ wfg_t0 ~= wfg_t0r)
  , testProperty "hold (1, fixed)"          (property $ wfg_t1 ~= wfg_t1r)
  , testProperty "dHold (0, fixed)"         (property $ utils_t0 ~= utils_t0r)
  , testProperty "dHold (1, fixed)"         (property $ utils_t1 ~= utils_t1r)
  , testProperty "trackAndHold (0, fixed)"  (property $ wfg_t2 ~= wfg_t2r)
  , testProperty "trackAndHold (1, fixed)"  (property $ wfg_t3 ~= wfg_t3r)
  , testProperty "dTrackAndHold (0, fixed)" (property $ utils_t2 ~= utils_t2r)
  , testProperty "dTrackAndHold (1, fixed)" (property $ utils_t3 ~= utils_t3r)
  , testProperty "accum (0, fixed)"         (property $ accum_t0  == accum_t0r)
  , testProperty "accum (1, fixed)"         (property $ accum_t1  == accum_t1r)
  , testProperty "accum (2, fixed)"         (property $ accum_t2  == accum_t2r)
  , testProperty "accum (3, fixed)"         (property $ accum_t3  == accum_t3r)
  , testProperty "accum (8, fixed)"         (property $ accum_t8  == accum_t8r)
  , testProperty "accum (9, fixed)"         (property $ accum_t9  == accum_t9r)
  , testProperty "accum (11, fixed)"        (property $ accum_t11 == accum_t11r)
  , testProperty "accum (10, fixed)"        (property $ accum_t10 == accum_t10r)
  , testProperty "accum (12, fixed)"        (property $ accum_t12 == accum_t12r)
  , testProperty "accum (4, fixed)"         (property $ accum_t4  == accum_t4r)
  , testProperty "accum (5, fixed)"         (property $ accum_t5  == accum_t5r)
  , testProperty "accum (6, fixed)"         (property $ accum_t6  == accum_t6r)
  , testProperty "accum (7, fixed)"         (property $ accum_t7  == accum_t7r)
  , testProperty "accum (13, fixed)"        (property $ accum_t13 == accum_t13r)
  , testProperty "accum (14, fixed)"        (property $ accum_t14 == accum_t14r)
  , testProperty "accum (15, fixed)"        (property $ accum_t15 == accum_t15r)
  , testProperty "accum (16, fixed)"        (property $ accum_t16 == accum_t16r)
  , testProperty "accum (17, fixed)"        (property $ accum_t17 == accum_t17r)
  , testProperty "accumHold (0, qc)"        testAccumHold1
  , testProperty "accumHold (1, qc)"        testAccumHold2
  , testProperty "dAccumHold (0, qc)"       testDAccumHold1
  , testProperty "dAccumHold (1, qc)"       testDAccumHold2
  ]

-- * Wave-form generation

wfg_t0 :: [Double]
wfg_t0 = take 16 $ embed (hold 99.99) wfg_inp1

wfg_t0r =
  [ 99.99, 99.99, 1.0, 1.0
  , 2.0,   2.0,   2.0, 2.0
  , 3.0,   4.0,   4.0, 4.0
  , 0.0,   0.0,   0.0, 0.0
  ]

wfg_inp1 = deltaEncode 1.0 $
  [ NoEvent,   NoEvent,   Event 1.0, NoEvent
  , Event 2.0, NoEvent,   NoEvent,   NoEvent
  , Event 3.0, Event 4.0, Event 4.0, NoEvent
  , Event 0.0, NoEvent,   NoEvent,   NoEvent
  ]
  ++ repeat NoEvent

wfg_t1 :: [Double]
wfg_t1 = take 16 $ embed (hold 99.99) wfg_inp2

wfg_t1r =
  [ 1.0, 1.0, 1.0, 1.0
  , 2.0, 2.0, 2.0, 2.0
  , 3.0, 4.0, 4.0, 4.0
  , 0.0, 0.0, 0.0, 0.0
  ]

utils_inp1 = deltaEncode 1.0 $
  [ NoEvent,   NoEvent,   Event 1.0, NoEvent
  , Event 2.0, NoEvent,   NoEvent,   NoEvent
  , Event 3.0, Event 4.0, Event 4.0, NoEvent
  , Event 0.0, NoEvent,   NoEvent,   NoEvent
  ]
  ++ repeat NoEvent

utils_inp2 = deltaEncode 1.0 $
  [ Event 1.0, NoEvent,   NoEvent,   NoEvent
  , Event 2.0, NoEvent,   NoEvent,   NoEvent
  , Event 3.0, Event 4.0, Event 4.0, NoEvent
  , Event 0.0, NoEvent,   NoEvent,   NoEvent
  ]
  ++ repeat NoEvent

utils_t0 :: [Double]
utils_t0 = take 16 $ embed (dHold 99.99) utils_inp1

utils_t0r =
  [ 99.99, 99.99, 99.99, 1.0
  , 1.0,   2.0,   2.0,   2.0
  , 2.0,   3.0,   4.0,   4.0
  , 4.0,   0.0,   0.0,   0.0
  ]

utils_t1 :: [Double]
utils_t1 = take 16 $ embed (dHold 99.99) utils_inp2

utils_t1r =
  [ 99.99, 1.0, 1.0, 1.0
  , 1.0,   2.0, 2.0, 2.0
  , 2.0,   3.0, 4.0, 4.0
  , 4.0,   0.0, 0.0, 0.0
  ]

wfg_inp2 = deltaEncode 1.0 $
  [ Event 1.0, NoEvent,   NoEvent,   NoEvent
  , Event 2.0, NoEvent,   NoEvent,   NoEvent
  , Event 3.0, Event 4.0, Event 4.0, NoEvent
  , Event 0.0, NoEvent,   NoEvent,   NoEvent
  ]
  ++ repeat NoEvent

wfg_t2 :: [Double]
wfg_t2 = take 25 $ embed (trackAndHold 99.99) wfg_inp3

wfg_t2r =
  [ 99.99, 99.99, 1.0, 2.0, 3.0
  , 4.0,   4.0,   4.0, 4.0, 3.0
  , 2.0,   2.0,   1.0, 0.0, 1.0
  , 2.0,   3.0,   3.0, 3.0, 4.0
  , 4.0,   4.0,   4.0, 4.0, 4.0
  ]

wfg_inp3 = deltaEncode 1.0 $
  [ Nothing,  Nothing,  Just 1.0, Just 2.0, Just 3.0
  , Just 4.0, Nothing,  Nothing,  Nothing,  Just 3.0
  , Just 2.0, Nothing,  Just 1.0, Just 0.0, Just 1.0
  , Just 2.0, Just 3.0, Nothing,  Nothing,  Just 4.0
  ]
  ++ repeat Nothing

wfg_t3 :: [Double]
wfg_t3 = take 25 $ embed (trackAndHold 99.99) wfg_inp4

wfg_t3r =
  [ 0.0, 0.0, 1.0, 2.0, 3.0
  , 4.0, 4.0, 4.0, 4.0, 3.0
  , 2.0, 2.0, 1.0, 0.0, 1.0
  , 2.0, 3.0, 3.0, 3.0, 4.0
  , 4.0, 4.0, 4.0, 4.0, 4.0
  ]

wfg_inp4 = deltaEncode 1.0 $
  [ Just 0.0, Nothing,  Just 1.0, Just 2.0, Just 3.0
  , Just 4.0, Nothing,  Nothing,  Nothing,  Just 3.0
  , Just 2.0, Nothing,  Just 1.0, Just 0.0, Just 1.0
  , Just 2.0, Just 3.0, Nothing,  Nothing,  Just 4.0
  ]
  ++ repeat Nothing

utils_t2 :: [Double]
utils_t2 = take 25 $ embed (dTrackAndHold 99.99) utils_inp3

utils_t2r =
  [ 99.99, 99.99, 99.99, 1.0, 2.0
  , 3.0,   4.0,   4.0,   4.0, 4.0
  , 3.0,   2.0,   2.0,   1.0, 0.0
  , 1.0,   2.0,   3.0,   3.0, 3.0
  , 4.0,   4.0,   4.0,   4.0, 4.0
  ]

utils_inp3 = deltaEncode 1.0 $
  [ Nothing,  Nothing,  Just 1.0, Just 2.0, Just 3.0
  , Just 4.0, Nothing,  Nothing,  Nothing,  Just 3.0
  , Just 2.0, Nothing,  Just 1.0, Just 0.0, Just 1.0
  , Just 2.0, Just 3.0, Nothing,  Nothing,  Just 4.0
  ]
  ++ repeat Nothing

utils_t3 :: [Double]
utils_t3 = take 25 $ embed (dTrackAndHold 99.99) utils_inp4

utils_t3r =
  [ 99.99, 0.0, 0.0, 1.0, 2.0
  , 3.0,   4.0, 4.0, 4.0, 4.0
  , 3.0,   2.0, 2.0, 1.0, 0.0
  , 1.0,   2.0, 3.0, 3.0, 3.0
  , 4.0,   4.0, 4.0, 4.0, 4.0
  ]

utils_inp4 = deltaEncode 1.0 $
  [ Just 0.0, Nothing,  Just 1.0, Just 2.0, Just 3.0
  , Just 4.0, Nothing,  Nothing,  Nothing,  Just 3.0
  , Just 2.0, Nothing,  Just 1.0, Just 0.0, Just 1.0
  , Just 2.0, Just 3.0, Nothing,  Nothing,  Just 4.0
  ]
  ++ repeat Nothing

-- * Accumulators

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_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_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_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_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_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_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_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_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_inp5 = deltaEncode 0.25 (repeat ())

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_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_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_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_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_accFiltFun1 a d =
  let a' = a + floor d
  in if even 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
  ]

accum_accFiltFun2 a d =
  let a' = a + floor d
  in if odd a'
       then (a', Just (a' > 10, a'))
       else (a', Nothing)

-- 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_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!

testAccumHold1 :: Property
testAccumHold1 =
    forAll arbitrary $ \x ->
    forAll myStream  $
      evalT $
        Always $ prop ((sf x &&& sfByHand x), const close)

  where
    myStream :: Gen (SignalSampleStream ())
    myStream = uniDistStream

    sf :: Double -> SF () Double
    sf x = never >>> accumHold x

    sfByHand :: Double -> SF () Double
    sfByHand x = constant x

    close (x, y) = abs (x - y) < 0.05

testAccumHold2 :: Property
testAccumHold2 =
    forAll myStream  $ evalT $
      Always $ prop ((sf &&& sfByHand), const close)

  where
    myStream :: Gen (SignalSampleStream ())
    myStream = uniDistStreamMaxDT maxSamplingDelay

    sf :: SF () Double
    sf = repeatedly eventUpdateDelay (+1) >>> accumHold 0

    sfByHand :: SF () Double
    sfByHand = time >>> arr floorDouble

    floorDouble :: Double -> Double
    floorDouble x = fromIntegral ((floor x) :: Integer)

    -- Important that this number be smaller than eventUpdateDelay below.
    maxSamplingDelay :: DTime
    maxSamplingDelay = 0.9

    -- Important that this delay be greater than maxSamplingDelay above.
    eventUpdateDelay :: DTime
    eventUpdateDelay = 1.0

    close (x, y) = abs (x - y) < 0.05

-- Test that dAccumHold is like constant for the first sample
testDAccumHold1 :: Property
testDAccumHold1 =
    forAll arbitrary $ \x ->
    forAll myStream  $
      evalT $
        prop (arr (fmap apply) >>> (sf x &&& sfByHand x), const close)

  where
    myStream :: Gen (SignalSampleStream (Event (Fun Double Double)))
    myStream = uniDistStream

    sf :: Double -> SF (Event (Double -> Double)) Double
    sf x = dAccumHold x

    sfByHand :: Double -> SF (Event (Double -> Double)) Double
    sfByHand x = constant x

    close (x, y) = abs (x - y) < 0.05

-- Test that dAccumHold is like accumHold delayed
testDAccumHold2 :: Property
testDAccumHold2 =
    forAll arbitrary $ \x ->
    forAll myStream  $
      evalT $
        Next $ Always $
          prop (arr (fmap apply) >>> (sf x &&& sfByHand x), const close)

  where
    myStream :: Gen (SignalSampleStream (Event (Fun Double Double)))
    myStream = uniDistStream

    sf :: Double -> SF (Event (Double -> Double)) Double
    sf x = dAccumHold x

    sfByHand :: Double -> SF (Event (Double -> Double)) Double
    sfByHand x = accumHold x >>> loopPre x (arr swap)

    close (x, y) = abs (x - y) < 0.05

-- * Auxiliary
-- prop :: SF a b -> (a -> b ->
prop (a,b) = SP ((identity &&& a) >>^ uncurry b)

-- ** Arbitrary value generation
instance Arbitrary x => Arbitrary (Event x) where
  arbitrary = oneof [ return NoEvent, fmap Event $ arbitrary ]