-- |
-- Description : Test cases for FRP.Yampa.Integration
-- Copyright   : (c) Ivan Perez, 2014-2022
--               (c) Antony Courtney and Henrik Nilsson, Yale University, 2003-2004
-- Authors     : Antony Courtney, Henrik Nilsson, Ivan Perez
module Test.FRP.Yampa.Integration
    ( tests
    )
  where

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

import FRP.Yampa as Yampa
import FRP.Yampa.Stream
import FRP.Yampa.QuickCheck
import FRP.Yampa.LTLFuture

import TestsCommon

tests :: TestTree
tests = testGroup "Regression tests for FRP.Yampa.Integration"
  [ testProperty "integral (0, qc)"           testIntegral0
  , testProperty "integral (1, qc)"           testIntegral1
  , testProperty "integral (2, qc)"           testIntegral2
  , testProperty "imIntegral (0, qc)"         testImIntegral0
  , testProperty "imIntegral (1, qc)"         testImIntegral1
  , testProperty "imIntegral (2, qc)"         testImIntegral2
  , testProperty "impulseIntegral (0, fixed)" (property $ utils_t7 ~= utils_t7r)
  , testProperty "count (0, fixed)"           (property $ utils_t4 ~= utils_t4r)
  , testProperty "count (1, fixed)"           (property $ utils_t5 ~= utils_t5r)
  , testProperty "derivative (fixed)"         (property $ der_t0_max_diff < 0.05)
  , testProperty "derivative (1, qc)"         prop_derivative_1
  , testProperty "derivative (2, qc)"         prop_derivative_2
  , testProperty "iterFrom (0, qc)"           testIterFrom0
  , testProperty "iterFrom (1, qc)"           testIterFrom1
  , testProperty "iterFrom (2, qc)"           testIterFrom2
  ]

-- * Integration

testIntegral0 :: Property
testIntegral0 =
    forAll myStream $ \s ->
      forAll number $ \n ->
        evalT (Next $ Always $ prop ((sf n &&& sfByHand n), const close)) s

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

    number :: Gen Double
    number = arbitrary

    sf :: Double -> SF Time Time
    sf n = constant n >>> integral

    sfByHand :: Double -> SF Time Time
    sfByHand n = localTime >>> arr (* n)

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

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

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

    sf :: SF Double Double
    sf = integral >>> derivative

    -- Delay stream by one sample
    sfByHand = loopPre 0 (arr $ \(x, y) -> (y, x))

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

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

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

    sf :: SF Double Double
    sf = arr (*2) >>> integral

    sfByHand :: SF Double Double
    sfByHand = integral >>> arr (*2)

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

testImIntegral0 :: Property
testImIntegral0 =
    forAll myStream $ \s ->
      forAll number $ \n ->
        evalT (Next $ Always $ prop ((sf n &&& sfByHand n), const close)) s

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

    number :: Gen Double
    number = arbitrary

    sf :: Double -> SF Time Time
    sf n = constant n >>> imIntegral 0

    sfByHand :: Double -> SF Time Time
    sfByHand n = localTime >>> arr (* n)

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

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

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

    sf :: SF Double Double
    sf = imIntegral 0 >>> derivative

    sfByHand = identity

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

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

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

    sf :: SF Double Double
    sf = arr (*2) >>> imIntegral 0

    sfByHand :: SF Double Double
    sfByHand = imIntegral 0 >>> arr (*2)

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

utils_t7 :: [Double]
utils_t7 = take 50 $ embed impulseIntegral
                           (deltaEncode 0.1 (zip (repeat 1.0) evSeq))
  where
    evSeq = replicate 9 NoEvent ++ [Event 10.0]
            ++ replicate 9 NoEvent ++ [Event (-10.0)]
            ++ evSeq

utils_t7r =
  [  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
  ]

utils_t4 :: [Event Int]
utils_t4 = take 16 $ embed count utils_inp1

utils_t4r :: [Event Int]
utils_t4r =
  [ NoEvent, NoEvent, Event 1, NoEvent
  , Event 2, NoEvent, NoEvent, NoEvent
  , Event 3, Event 4, Event 5, NoEvent
  , Event 6, NoEvent, NoEvent, NoEvent
  ]

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_t5 :: [Event Int]
utils_t5 = take 16 $ embed count utils_inp2

utils_t5r :: [Event Int]
utils_t5r =
  [ Event 1, NoEvent, NoEvent, NoEvent
  , Event 2, NoEvent, NoEvent, NoEvent
  , Event 3, Event 4, Event 5, NoEvent
  , Event 6, NoEvent, NoEvent, 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

-- * Differentiation

der_step = 0.001
der_N = 1000

der_t0 :: [Double]
der_t0 = take der_N $  -- First value is always 0
         embed derivative
               (deltaEncode der_step
                            [sin(2 * pi * t) | t <- [0.0, der_step ..]])
{-
-- For stepsize 0.1
der_t0r :: [Double]
der_t0r =
  [  0.0000,  5.8779,  3.6327, 0.0000, -3.6327
  , -5.8779, -5.8779, -3.6327, 0.0000,  3.6327
  ,  5.8779,  5.8779,  3.6327, 0.0000, -3.6327
  , -5.8779, -5.8779, -3.6327, 0.0000,  3.6327
  ]
-}

der_t0r :: [Double]
der_t0r = take der_N $
          [2 * pi * cos (2 * pi * t) | t <- [0.0, der_step ..]]

-- We're happy if we are in the right ball park.
der_t0_max_diff = (maximum (zipWith (\x y -> abs (x - y))
                                    (tail der_t0)
                                    (tail der_t0r)))

prop_derivative_1 =
    forAll myStream $ evalT $
      Next $ Always $ prop ((sfDer &&& sfDerByHand), const close)

  where myStream :: Gen (SignalSampleStream Double)
        myStream = fixedDelayStreamWith (\t -> sin(2 * pi * t)) der_step

        sfDer :: SF Time Time
        sfDer = derivative

        sfDerByHand = localTime >>> arr (\t -> (2 * pi * cos (2 * pi * t)))

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

prop_derivative_2 =
    forAll myStream $ evalT $
      Next $ Always $ prop ( sfDer &&& sfDerByHand
                           , const close)

  where
    myStream :: Gen (SignalSampleStream Double)
    myStream = fixedDelayStream der_step

    sfDer :: SF Time Time
    sfDer = localTime
              >>> arr (\t -> sin(2*pi*t))
                >>> derivative

    sfDerByHand = localTime
                    >>> arr (\t -> 2*pi*cos (2*pi*t))

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

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

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

    sf :: SF Double Double
    sf = iterFrom (\_ _ _ _ -> 0) 0

    sfByHand :: SF Double Double
    sfByHand = constant 0

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

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

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

    sf :: SF Double Double
    sf = iterFrom (\a0 _a1 dt b -> a0 * dt + b) 0

    sfByHand :: SF Double Double
    sfByHand = integral

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

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

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

    sf :: SF Double Double
    sf = iterFrom (\a0 a1 dt _b -> (a1 - a0) / dt) 0

    sfByHand :: SF Double Double
    sfByHand = derivative

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

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