{-# LANGUAGE Arrows #-}
{-# LANGUAGE MultiWayIf #-}
{-# LANGUAGE ScopedTypeVariables #-}
module FRP.Yampa.QuickCheck
(
generateStream
, generateStreamWith
, Distribution(..)
, Range
, Length
, uniDistStream
, uniDistStreamMaxDT
, fixedDelayStream
, fixedDelayStreamWith
)
where
import Control.Applicative ((<$>), pure)
import Data.Random.Normal
import FRP.Yampa
import Test.QuickCheck
import Test.QuickCheck.Gen
import FRP.Yampa.Stream
data Distribution = DistConstant
| DistNormal (DTime, DTime)
| DistRandom
type Range = (Maybe DTime, Maybe DTime)
type Length = Maybe (Either Int DTime)
generateDeltas :: Distribution -> Range -> Length -> Gen DTime
generateDeltas DistConstant (mn, mx) len = generateDelta mn mx
generateDeltas DistRandom (mn, mx) len = generateDelta mn mx
generateDeltas (DistNormal (avg, dev)) (mn, mx) len = generateDSNormal avg dev mn mx
generateDelta :: Maybe DTime -> Maybe DTime -> Gen DTime
generateDelta (Just x) (Just y) = choose (x, y)
generateDelta (Just x) (Nothing) = (x+) <$> arbitrary
generateDelta (Nothing) (Just y) = choose (2.2251e-308, y)
generateDelta (Nothing) (Nothing) = getPositive <$> arbitrary
generateDSNormal :: DTime -> DTime -> Maybe DTime -> Maybe DTime -> Gen DTime
generateDSNormal avg stddev m n = suchThat gen (\x -> mx x && mn x)
where
gen = MkGen (\r _ -> let (x,_) = normal' (avg, stddev) r in x)
mn = maybe (\_ -> True) (<=) m
mx = maybe (\_ -> True) (>=) n
timeStampsUntil :: DTime -> Gen [DTime]
timeStampsUntil = timeStampsUntilWith arbitrary
timeStampsUntilWith :: Gen DTime -> DTime -> Gen [DTime]
timeStampsUntilWith arb ds = timeStampsUntilWith' arb [] ds
where
timeStampsUntilWith' :: Gen DTime -> [DTime] -> DTime -> Gen [DTime]
timeStampsUntilWith' arb acc ds
| ds < 0 = return acc
| otherwise = do d <- arb
let acc' = acc `seq` (d:acc)
acc' `seq` timeStampsUntilWith' arb acc' (ds - d)
generateStream :: Arbitrary a
=> Distribution -> Range -> Length -> Gen (SignalSampleStream a)
generateStream = generateStreamWith (\_ _ -> arbitrary)
generateStreamWith :: Arbitrary a
=> (Int -> DTime -> Gen a) -> Distribution -> Range -> Length -> Gen (SignalSampleStream a)
generateStreamWith arb DistConstant range len = generateConstantStream arb =<< generateStreamLenDT range len
generateStreamWith arb DistRandom (m, n) Nothing = do
l <- arbitrary
x <- arb 0 0
ds <- vectorOfWith l (\_ -> generateDelta m n)
let f n = arb n (ds!!(n-1))
xs <- vectorOfWith l f
return $ groupDeltas (x:xs) ds
generateStreamWith arb DistRandom (m, n) (Just (Left l)) = do
x <- arb 0 0
ds <- vectorOfWith l (\_ -> generateDelta m n)
let f n = arb n (ds!!(n-1))
xs <- vectorOfWith l f
return $ groupDeltas (x:xs) ds
generateStreamWith arb DistRandom (m, n) (Just (Right maxds)) = do
ds <- timeStampsUntilWith (generateDelta m n) maxds
let l = length ds
x <- arb 0 0
let f n = arb n (ds!!(n-1))
xs <- vectorOfWith l f
return $ groupDeltas (x:xs) ds
generateStreamWith arb (DistNormal (avg, stddev)) (m, n) Nothing = do
l <- arbitrary
x <- arb 0 0
ds <- vectorOfWith l (\_ -> generateDSNormal avg stddev m n)
let f n = arb n (ds!!(n-1))
xs <- vectorOfWith l f
return $ groupDeltas (x:xs) ds
generateStreamWith arb (DistNormal (avg, stddev)) (m, n) (Just (Left l)) = do
x <- arb 0 0
ds <- vectorOfWith l (\_ -> generateDSNormal avg stddev m n)
let f n = arb n (ds!!(n-1))
xs <- vectorOfWith l f
return $ groupDeltas (x:xs) ds
generateStreamWith arb (DistNormal (avg, stddev)) (m, n) (Just (Right maxds)) = do
ds <- timeStampsUntilWith (generateDSNormal avg stddev m n) maxds
let l = length ds
x <- arb 0 0
let f n = arb n (ds!!(n-1))
xs <- vectorOfWith l f
return $ groupDeltas (x:xs) ds
generateConstantStream :: (Int -> DTime -> Gen a) -> (DTime, Int) -> Gen (SignalSampleStream a)
generateConstantStream arb (x, length) = do
ys <- vectorOfWith length (\n -> arb n x)
let ds = repeat x
return $ groupDeltas ys ds
generateStreamLenDT :: (Maybe DTime, Maybe DTime) -> Maybe (Either Int DTime) -> Gen (DTime, Int)
generateStreamLenDT range len = do
x <- uncurry generateDelta range
l <- case len of
Nothing -> ((1 +) . getPositive) <$> arbitrary
Just (Left l) -> pure l
Just (Right ds) -> (max 1) <$> (pure (floor (ds / x)))
return (x, l)
uniDistStream :: Arbitrary a => Gen (SignalSampleStream a)
uniDistStream = generateStream DistRandom (Nothing, Nothing) Nothing
uniDistStreamMaxDT :: Arbitrary a => DTime -> Gen (SignalSampleStream a)
uniDistStreamMaxDT maxDT = generateStream DistRandom (Nothing, Just maxDT ) Nothing
fixedDelayStream :: Arbitrary a => DTime -> Gen (SignalSampleStream a)
fixedDelayStream dt = generateStream DistConstant (Just dt, Just dt) Nothing
fixedDelayStreamWith :: Arbitrary a => (DTime -> a) -> DTime -> Gen (SignalSampleStream a)
fixedDelayStreamWith f dt = generateStreamWith f' DistConstant (Just dt, Just dt) Nothing
where
f' n t = return $ f (fromIntegral n * t)
vectorOfWith :: Int -> (Int -> Gen a) -> Gen [a]
vectorOfWith k genF = sequence [ genF i | i <- [1..k] ]