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

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

import FRP.Yampa as Yampa

import TestsCommon

tests :: TestTree
tests = testGroup "Regression tests for FRP.Yampa.Scan"
  [ testProperty "scan (3, fixed)"  (property $ sscan_t3 ~= sscan_t3r)
  , testProperty "scan (0, fixed)"  (property $ sscan_t0 ~= sscan_t0r)
  , testProperty "scan (1, fixed)"  (property $ sscan_t1 ~= sscan_t1r)
  , testProperty "scan (2, fixed)"  (property $ sscan_t2 ~= sscan_t2r)
  , testProperty "scan (4, fixed)"  (property $ sscan_t4 == sscan_t4r)
  , testProperty "scan (5, fixed)"  (property $ sscan_t5 == sscan_t5r)
  , testProperty "scan (6, fixed)"  (property $ sscan_t6 == sscan_t6r)
  , testProperty "scan (7, fixed)"  (property $ sscan_t7 == sscan_t7r)
  , testProperty "scan (8, fixed)"  (property $ sscan_t8 == sscan_t8r)
  , testProperty "scan (9, fixed)"  (property $ sscan_t9 == sscan_t9r)
  , testProperty "scan (10, fixed)" (property $ sscan_t10 == sscan_t10r)
  , testProperty "scan (11, fixed)" (property $ sscan_t11 == sscan_t11r)
  , testProperty "scan (12, fixed)" (property $ sscan_t12 == sscan_t12r)
  , testProperty "scan (13, fixed)" (property $ sscan_t13 ~= sscan_t13r)
  , testProperty "scan (14, fixed)" (property $ sscan_t14 ~= sscan_t14r)
  , testProperty "scan (15, fixed)" (property $ sscan_t15 ~= sscan_t15r)
  , testProperty "scan (16, fixed)" (property $ sscan_t16 ~= sscan_t16r)
  , testProperty "scan (17, fixed)" (property $ sscan_t17 ~= sscan_t17r)
  , testProperty "scan (18, fixed)" (property $ sscan_t18 ~= sscan_t18r)
  ]

-- ** Simple, stateful signal processing

sscan_t3, sscan_t3r :: [Double]
sscan_t3 = testSF1 (time
                    >>> arr (\t -> sin (0.5 * t * pi + pi))
                    >>> sscan max 0.0)

sscan_t3r =
  take 25
       (let xs = [ sin (0.5 * t * pi + pi) | t <- [0.0, 0.25 ..] ]
        in tail (scanl max 0 xs))

-- pre and iPre in terms of sscan
pre_sscan :: SF a a
pre_sscan = sscanPrim f uninit uninit
  where
    f c a = Just (a, c)
    uninit = error "pre_sscan: Uninitialized pre operator."

iPre_sscan :: a -> SF a a
iPre_sscan = (--> pre_sscan)

sscan_t0, sscan_t0r :: [Double]
sscan_t0 = testSF1 (iPre_sscan 17)
sscan_t0r =
  [ 17.0,0.0,1.0,2.0,3.0,4.0,5.0,6.0,7.0,8.0,9.0,10.0,11.0,12.0,13.0,14.0
  , 15.0,16.0,17.0,18.0,19.0,20.0,21.0,22.0,23.0
  ]

sscan_t1, sscan_t1r :: [Double]
sscan_t1 = testSF2 (iPre_sscan 17)
sscan_t1r =
  [ 17.0,0.0,0.0,0.0,0.0,0.0,1.0,1.0,1.0,1.0,1.0,2.0,2.0,2.0,2.0,2.0
  , 3.0,3.0,3.0,3.0,3.0,4.0,4.0,4.0,4.0
  ]

