{-# 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 :: Distribution -> Range -> Length -> Gen DTime
generateDeltas Distribution
DistConstant (Maybe DTime
mn, Maybe DTime
mx) Length
len = Maybe DTime -> Maybe DTime -> Gen DTime
generateDelta Maybe DTime
mn Maybe DTime
mx
generateDeltas Distribution
DistRandom (Maybe DTime
mn, Maybe DTime
mx) Length
len = Maybe DTime -> Maybe DTime -> Gen DTime
generateDelta Maybe DTime
mn Maybe DTime
mx
generateDeltas (DistNormal (DTime
avg, DTime
dev)) (Maybe DTime
mn, Maybe DTime
mx) Length
len = DTime -> DTime -> Maybe DTime -> Maybe DTime -> Gen DTime
generateDSNormal DTime
avg DTime
dev Maybe DTime
mn Maybe DTime
mx
generateDelta :: Maybe DTime -> Maybe DTime -> Gen DTime
generateDelta :: Maybe DTime -> Maybe DTime -> Gen DTime
generateDelta (Just DTime
x) (Just DTime
y) = forall a. Random a => (a, a) -> Gen a
choose (DTime
x, DTime
y)
generateDelta (Just DTime
x) (Maybe DTime
Nothing) = (DTime
xforall a. Num a => a -> a -> a
+) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Arbitrary a => Gen a
arbitrary
generateDelta (Maybe DTime
Nothing) (Just DTime
y) = forall a. Random a => (a, a) -> Gen a
choose (DTime
2.2251e-308, DTime
y)
generateDelta (Maybe DTime
Nothing) (Maybe DTime
Nothing) = forall a. Positive a -> a
getPositive forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Arbitrary a => Gen a
arbitrary
generateDSNormal :: DTime -> DTime -> Maybe DTime -> Maybe DTime -> Gen DTime
generateDSNormal :: DTime -> DTime -> Maybe DTime -> Maybe DTime -> Gen DTime
generateDSNormal DTime
avg DTime
stddev Maybe DTime
m Maybe DTime
n = forall a. Gen a -> (a -> Bool) -> Gen a
suchThat Gen DTime
gen (\DTime
x -> DTime -> Bool
mx DTime
x Bool -> Bool -> Bool
&& DTime -> Bool
mn DTime
x)
where
gen :: Gen DTime
gen = forall a. (QCGen -> Int -> a) -> Gen a
MkGen (\QCGen
r Int
_ -> let (DTime
x,QCGen
_) = forall g a.
(RandomGen g, Random a, Floating a) =>
(a, a) -> g -> (a, g)
normal' (DTime
avg, DTime
stddev) QCGen
r in DTime
x)
mn :: DTime -> Bool
mn = forall b a. b -> (a -> b) -> Maybe a -> b
maybe (\DTime
_ -> Bool
True) forall a. Ord a => a -> a -> Bool
(<=) Maybe DTime
m
mx :: DTime -> Bool
mx = forall b a. b -> (a -> b) -> Maybe a -> b
maybe (\DTime
_ -> Bool
True) forall a. Ord a => a -> a -> Bool
(>=) Maybe DTime
n
timeStampsUntil :: DTime -> Gen [DTime]
timeStampsUntil :: DTime -> Gen [DTime]
timeStampsUntil = Gen DTime -> DTime -> Gen [DTime]
timeStampsUntilWith forall a. Arbitrary a => Gen a
arbitrary
timeStampsUntilWith :: Gen DTime -> DTime -> Gen [DTime]
timeStampsUntilWith :: Gen DTime -> DTime -> Gen [DTime]
timeStampsUntilWith Gen DTime
arb DTime
ds = Gen DTime -> [DTime] -> DTime -> Gen [DTime]
timeStampsUntilWith' Gen DTime
arb [] DTime
ds
where
timeStampsUntilWith' :: Gen DTime -> [DTime] -> DTime -> Gen [DTime]
timeStampsUntilWith' :: Gen DTime -> [DTime] -> DTime -> Gen [DTime]
timeStampsUntilWith' Gen DTime
arb [DTime]
acc DTime
ds
| DTime
ds forall a. Ord a => a -> a -> Bool
< DTime
0 = forall (m :: * -> *) a. Monad m => a -> m a
return [DTime]
acc
| Bool
otherwise = do DTime
d <- Gen DTime
arb
let acc' :: [DTime]
acc' = [DTime]
acc seq :: forall a b. a -> b -> b
`seq` (DTime
dforall a. a -> [a] -> [a]
:[DTime]
acc)
[DTime]
acc' seq :: forall a b. a -> b -> b
`seq` Gen DTime -> [DTime] -> DTime -> Gen [DTime]
timeStampsUntilWith' Gen DTime
arb [DTime]
acc' (DTime
ds forall a. Num a => a -> a -> a
- DTime
d)
generateStream :: Arbitrary a
=> Distribution -> Range -> Length -> Gen (SignalSampleStream a)
generateStream :: forall a.
Arbitrary a =>
Distribution -> Range -> Length -> Gen (SignalSampleStream a)
generateStream = forall a.
Arbitrary a =>
(Int -> DTime -> Gen a)
-> Distribution -> Range -> Length -> Gen (SignalSampleStream a)
generateStreamWith (\Int
_ DTime
_ -> forall a. Arbitrary a => Gen a
arbitrary)
generateStreamWith :: Arbitrary a
=> (Int -> DTime -> Gen a) -> Distribution -> Range -> Length -> Gen (SignalSampleStream a)
generateStreamWith :: forall a.
Arbitrary a =>
(Int -> DTime -> Gen a)
-> Distribution -> Range -> Length -> Gen (SignalSampleStream a)
generateStreamWith Int -> DTime -> Gen a
arb Distribution
DistConstant Range
range Length
len = forall a.
(Int -> DTime -> Gen a)
-> (DTime, Int) -> Gen (SignalSampleStream a)
generateConstantStream Int -> DTime -> Gen a
arb forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Range -> Length -> Gen (DTime, Int)
generateStreamLenDT Range
range Length
len
generateStreamWith Int -> DTime -> Gen a
arb Distribution
DistRandom (Maybe DTime
m, Maybe DTime
n) Length
Nothing = do
Int
l <- forall a. Arbitrary a => Gen a
arbitrary
a
x <- Int -> DTime -> Gen a
arb Int
0 DTime
0
[DTime]
ds <- forall a. Int -> (Int -> Gen a) -> Gen [a]
vectorOfWith Int
l (\Int
_ -> Maybe DTime -> Maybe DTime -> Gen DTime
generateDelta Maybe DTime
m Maybe DTime
n)
let f :: Int -> Gen a
f Int
n = Int -> DTime -> Gen a
arb Int
n ([DTime]
dsforall a. [a] -> Int -> a
!!(Int
nforall a. Num a => a -> a -> a
-Int
1))
[a]
xs <- forall a. Int -> (Int -> Gen a) -> Gen [a]
vectorOfWith Int
l Int -> Gen a
f
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. [a] -> [DTime] -> SignalSampleStream a
groupDeltas (a
xforall a. a -> [a] -> [a]
:[a]
xs) [DTime]
ds
generateStreamWith Int -> DTime -> Gen a
arb Distribution
DistRandom (Maybe DTime
m, Maybe DTime
n) (Just (Left Int
l)) = do
a
x <- Int -> DTime -> Gen a
arb Int
0 DTime
0
[DTime]
ds <- forall a. Int -> (Int -> Gen a) -> Gen [a]
vectorOfWith Int
l (\Int
_ -> Maybe DTime -> Maybe DTime -> Gen DTime
generateDelta Maybe DTime
m Maybe DTime
n)
let f :: Int -> Gen a
f Int
n = Int -> DTime -> Gen a
arb Int
n ([DTime]
dsforall a. [a] -> Int -> a
!!(Int
nforall a. Num a => a -> a -> a
-Int
1))
[a]
xs <- forall a. Int -> (Int -> Gen a) -> Gen [a]
vectorOfWith Int
l Int -> Gen a
f
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. [a] -> [DTime] -> SignalSampleStream a
groupDeltas (a
xforall a. a -> [a] -> [a]
:[a]
xs) [DTime]
ds
generateStreamWith Int -> DTime -> Gen a
arb Distribution
DistRandom (Maybe DTime
m, Maybe DTime
n) (Just (Right DTime
maxds)) = do
[DTime]
ds <- Gen DTime -> DTime -> Gen [DTime]
timeStampsUntilWith (Maybe DTime -> Maybe DTime -> Gen DTime
generateDelta Maybe DTime
m Maybe DTime
n) DTime
maxds
let l :: Int
l = forall (t :: * -> *) a. Foldable t => t a -> Int
length [DTime]
ds
a
x <- Int -> DTime -> Gen a
arb Int
0 DTime
0
let f :: Int -> Gen a
f Int
n = Int -> DTime -> Gen a
arb Int
n ([DTime]
dsforall a. [a] -> Int -> a
!!(Int
nforall a. Num a => a -> a -> a
-Int
1))
[a]
xs <- forall a. Int -> (Int -> Gen a) -> Gen [a]
vectorOfWith Int
l Int -> Gen a
f
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. [a] -> [DTime] -> SignalSampleStream a
groupDeltas (a
xforall a. a -> [a] -> [a]
:[a]
xs) [DTime]
ds
generateStreamWith Int -> DTime -> Gen a
arb (DistNormal (DTime
avg, DTime
stddev)) (Maybe DTime
m, Maybe DTime
n) Length
Nothing = do
Int
l <- forall a. Arbitrary a => Gen a
arbitrary
a
x <- Int -> DTime -> Gen a
arb Int
0 DTime
0
[DTime]
ds <- forall a. Int -> (Int -> Gen a) -> Gen [a]
vectorOfWith Int
l (\Int
_ -> DTime -> DTime -> Maybe DTime -> Maybe DTime -> Gen DTime
generateDSNormal DTime
avg DTime
stddev Maybe DTime
m Maybe DTime
n)
let f :: Int -> Gen a
f Int
n = Int -> DTime -> Gen a
arb Int
n ([DTime]
dsforall a. [a] -> Int -> a
!!(Int
nforall a. Num a => a -> a -> a
-Int
1))
[a]
xs <- forall a. Int -> (Int -> Gen a) -> Gen [a]
vectorOfWith Int
l Int -> Gen a
f
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. [a] -> [DTime] -> SignalSampleStream a
groupDeltas (a
xforall a. a -> [a] -> [a]
:[a]
xs) [DTime]
ds
generateStreamWith Int -> DTime -> Gen a
arb (DistNormal (DTime
avg, DTime
stddev)) (Maybe DTime
m, Maybe DTime
n) (Just (Left Int
l)) = do
a
x <- Int -> DTime -> Gen a
arb Int
0 DTime
0
[DTime]
ds <- forall a. Int -> (Int -> Gen a) -> Gen [a]
vectorOfWith Int
l (\Int
_ -> DTime -> DTime -> Maybe DTime -> Maybe DTime -> Gen DTime
generateDSNormal DTime
avg DTime
stddev Maybe DTime
m Maybe DTime
n)
let f :: Int -> Gen a
f Int
n = Int -> DTime -> Gen a
arb Int
n ([DTime]
dsforall a. [a] -> Int -> a
!!(Int
nforall a. Num a => a -> a -> a
-Int
1))
[a]
xs <- forall a. Int -> (Int -> Gen a) -> Gen [a]
vectorOfWith Int
l Int -> Gen a
f
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. [a] -> [DTime] -> SignalSampleStream a
groupDeltas (a
xforall a. a -> [a] -> [a]
:[a]
xs) [DTime]
ds
generateStreamWith Int -> DTime -> Gen a
arb (DistNormal (DTime
avg, DTime
stddev)) (Maybe DTime
m, Maybe DTime
n) (Just (Right DTime
maxds)) = do
[DTime]
ds <- Gen DTime -> DTime -> Gen [DTime]
timeStampsUntilWith (DTime -> DTime -> Maybe DTime -> Maybe DTime -> Gen DTime
generateDSNormal DTime
avg DTime
stddev Maybe DTime
m Maybe DTime
n) DTime
maxds
let l :: Int
l = forall (t :: * -> *) a. Foldable t => t a -> Int
length [DTime]
ds
a
x <- Int -> DTime -> Gen a
arb Int
0 DTime
0
let f :: Int -> Gen a
f Int
n = Int -> DTime -> Gen a
arb Int
n ([DTime]
dsforall a. [a] -> Int -> a
!!(Int
nforall a. Num a => a -> a -> a
-Int
1))
[a]
xs <- forall a. Int -> (Int -> Gen a) -> Gen [a]
vectorOfWith Int
l Int -> Gen a
f
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. [a] -> [DTime] -> SignalSampleStream a
groupDeltas (a
xforall a. a -> [a] -> [a]
:[a]
xs) [DTime]
ds
generateConstantStream :: (Int -> DTime -> Gen a) -> (DTime, Int) -> Gen (SignalSampleStream a)
generateConstantStream :: forall a.
(Int -> DTime -> Gen a)
-> (DTime, Int) -> Gen (SignalSampleStream a)
generateConstantStream Int -> DTime -> Gen a
arb (DTime
x, Int
length) = do
[a]
ys <- forall a. Int -> (Int -> Gen a) -> Gen [a]
vectorOfWith Int
length (\Int
n -> Int -> DTime -> Gen a
arb Int
n DTime
x)
let ds :: [DTime]
ds = forall a. a -> [a]
repeat DTime
x
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. [a] -> [DTime] -> SignalSampleStream a
groupDeltas [a]
ys [DTime]
ds
generateStreamLenDT :: (Maybe DTime, Maybe DTime) -> Maybe (Either Int DTime) -> Gen (DTime, Int)
generateStreamLenDT :: Range -> Length -> Gen (DTime, Int)
generateStreamLenDT Range
range Length
len = do
DTime
x <- forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Maybe DTime -> Maybe DTime -> Gen DTime
generateDelta Range
range
Int
l <- case Length
len of
Length
Nothing -> ((Int
1 forall a. Num a => a -> a -> a
+) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Positive a -> a
getPositive) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Arbitrary a => Gen a
arbitrary
Just (Left Int
l) -> forall (f :: * -> *) a. Applicative f => a -> f a
pure Int
l
Just (Right DTime
ds) -> (forall a. Ord a => a -> a -> a
max Int
1) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall a b. (RealFrac a, Integral b) => a -> b
floor (DTime
ds forall a. Fractional a => a -> a -> a
/ DTime
x)))
forall (m :: * -> *) a. Monad m => a -> m a
return (DTime
x, Int
l)
uniDistStream :: Arbitrary a => Gen (SignalSampleStream a)
uniDistStream :: forall a. Arbitrary a => Gen (SignalSampleStream a)
uniDistStream = forall a.
Arbitrary a =>
Distribution -> Range -> Length -> Gen (SignalSampleStream a)
generateStream Distribution
DistRandom (forall a. Maybe a
Nothing, forall a. Maybe a
Nothing) forall a. Maybe a
Nothing
uniDistStreamMaxDT :: Arbitrary a => DTime -> Gen (SignalSampleStream a)
uniDistStreamMaxDT :: forall a. Arbitrary a => DTime -> Gen (SignalSampleStream a)
uniDistStreamMaxDT DTime
maxDT = forall a.
Arbitrary a =>
Distribution -> Range -> Length -> Gen (SignalSampleStream a)
generateStream Distribution
DistRandom (forall a. Maybe a
Nothing, forall a. a -> Maybe a
Just DTime
maxDT ) forall a. Maybe a
Nothing
fixedDelayStream :: Arbitrary a => DTime -> Gen (SignalSampleStream a)
fixedDelayStream :: forall a. Arbitrary a => DTime -> Gen (SignalSampleStream a)
fixedDelayStream DTime
dt = forall a.
Arbitrary a =>
Distribution -> Range -> Length -> Gen (SignalSampleStream a)
generateStream Distribution
DistConstant (forall a. a -> Maybe a
Just DTime
dt, forall a. a -> Maybe a
Just DTime
dt) forall a. Maybe a
Nothing
fixedDelayStreamWith :: Arbitrary a => (DTime -> a) -> DTime -> Gen (SignalSampleStream a)
fixedDelayStreamWith :: forall a.
Arbitrary a =>
(DTime -> a) -> DTime -> Gen (SignalSampleStream a)
fixedDelayStreamWith DTime -> a
f DTime
dt = forall a.
Arbitrary a =>
(Int -> DTime -> Gen a)
-> Distribution -> Range -> Length -> Gen (SignalSampleStream a)
generateStreamWith forall {m :: * -> *} {a}.
(Monad m, Integral a) =>
a -> DTime -> m a
f' Distribution
DistConstant (forall a. a -> Maybe a
Just DTime
dt, forall a. a -> Maybe a
Just DTime
dt) forall a. Maybe a
Nothing
where
f' :: a -> DTime -> m a
f' a
n DTime
t = forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ DTime -> a
f (forall a b. (Integral a, Num b) => a -> b
fromIntegral a
n forall a. Num a => a -> a -> a
* DTime
t)
vectorOfWith :: Int -> (Int -> Gen a) -> Gen [a]
vectorOfWith :: forall a. Int -> (Int -> Gen a) -> Gen [a]
vectorOfWith Int
k Int -> Gen a
genF = forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence [ Int -> Gen a
genF Int
i | Int
i <- [Int
1..Int
k] ]