{-# LANGUAGE DeriveFunctor, DeriveDataTypeable,DeriveGeneric  #-}
module Statistics.Test.Types (
    Test(..)
  , isSignificant
  , TestResult(..)
  , significant
  , PositionTest(..)
  ) where

import Control.DeepSeq  (NFData(..))
import Control.Monad    (liftM3)
import Data.Aeson       (FromJSON, ToJSON)
import Data.Binary      (Binary (..))
import Data.Data (Typeable, Data)
import GHC.Generics

import Statistics.Types (PValue)


-- | Result of hypothesis testing
data TestResult = Significant    -- ^ Null hypothesis should be rejected
                | NotSignificant -- ^ Data is compatible with hypothesis
                  deriving (TestResult -> TestResult -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TestResult -> TestResult -> Bool
$c/= :: TestResult -> TestResult -> Bool
== :: TestResult -> TestResult -> Bool
$c== :: TestResult -> TestResult -> Bool
Eq,Eq TestResult
TestResult -> TestResult -> Bool
TestResult -> TestResult -> Ordering
TestResult -> TestResult -> TestResult
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: TestResult -> TestResult -> TestResult
$cmin :: TestResult -> TestResult -> TestResult
max :: TestResult -> TestResult -> TestResult
$cmax :: TestResult -> TestResult -> TestResult
>= :: TestResult -> TestResult -> Bool
$c>= :: TestResult -> TestResult -> Bool
> :: TestResult -> TestResult -> Bool
$c> :: TestResult -> TestResult -> Bool
<= :: TestResult -> TestResult -> Bool
$c<= :: TestResult -> TestResult -> Bool
< :: TestResult -> TestResult -> Bool
$c< :: TestResult -> TestResult -> Bool
compare :: TestResult -> TestResult -> Ordering
$ccompare :: TestResult -> TestResult -> Ordering
Ord,Int -> TestResult -> ShowS
[TestResult] -> ShowS
TestResult -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TestResult] -> ShowS
$cshowList :: [TestResult] -> ShowS
show :: TestResult -> String
$cshow :: TestResult -> String
showsPrec :: Int -> TestResult -> ShowS
$cshowsPrec :: Int -> TestResult -> ShowS
Show,Typeable,Typeable TestResult
TestResult -> DataType
TestResult -> Constr
(forall b. Data b => b -> b) -> TestResult -> TestResult
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> TestResult -> u
forall u. (forall d. Data d => d -> u) -> TestResult -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> TestResult -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> TestResult -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> TestResult -> m TestResult
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> TestResult -> m TestResult
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c TestResult
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> TestResult -> c TestResult
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c TestResult)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c TestResult)
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> TestResult -> m TestResult
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> TestResult -> m TestResult
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> TestResult -> m TestResult
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> TestResult -> m TestResult
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> TestResult -> m TestResult
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> TestResult -> m TestResult
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> TestResult -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> TestResult -> u
gmapQ :: forall u. (forall d. Data d => d -> u) -> TestResult -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> TestResult -> [u]
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> TestResult -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> TestResult -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> TestResult -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> TestResult -> r
gmapT :: (forall b. Data b => b -> b) -> TestResult -> TestResult
$cgmapT :: (forall b. Data b => b -> b) -> TestResult -> TestResult
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c TestResult)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c TestResult)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c TestResult)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c TestResult)
dataTypeOf :: TestResult -> DataType
$cdataTypeOf :: TestResult -> DataType
toConstr :: TestResult -> Constr
$ctoConstr :: TestResult -> Constr
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c TestResult
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c TestResult
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> TestResult -> c TestResult
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> TestResult -> c TestResult
Data,forall x. Rep TestResult x -> TestResult
forall x. TestResult -> Rep TestResult x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep TestResult x -> TestResult
$cfrom :: forall x. TestResult -> Rep TestResult x
Generic)

instance Binary   TestResult where
  get :: Get TestResult
get = do
      Bool
sig <- forall t. Binary t => Get t
get
      if Bool
sig then forall (m :: * -> *) a. Monad m => a -> m a
return TestResult
Significant else forall (m :: * -> *) a. Monad m => a -> m a
return TestResult
NotSignificant
  put :: TestResult -> Put
put = forall t. Binary t => t -> Put
put forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a. Eq a => a -> a -> Bool
== TestResult
Significant)
instance FromJSON TestResult
instance ToJSON   TestResult
instance NFData   TestResult