sscan_t2, sscan_t2r :: [Double]
sscan_t2 = testSF1 (time
                    >>> arr (\t -> sin (0.5 * t * pi + pi))
                    >>> loop (arr (\(x1,x2) -> let x' = max x1 x2 in (x',x'))
                              >>> second (iPre_sscan 0.0)))
sscan_t2r =
  take 25
       (let xs = [ sin (0.5 * t * pi + pi) | t <- [0.0, 0.25 ..] ]
        in tail (scanl max 0 xs))

hold_sscan :: a -> SF (Event a) a
hold_sscan a = sscanPrim f () a
  where
    f _ NoEvent   = Nothing
    f _ (Event a) = Just ((), a)

dHold_sscan :: a -> SF (Event a) a
dHold_sscan a = hold_sscan a >>> iPre_sscan a

-- This is a (somewhat strange) way of doing a counter that
-- stops after reaching a threshold. Note that the ingoing event
-- is *control dependent* on the output of the counter, so
-- "dHold" really has to have the capability of delivering an
-- output without looking at the current input at all.
sscan_t4, sscan_t4r :: [Int]
sscan_t4 = take 50 (embed sf (deltaEncode 0.25 (repeat ())))
  where
    sf = repeatedly 1.0 ()
         >>> (loop $
                arr (\(e,c) -> (e `tag` (c + 1)) `gate` (c < 10))
                >>> dHold_sscan 0
                >>> arr dup)
sscan_t4r = [ 0,0,0,0      -- 0s
            , 0,1,1,1      -- 1s
            , 1,2,2,2      -- 2s
            , 2,3,3,3      -- 3s
            , 3,4,4,4      -- 4s
            , 4,5,5,5      -- 5s
            , 5,6,6,6      -- 6s
            , 6,7,7,7      -- 7s
            , 7,8,8,8      -- 8s
            , 8,9,9,9      -- 9s
            , 9,10,10,10   -- 10s
            , 10,10,10,10  -- 11s
            , 10,10        -- 12s
            ]

-- Version of the above that tests that thigs still work OK also if
-- there is an initial event.
sscan_t5, sscan_t5r :: [Int]
sscan_t5 = take 50 (embed sf (deltaEncode 0.25 (repeat ())))
  where
    sf = (now () &&& repeatedly 1.0 ()) >>> arr (uncurry lMerge)
         >>> (loop $
                arr (\(e,c) -> (e `tag` (c + 1)) `gate` (c < 10))
                >>> dHold_sscan 0
                >>> arr dup)
sscan_t5r = [ 0,1,1,1      -- 0s
            , 1,2,2,2      -- 1s
            , 2,3,3,3      -- 2s
            , 3,4,4,4      -- 3s
            , 4,5,5,5      -- 4s
            , 5,6,6,6      -- 5s
            , 6,7,7,7      -- 6s
            , 7,8,8,8      -- 7s
            , 8,9,9,9      -- 8s
            , 9,10,10,10   -- 9s
            , 10,10,10,10  -- 10s
            , 10,10,10,10  -- 11s
            , 10,10        -- 12s
            ]

-- Version of the sscan_t4 in terms of sscan
sscan_t6, sscan_t6r :: [Int]
sscan_t6 = take 50 (embed sf (deltaEncode 0.25 (repeat ())))
  where
    sf = repeatedly 1.0 () >>> (sscanPrim f 0 0)

    f c NoEvent               = Nothing
    f c (Event _) | c < 10    = Just (c', c')
                  | otherwise = Nothing
      where
        c' = c + 1

sscan_t6r = [ 0,0,0,0      -- 0s
            , 1,1,1,1      -- 1s
            , 2,2,2,2      -- 2s
            , 3,3,3,3      -- 3s
            , 4,4,4,4      -- 4s
            , 5,5,5,5      -- 5s
            , 6,6,6,6      -- 6s
            , 7,7,7,7      -- 7s
            , 8,8,8,8      -- 8s
            , 9,9,9,9      -- 9s
            , 10,10,10,10  -- 10s
            , 10,10,10,10  -- 11s
            , 10,10        -- 12s
            ]

-- Version of sscan_t5 directly in terms of sscan.
sscan_t7, sscan_t7r :: [Int]
sscan_t7 = take 50 (embed sf (deltaEncode 0.25 (repeat ())))
  where
    sf = (now () &&& repeatedly 1.0 ()) >>> arr (uncurry lMerge)
         >>> (sscanPrim f 0 0)

    f c NoEvent               = Nothing
    f c (Event _) | c < 10    = Just (c', c')
                  | otherwise = Nothing
      where
        c' = c + 1

sscan_t7r = [ 1,1,1,1      -- 0s
            , 2,2,2,2      -- 1s
            , 3,3,3,3      -- 2s
            , 4,4,4,4      -- 3s
            , 5,5,5,5      -- 4s
            , 6,6,6,6      -- 5s
            , 7,7,7,7      -- 6s
            , 8,8,8,8      -- 7s
            , 9,9,9,9      -- 8s
            , 10,10,10,10  -- 9s
            , 10,10,10,10  -- 10s
            , 10,10,10,10  -- 11s
            , 10,10        -- 12s
            ]

edge_sscan :: SF Bool (Event ())
edge_sscan = sscanPrim f 2 NoEvent
  where
    f 0 False = Nothing
    f 0 True  = Just (1, Event ())
    f 1 False = Just (0, NoEvent)
    f 1 True  = Just (2, NoEvent)
    f 2 False = Just (0, NoEvent)
    f 2 True  = Nothing

sscan_t8 :: [Event ()]
sscan_t8 = testSF1 (localTime >>> arr (>=0) >>> edge_sscan)

sscan_t8r =
  [ NoEvent, NoEvent, NoEvent, NoEvent  -- 0.0 s
  , NoEvent, NoEvent, NoEvent, NoEvent  -- 1.0 s
  , NoEvent, NoEvent, NoEvent, NoEvent  -- 2.0 s
  , NoEvent, NoEvent, NoEvent, NoEvent  -- 3.0 s
  , NoEvent, NoEvent, NoEvent, NoEvent  -- 4.0 s
  , NoEvent, NoEvent, NoEvent, NoEvent  -- 5.0 s
  , NoEvent
  ]

sscan_t9 :: [Event ()]
sscan_t9 = testSF1 (localTime >>> arr (>=4.26) >>> edge_sscan)

sscan_t9r =
  [ NoEvent, NoEvent, NoEvent,  NoEvent  -- 0.0 s
  , NoEvent, NoEvent, NoEvent,  NoEvent  -- 1.0 s
  , NoEvent, NoEvent, NoEvent,  NoEvent  -- 2.0 s
  , NoEvent, NoEvent, NoEvent,  NoEvent  -- 3.0 s
  , NoEvent, NoEvent, Event (), NoEvent  -- 4.0 s
  , NoEvent, NoEvent, NoEvent,  NoEvent  -- 5.0 s
  , NoEvent
  ]

edgeBy_sscan :: (a -> a -> Maybe b) -> a -> SF a (Event b)
edgeBy_sscan f a = sscanPrim g a NoEvent
  where
    g a_prev a = Just (a, maybeToEvent (f a_prev a))

-- Raising edge detector.
sscan_isEdge False False = Nothing
sscan_isEdge False True  = Just ()
sscan_isEdge True  True  = Nothing
sscan_isEdge True  False = Nothing

sscan_t10 :: [Event ()]
sscan_t10 = testSF1 (localTime
                     >>> arr (>=0)
                     >>> edgeBy_sscan sscan_isEdge False)

sscan_t10r =
  [ Event (), NoEvent, NoEvent, NoEvent  -- 0.0 s
  , NoEvent,  NoEvent, NoEvent, NoEvent  -- 1.0 s
  , NoEvent,  NoEvent, NoEvent, NoEvent  -- 2.0 s
  , NoEvent,  NoEvent, NoEvent, NoEvent  -- 3.0 s
  , NoEvent,  NoEvent, NoEvent, NoEvent  -- 4.0 s
  , NoEvent,  NoEvent, NoEvent, NoEvent  -- 5.0 s
  , NoEvent
  ]

sscan_t11 :: [Event ()]
sscan_t11 = testSF1 (localTime
                     >>> arr (>=4.26)
                     >>> edgeBy_sscan sscan_isEdge False)

sscan_t11r =
  [ NoEvent, NoEvent, NoEvent,  NoEvent  -- 0.0 s
  , NoEvent, NoEvent, NoEvent,  NoEvent  -- 1.0 s
  , NoEvent, NoEvent, NoEvent,  NoEvent  -- 2.0 s
  , NoEvent, NoEvent, NoEvent,  NoEvent  -- 3.0 s
  , NoEvent, NoEvent, Event (), NoEvent  -- 4.0 s
  , NoEvent, NoEvent, NoEvent,  NoEvent  -- 5.0 s
  , NoEvent
  ]

-- Raising and falling edge detector.
sscan_isEdge2 False False = Nothing
sscan_isEdge2 False True  = Just True
sscan_isEdge2 True  True  = Nothing
sscan_isEdge2 True  False = Just False

sscan_t12 :: [Event Bool]
sscan_t12 = testSF1 (localTime
                    >>> arr (\t -> t >=2.01 && t <= 4.51)
                    >>> edgeBy_sscan sscan_isEdge2 True)

sscan_t12r =
  [ Event False, NoEvent,    NoEvent, NoEvent      -- 0.0 s
  , NoEvent,     NoEvent,    NoEvent, NoEvent      -- 1.0 s
  , NoEvent,     Event True, NoEvent, NoEvent      -- 2.0 s
  , NoEvent,     NoEvent,    NoEvent, NoEvent      -- 3.0 s
  , NoEvent,     NoEvent,    NoEvent, Event False  -- 4.0 s
  , NoEvent,     NoEvent,    NoEvent, NoEvent      -- 5.0 s
  , NoEvent
  ]

smaximum_sscan :: Ord a => SF a a
smaximum_sscan =
  switch (identity &&& now () >>> arr (\(a,e) -> (a, e `tag` a)))
         (\a0 -> sscanPrim (\c a -> if a > c
                                      then (Just (a,a))
                                      else Nothing)
                           a0 a0)

sscan_t13, sscan_t13r :: [Double]
sscan_t13 = take 100 (embed sf (deltaEncode 0.1 (repeat ())))
  where
    sf = time
         >>> arr (\t -> (t + 1) * cos (pi * t + pi))
         >>> smaximum_sscan

sscan_t13r =
  take 100
       (let xs = [ (t + 1) * cos (pi * t + pi) | t <- [0.0, 0.1 ..] ]
        in tail (scanl max (-100) xs))

-- Some tests of signal functions that may be implemented using sscan
-- internally and their combinations with other sscan-based signal
-- functions and event processors.

sscan_t14, sscan_t14r :: [Event Int]
sscan_t14 = take 100 (embed sf (deltaEncode 0.1 (repeat ())))
  where
    sf :: SF () (Event Int)
    sf = time >>> arr (\t -> sin (2 * t))
         >>> arr (>0)
         >>> edge
         >>> arr (`tag` (+1))
         >>> accum 0

sscan_t14r =
  [ NoEvent,Event 1,NoEvent,NoEvent,NoEvent
  , NoEvent,NoEvent,NoEvent,NoEvent,NoEvent
  , NoEvent,NoEvent,NoEvent,NoEvent,NoEvent
  , NoEvent,NoEvent,NoEvent,NoEvent,NoEvent
  , NoEvent,NoEvent,NoEvent,NoEvent,NoEvent
  , NoEvent,NoEvent,NoEvent,NoEvent,NoEvent
  , NoEvent,NoEvent,Event 2,NoEvent,NoEvent
  , NoEvent,NoEvent,NoEvent,NoEvent,NoEvent
  , NoEvent,NoEvent,NoEvent,NoEvent,NoEvent
  , NoEvent,NoEvent,NoEvent,NoEvent,NoEvent
  , NoEvent,NoEvent,NoEvent,NoEvent,NoEvent
  , NoEvent,NoEvent,NoEvent,NoEvent,NoEvent
  , NoEvent,NoEvent,NoEvent,Event 3,NoEvent
  , NoEvent,NoEvent,NoEvent,NoEvent,NoEvent
  , NoEvent,NoEvent,NoEvent,NoEvent,NoEvent
  , NoEvent,NoEvent,NoEvent,NoEvent,NoEvent
  , NoEvent,NoEvent,NoEvent,NoEvent,NoEvent
  , NoEvent,NoEvent,NoEvent,NoEvent,NoEvent
  , NoEvent,NoEvent,NoEvent,NoEvent,NoEvent
  , Event 4,NoEvent,NoEvent,NoEvent,NoEvent
  ]

sscan_t15, sscan_t15r :: [Int]
sscan_t15 = take 100 (embed sf (deltaEncode 0.1 (repeat ())))
  where
    sf :: SF () Int
    sf = time >>> arr (\t -> sin (2 * t))
         >>> arr (>0)
         >>> edge
         >>> arr (`tag` (+1))
         >>> accumHold 0

sscan_t15r =
  [ 0,1,1,1,1,1,1,1,1,1
  , 1,1,1,1,1,1,1,1,1,1
  , 1,1,1,1,1,1,1,1,1,1
  , 1,1,2,2,2,2,2,2,2,2
  , 2,2,2,2,2,2,2,2,2,2
  , 2,2,2,2,2,2,2,2,2,2
  , 2,2,2,3,3,3,3,3,3,3
  , 3,3,3,3,3,3,3,3,3,3
  , 3,3,3,3,3,3,3,3,3,3
  , 3,3,3,3,3,4,4,4,4,4
  ]

sscan_t16, sscan_t16r :: [Int]
sscan_t16 = take 100 (embed sf (deltaEncode 0.1 (repeat ())))
  where
    sf :: SF () Int
    sf = time >>> arr (\t -> sin (2 * t))
         >>> arr (>0)
         >>> edge
         >>> arr (`tag` (+1))
         >>> dAccumHold 0

sscan_t16r =
  [ 0,0,1,1,1,1,1,1,1,1
  , 1,1,1,1,1,1,1,1,1,1
  , 1,1,1,1,1,1,1,1,1,1
  , 1,1,1,2,2,2,2,2,2,2
  , 2,2,2,2,2,2,2,2,2,2
  , 2,2,2,2,2,2,2,2,2,2
  , 2,2,2,2,3,3,3,3,3,3
  , 3,3,3,3,3,3,3,3,3,3
  , 3,3,3,3,3,3,3,3,3,3
  , 3,3,3,3,3,3,4,4,4,4
  ]

sscan_t17, sscan_t17r :: [Event Int]
sscan_t17 = take 100 (embed sf (deltaEncode 0.1 (repeat ())))
  where
    sf :: SF () (Event Int)
    sf = time >>> arr (\t -> sin (2 * t))
         >>> arr (>0)
         >>> iPre False
         >>> edge
         >>> arr (`tag` (+1))
         >>> accum 0

sscan_t17r =
  [ NoEvent,NoEvent,Event 1,NoEvent,NoEvent
  , NoEvent,NoEvent,NoEvent,NoEvent,NoEvent
  , NoEvent,NoEvent,NoEvent,NoEvent,NoEvent
  , NoEvent,NoEvent,NoEvent,NoEvent,NoEvent
  , NoEvent,NoEvent,NoEvent,NoEvent,NoEvent
  , NoEvent,NoEvent,NoEvent,NoEvent,NoEvent
  , NoEvent,NoEvent,NoEvent,Event 2,NoEvent
  , NoEvent,NoEvent,NoEvent,NoEvent,NoEvent
  , NoEvent,NoEvent,NoEvent,NoEvent,NoEvent
  , NoEvent,NoEvent,NoEvent,NoEvent,NoEvent
  , NoEvent,NoEvent,NoEvent,NoEvent,NoEvent
  , NoEvent,NoEvent,NoEvent,NoEvent,NoEvent
  , NoEvent,NoEvent,NoEvent,NoEvent,Event 3
  , NoEvent,NoEvent,NoEvent,NoEvent,NoEvent
  , NoEvent,NoEvent,NoEvent,NoEvent,NoEvent
  , NoEvent,NoEvent,NoEvent,NoEvent,NoEvent
  , NoEvent,NoEvent,NoEvent,NoEvent,NoEvent
  , NoEvent,NoEvent,NoEvent,NoEvent,NoEvent
  , NoEvent,NoEvent,NoEvent,NoEvent,NoEvent
  , NoEvent,Event 4,NoEvent,NoEvent,NoEvent
  ]

sscan_t18, sscan_t18r :: [Int]
sscan_t18 = take 100 (embed sf (deltaEncode 0.1 (repeat ())))
  where
    sf :: SF () Int
    sf = time >>> arr (\t -> sin (2 * t))
         >>> arr (>0)
         >>> iPre False
         >>> edge
         >>> arr (`tag` (+1))
         >>> accumHold 0

sscan_t18r =
  [ 0,0,1,1,1,1,1,1,1,1
  , 1,1,1,1,1,1,1,1,1,1
  , 1,1,1,1,1,1,1,1,1,1
  , 1,1,1,2,2,2,2,2,2,2
  , 2,2,2,2,2,2,2,2,2,2
  , 2,2,2,2,2,2,2,2,2,2
  , 2,2,2,2,3,3,3,3,3,3
  , 3,3,3,3,3,3,3,3,3,3
  , 3,3,3,3,3,3,3,3,3,3
  , 3,3,3,3,3,3,4,4,4,4
  ]