-- | Result of statistical test.
data Test distr = Test
  { forall distr. Test distr -> PValue Double
testSignificance :: !(PValue Double)
    -- ^ Probability of getting value of test statistics at least as
    --   extreme as measured.
  , forall distr. Test distr -> Double
testStatistics   :: !Double
    -- ^ Statistic used for test.
  , forall distr. Test distr -> distr
testDistribution :: distr
    -- ^ Distribution of test statistics if null hypothesis is correct.
  }
  deriving (Test distr -> Test distr -> Bool
forall distr. Eq distr => Test distr -> Test distr -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Test distr -> Test distr -> Bool
$c/= :: forall distr. Eq distr => Test distr -> Test distr -> Bool
== :: Test distr -> Test distr -> Bool
$c== :: forall distr. Eq distr => Test distr -> Test distr -> Bool
Eq,Test distr -> Test distr -> Bool
Test distr -> Test distr -> Ordering
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall {distr}. Ord distr => Eq (Test distr)
forall distr. Ord distr => Test distr -> Test distr -> Bool
forall distr. Ord distr => Test distr -> Test distr -> Ordering
forall distr. Ord distr => Test distr -> Test distr -> Test distr
min :: Test distr -> Test distr -> Test distr
$cmin :: forall distr. Ord distr => Test distr -> Test distr -> Test distr
max :: Test distr -> Test distr -> Test distr
$cmax :: forall distr. Ord distr => Test distr -> Test distr -> Test distr
>= :: Test distr -> Test distr -> Bool
$c>= :: forall distr. Ord distr => Test distr -> Test distr -> Bool
> :: Test distr -> Test distr -> Bool
$c> :: forall distr. Ord distr => Test distr -> Test distr -> Bool
<= :: Test distr -> Test distr -> Bool
$c<= :: forall distr. Ord distr => Test distr -> Test distr -> Bool
< :: Test distr -> Test distr -> Bool
$c< :: forall distr. Ord distr => Test distr -> Test distr -> Bool
compare :: Test distr -> Test distr -> Ordering
$ccompare :: forall distr. Ord distr => Test distr -> Test distr -> Ordering
Ord,Int -> Test distr -> ShowS
forall distr. Show distr => Int -> Test distr -> ShowS
forall distr. Show distr => [Test distr] -> ShowS
forall distr. Show distr => Test distr -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Test distr] -> ShowS
$cshowList :: forall distr. Show distr => [Test distr] -> ShowS
show :: Test distr -> String
$cshow :: forall distr. Show distr => Test distr -> String
showsPrec :: Int -> Test distr -> ShowS
$cshowsPrec :: forall distr. Show distr => Int -> Test distr -> ShowS
Show,Typeable,Test distr -> DataType
Test distr -> Constr
forall {distr}. Data distr => Typeable (Test distr)
forall distr. Data distr => Test distr -> DataType
forall distr. Data distr => Test distr -> Constr
forall distr.
Data distr =>
(forall b. Data b => b -> b) -> Test distr -> Test distr
forall distr u.
Data distr =>
Int -> (forall d. Data d => d -> u) -> Test distr -> u
forall distr u.
Data distr =>
(forall d. Data d => d -> u) -> Test distr -> [u]
forall distr r r'.
Data distr =>
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Test distr -> r
forall distr r r'.
Data distr =>
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Test distr -> r
forall distr (m :: * -> *).
(Data distr, Monad m) =>
(forall d. Data d => d -> m d) -> Test distr -> m (Test distr)
forall distr (m :: * -> *).
(Data distr, MonadPlus m) =>
(forall d. Data d => d -> m d) -> Test distr -> m (Test distr)
forall distr (c :: * -> *).
Data distr =>
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (Test distr)
forall distr (c :: * -> *).
Data distr =>
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Test distr -> c (Test distr)
forall distr (t :: * -> *) (c :: * -> *).
(Data distr, Typeable t) =>
(forall d. Data d => c (t d)) -> Maybe (c (Test distr))
forall distr (t :: * -> * -> *) (c :: * -> *).
(Data distr, Typeable t) =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (Test distr))
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (Test distr)
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Test distr -> c (Test distr)
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c (Test distr))
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Test distr -> m (Test distr)
$cgmapMo :: forall distr (m :: * -> *).
(Data distr, MonadPlus m) =>
(forall d. Data d => d -> m d) -> Test distr -> m (Test distr)
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Test distr -> m (Test distr)
$cgmapMp :: forall distr (m :: * -> *).
(Data distr, MonadPlus m) =>
(forall d. Data d => d -> m d) -> Test distr -> m (Test distr)
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Test distr -> m (Test distr)
$cgmapM :: forall distr (m :: * -> *).
(Data distr, Monad m) =>
(forall d. Data d => d -> m d) -> Test distr -> m (Test distr)
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Test distr -> u
$cgmapQi :: forall distr u.
Data distr =>
Int -> (forall d. Data d => d -> u) -> Test distr -> u
gmapQ :: forall u. (forall d. Data d => d -> u) -> Test distr -> [u]
$cgmapQ :: forall distr u.
Data distr =>
(forall d. Data d => d -> u) -> Test distr -> [u]
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Test distr -> r
$cgmapQr :: forall distr r r'.
Data distr =>
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Test distr -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Test distr -> r
$cgmapQl :: forall distr r r'.
Data distr =>
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Test distr -> r
gmapT :: (forall b. Data b => b -> b) -> Test distr -> Test distr
$cgmapT :: forall distr.
Data distr =>
(forall b. Data b => b -> b) -> Test distr -> Test distr
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (Test distr))
$cdataCast2 :: forall distr (t :: * -> * -> *) (c :: * -> *).
(Data distr, Typeable t) =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (Test distr))
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c (Test distr))
$cdataCast1 :: forall distr (t :: * -> *) (c :: * -> *).
(Data distr, Typeable t) =>
(forall d. Data d => c (t d)) -> Maybe (c (Test distr))
dataTypeOf :: Test distr -> DataType
$cdataTypeOf :: forall distr. Data distr => Test distr -> DataType
toConstr :: Test distr -> Constr
$ctoConstr :: forall distr. Data distr => Test distr -> Constr
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (Test distr)
$cgunfold :: forall distr (c :: * -> *).
Data distr =>
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (Test distr)
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Test distr -> c (Test distr)
$cgfoldl :: forall distr (c :: * -> *).
Data distr =>
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Test distr -> c (Test distr)
Data,forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall distr x. Rep (Test distr) x -> Test distr
forall distr x. Test distr -> Rep (Test distr) x
$cto :: forall distr x. Rep (Test distr) x -> Test distr
$cfrom :: forall distr x. Test distr -> Rep (Test distr) x
Generic,forall a b. a -> Test b -> Test a
forall a b. (a -> b) -> Test a -> Test b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: forall a b. a -> Test b -> Test a
$c<$ :: forall a b. a -> Test b -> Test a
fmap :: forall a b. (a -> b) -> Test a -> Test b
$cfmap :: forall a b. (a -> b) -> Test a -> Test b
Functor)

instance (Binary   d) => Binary   (Test d) where
  get :: Get (Test d)
get = forall (m :: * -> *) a1 a2 a3 r.
Monad m =>
(a1 -> a2 -> a3 -> r) -> m a1 -> m a2 -> m a3 -> m r
liftM3 forall distr. PValue Double -> Double -> distr -> Test distr
Test forall t. Binary t => Get t
get forall t. Binary t => Get t
get forall t. Binary t => Get t
get
  put :: Test d -> Put
put (Test PValue Double
sign Double
stat d
distr) = forall t. Binary t => t -> Put
put PValue Double
sign forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall t. Binary t => t -> Put
put Double
stat forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall t. Binary t => t -> Put
put d
distr
instance (FromJSON d) => FromJSON (Test d)
instance (ToJSON   d) => ToJSON   (Test d)
instance (NFData   d) => NFData   (Test d) where
  rnf :: Test d -> ()
rnf (Test PValue Double
_ Double
_ d
a) = forall a. NFData a => a -> ()
rnf d
a

-- | Check whether test is significant for given p-value.
isSignificant :: PValue Double -> Test d -> TestResult
isSignificant :: forall d. PValue Double -> Test d -> TestResult
isSignificant PValue Double
p Test d
t
  = Bool -> TestResult
significant forall a b. (a -> b) -> a -> b
$ PValue Double
p forall a. Ord a => a -> a -> Bool
>= forall distr. Test distr -> PValue Double
testSignificance Test d
t


-- | Test type for test which compare positional (mean,median etc.)
--   information of samples.
data PositionTest
  = SamplesDiffer
    -- ^ Test whether samples differ in position. Null hypothesis is
    --   samples are not different
  | AGreater
    -- ^ Test if first sample (A) is larger than second (B). Null
    --   hypothesis is first sample is not larger than second.
  | BGreater
    -- ^ Test if second sample is larger than first.
  deriving (PositionTest -> PositionTest -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PositionTest -> PositionTest -> Bool
$c/= :: PositionTest -> PositionTest -> Bool
== :: PositionTest -> PositionTest -> Bool
$c== :: PositionTest -> PositionTest -> Bool
Eq,Eq PositionTest
PositionTest -> PositionTest -> Bool
PositionTest -> PositionTest -> Ordering
PositionTest -> PositionTest -> PositionTest
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: PositionTest -> PositionTest -> PositionTest
$cmin :: PositionTest -> PositionTest -> PositionTest
max :: PositionTest -> PositionTest -> PositionTest
$cmax :: PositionTest -> PositionTest -> PositionTest
>= :: PositionTest -> PositionTest -> Bool
$c>= :: PositionTest -> PositionTest -> Bool
> :: PositionTest -> PositionTest -> Bool
$c> :: PositionTest -> PositionTest -> Bool
<= :: PositionTest -> PositionTest -> Bool
$c<= :: PositionTest -> PositionTest -> Bool
< :: PositionTest -> PositionTest -> Bool
$c< :: PositionTest -> PositionTest -> Bool
compare :: PositionTest -> PositionTest -> Ordering
$ccompare :: PositionTest -> PositionTest -> Ordering
Ord,Int -> PositionTest -> ShowS
[PositionTest] -> ShowS
PositionTest -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PositionTest] -> ShowS
$cshowList :: [PositionTest] -> ShowS
show :: PositionTest -> String
$cshow :: PositionTest -> String
showsPrec :: Int -> PositionTest -> ShowS
$cshowsPrec :: Int -> PositionTest -> ShowS
Show,Typeable,Typeable PositionTest
PositionTest -> DataType
PositionTest -> Constr
(forall b. Data b => b -> b) -> PositionTest -> PositionTest
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> PositionTest -> u
forall u. (forall d. Data d => d -> u) -> PositionTest -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> PositionTest -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> PositionTest -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> PositionTest -> m PositionTest
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> PositionTest -> m PositionTest
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c PositionTest
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> PositionTest -> c PositionTest
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c PositionTest)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c PositionTest)
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> PositionTest -> m PositionTest
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> PositionTest -> m PositionTest
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> PositionTest -> m PositionTest
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> PositionTest -> m PositionTest
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> PositionTest -> m PositionTest
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> PositionTest -> m PositionTest
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> PositionTest -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> PositionTest -> u
gmapQ :: forall u. (forall d. Data d => d -> u) -> PositionTest -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> PositionTest -> [u]
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> PositionTest -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> PositionTest -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> PositionTest -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> PositionTest -> r
gmapT :: (forall b. Data b => b -> b) -> PositionTest -> PositionTest
$cgmapT :: (forall b. Data b => b -> b) -> PositionTest -> PositionTest
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c PositionTest)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c PositionTest)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c PositionTest)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c PositionTest)
dataTypeOf :: PositionTest -> DataType
$cdataTypeOf :: PositionTest -> DataType
toConstr :: PositionTest -> Constr
$ctoConstr :: PositionTest -> Constr
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c PositionTest
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c PositionTest
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> PositionTest -> c PositionTest
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> PositionTest -> c PositionTest
Data,forall x. Rep PositionTest x -> PositionTest
forall x. PositionTest -> Rep PositionTest x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep PositionTest x -> PositionTest
$cfrom :: forall x. PositionTest -> Rep PositionTest x
Generic)

instance Binary   PositionTest where
  get :: Get PositionTest
get = do
    Int
i <- forall t. Binary t => Get t
get
    case (Int
i :: Int) of
      Int
0 -> forall (m :: * -> *) a. Monad m => a -> m a
return PositionTest
SamplesDiffer
      Int
1 -> forall (m :: * -> *) a. Monad m => a -> m a
return PositionTest
AGreater
      Int
2 -> forall (m :: * -> *) a. Monad m => a -> m a
return PositionTest
BGreater
      Int
_ -> forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Invalid PositionTest"
  put :: PositionTest -> Put
put PositionTest
SamplesDiffer = forall t. Binary t => t -> Put
put (Int
0 :: Int)
  put PositionTest
AGreater      = forall t. Binary t => t -> Put
put (Int
1 :: Int)
  put PositionTest
BGreater      = forall t. Binary t => t -> Put
put (Int
2 :: Int)
instance FromJSON PositionTest
instance ToJSON   PositionTest
instance NFData   PositionTest

-- | significant if parameter is 'True', not significant otherwise
significant :: Bool -> TestResult
significant :: Bool -> TestResult
significant Bool
True  = TestResult
Significant
significant Bool
False = TestResult
NotSignificant