{-# LANGUAGE CPP #-}
{-# LANGUAGE Trustworthy #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE DeriveDataTypeable, DeriveGeneric, GADTs, RecordWildCards #-}
{-# OPTIONS_GHC -funbox-strict-fields #-}

-- |
-- Module      : Criterion.Types
-- Copyright   : (c) 2009-2014 Bryan O'Sullivan
--
-- License     : BSD-style
-- Maintainer  : bos@serpentine.com
-- Stability   : experimental
-- Portability : GHC
--
-- Types for benchmarking.
--
-- The core type is 'Benchmarkable', which admits both pure functions
-- and 'IO' actions.
--
-- For a pure function of type @a -> b@, the benchmarking harness
-- calls this function repeatedly, each time with a different 'Int64'
-- argument (the number of times to run the function in a loop), and
-- reduces the result the function returns to weak head normal form.
--
-- For an action of type @IO a@, the benchmarking harness calls the
-- action repeatedly, but does not reduce the result.

module Criterion.Types
    (
    -- * Configuration
      Config(..)
    , Verbosity(..)
    -- * Benchmark descriptions
    , Benchmarkable(..)
    , Benchmark(..)
    -- * Measurements
    , Measured(..)
    , fromInt
    , toInt
    , fromDouble
    , toDouble
    , measureAccessors
    , measureKeys
    , measure
    , rescale
    -- * Benchmark construction
    , env
    , envWithCleanup
    , perBatchEnv
    , perBatchEnvWithCleanup
    , perRunEnv
    , perRunEnvWithCleanup
    , toBenchmarkable
    , bench
    , bgroup
    , addPrefix
    , benchNames
    -- ** Evaluation control
    , nf
    , whnf
    , nfIO
    , whnfIO
    , nfAppIO
    , whnfAppIO
    -- * Result types
    , Outliers(..)
    , OutlierEffect(..)
    , OutlierVariance(..)
    , Regression(..)
    , KDE(..)
    , Report(..)
    , SampleAnalysis(..)
    , DataRecord(..)
    ) where

import Control.DeepSeq (NFData(rnf))
import Criterion.Measurement.Types
import Data.Aeson (FromJSON(..), ToJSON(..))
import Data.Binary (Binary(..), putWord8, getWord8)
import Data.Binary.Orphans ()
import Data.Data (Data, Typeable)
import Data.Int (Int64)
import Data.Map (Map)
import GHC.Generics (Generic)
import Prelude ()
import Prelude.Compat
import qualified Data.Vector as V
import qualified Data.Vector.Unboxed as U
import qualified Statistics.Types as St
import           Statistics.Resampling.Bootstrap ()

-- | Control the amount of information displayed.
data Verbosity = Quiet
               | Normal
               | Verbose
                 deriving (Verbosity -> Verbosity -> Bool
(Verbosity -> Verbosity -> Bool)
-> (Verbosity -> Verbosity -> Bool) -> Eq Verbosity
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Verbosity -> Verbosity -> Bool
$c/= :: Verbosity -> Verbosity -> Bool
== :: Verbosity -> Verbosity -> Bool
$c== :: Verbosity -> Verbosity -> Bool
Eq, Eq Verbosity
Eq Verbosity
-> (Verbosity -> Verbosity -> Ordering)
-> (Verbosity -> Verbosity -> Bool)
-> (Verbosity -> Verbosity -> Bool)
-> (Verbosity -> Verbosity -> Bool)
-> (Verbosity -> Verbosity -> Bool)
-> (Verbosity -> Verbosity -> Verbosity)
-> (Verbosity -> Verbosity -> Verbosity)
-> Ord Verbosity
Verbosity -> Verbosity -> Bool
Verbosity -> Verbosity -> Ordering
Verbosity -> Verbosity -> Verbosity
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 :: Verbosity -> Verbosity -> Verbosity
$cmin :: Verbosity -> Verbosity -> Verbosity
max :: Verbosity -> Verbosity -> Verbosity
$cmax :: Verbosity -> Verbosity -> Verbosity
>= :: Verbosity -> Verbosity -> Bool
$c>= :: Verbosity -> Verbosity -> Bool
> :: Verbosity -> Verbosity -> Bool
$c> :: Verbosity -> Verbosity -> Bool
<= :: Verbosity -> Verbosity -> Bool
$c<= :: Verbosity -> Verbosity -> Bool
< :: Verbosity -> Verbosity -> Bool
$c< :: Verbosity -> Verbosity -> Bool
compare :: Verbosity -> Verbosity -> Ordering
$ccompare :: Verbosity -> Verbosity -> Ordering
$cp1Ord :: Eq Verbosity
Ord, Verbosity
Verbosity -> Verbosity -> Bounded Verbosity
forall a. a -> a -> Bounded a
maxBound :: Verbosity
$cmaxBound :: Verbosity
minBound :: Verbosity
$cminBound :: Verbosity
Bounded, Int -> Verbosity
Verbosity -> Int
Verbosity -> [Verbosity]
Verbosity -> Verbosity
Verbosity -> Verbosity -> [Verbosity]
Verbosity -> Verbosity -> Verbosity -> [Verbosity]
(Verbosity -> Verbosity)
-> (Verbosity -> Verbosity)
-> (Int -> Verbosity)
-> (Verbosity -> Int)
-> (Verbosity -> [Verbosity])
-> (Verbosity -> Verbosity -> [Verbosity])
-> (Verbosity -> Verbosity -> [Verbosity])
-> (Verbosity -> Verbosity -> Verbosity -> [Verbosity])
-> Enum Verbosity
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: Verbosity -> Verbosity -> Verbosity -> [Verbosity]
$cenumFromThenTo :: Verbosity -> Verbosity -> Verbosity -> [Verbosity]
enumFromTo :: Verbosity -> Verbosity -> [Verbosity]
$cenumFromTo :: Verbosity -> Verbosity -> [Verbosity]
enumFromThen :: Verbosity -> Verbosity -> [Verbosity]
$cenumFromThen :: Verbosity -> Verbosity -> [Verbosity]
enumFrom :: Verbosity -> [Verbosity]
$cenumFrom :: Verbosity -> [Verbosity]
fromEnum :: Verbosity -> Int
$cfromEnum :: Verbosity -> Int
toEnum :: Int -> Verbosity
$ctoEnum :: Int -> Verbosity
pred :: Verbosity -> Verbosity
$cpred :: Verbosity -> Verbosity
succ :: Verbosity -> Verbosity
$csucc :: Verbosity -> Verbosity
Enum, ReadPrec [Verbosity]
ReadPrec Verbosity
Int -> ReadS Verbosity
ReadS [Verbosity]
(Int -> ReadS Verbosity)
-> ReadS [Verbosity]
-> ReadPrec Verbosity
-> ReadPrec [Verbosity]
-> Read Verbosity
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Verbosity]
$creadListPrec :: ReadPrec [Verbosity]
readPrec :: ReadPrec Verbosity
$creadPrec :: ReadPrec Verbosity
readList :: ReadS [Verbosity]
$creadList :: ReadS [Verbosity]
readsPrec :: Int -> ReadS Verbosity
$creadsPrec :: Int -> ReadS Verbosity
Read, Int -> Verbosity -> ShowS
[Verbosity] -> ShowS
Verbosity -> String
(Int -> Verbosity -> ShowS)
-> (Verbosity -> String)
-> ([Verbosity] -> ShowS)
-> Show Verbosity
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Verbosity] -> ShowS
$cshowList :: [Verbosity] -> ShowS
show :: Verbosity -> String
$cshow :: Verbosity -> String
showsPrec :: Int -> Verbosity -> ShowS
$cshowsPrec :: Int -> Verbosity -> ShowS
Show, Typeable, Typeable Verbosity
DataType
Constr
Typeable Verbosity
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> Verbosity -> c Verbosity)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c Verbosity)
-> (Verbosity -> Constr)
-> (Verbosity -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c Verbosity))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Verbosity))
-> ((forall b. Data b => b -> b) -> Verbosity -> Verbosity)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> Verbosity -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> Verbosity -> r)
-> (forall u. (forall d. Data d => d -> u) -> Verbosity -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> Verbosity -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> Verbosity -> m Verbosity)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Verbosity -> m Verbosity)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Verbosity -> m Verbosity)
-> Data Verbosity
Verbosity -> DataType
Verbosity -> Constr
(forall b. Data b => b -> b) -> Verbosity -> Verbosity
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Verbosity -> c Verbosity
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Verbosity
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) -> Verbosity -> u
forall u. (forall d. Data d => d -> u) -> Verbosity -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Verbosity -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Verbosity -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Verbosity -> m Verbosity
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Verbosity -> m Verbosity
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Verbosity
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Verbosity -> c Verbosity
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Verbosity)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Verbosity)
$cVerbose :: Constr
$cNormal :: Constr
$cQuiet :: Constr
$tVerbosity :: DataType
gmapMo :: (forall d. Data d => d -> m d) -> Verbosity -> m Verbosity
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Verbosity -> m Verbosity
gmapMp :: (forall d. Data d => d -> m d) -> Verbosity -> m Verbosity
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Verbosity -> m Verbosity
gmapM :: (forall d. Data d => d -> m d) -> Verbosity -> m Verbosity
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Verbosity -> m Verbosity
gmapQi :: Int -> (forall d. Data d => d -> u) -> Verbosity -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Verbosity -> u
gmapQ :: (forall d. Data d => d -> u) -> Verbosity -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> Verbosity -> [u]
gmapQr :: (r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Verbosity -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Verbosity -> r
gmapQl :: (r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Verbosity -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Verbosity -> r
gmapT :: (forall b. Data b => b -> b) -> Verbosity -> Verbosity
$cgmapT :: (forall b. Data b => b -> b) -> Verbosity -> Verbosity
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Verbosity)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Verbosity)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c Verbosity)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Verbosity)
dataTypeOf :: Verbosity -> DataType
$cdataTypeOf :: Verbosity -> DataType
toConstr :: Verbosity -> Constr
$ctoConstr :: Verbosity -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Verbosity
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Verbosity
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Verbosity -> c Verbosity
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Verbosity -> c Verbosity
$cp1Data :: Typeable Verbosity
Data,
                           (forall x. Verbosity -> Rep Verbosity x)
-> (forall x. Rep Verbosity x -> Verbosity) -> Generic Verbosity
forall x. Rep Verbosity x -> Verbosity
forall x. Verbosity -> Rep Verbosity x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Verbosity x -> Verbosity
$cfrom :: forall x. Verbosity -> Rep Verbosity x
Generic)

-- | Top-level benchmarking configuration.
data Config = Config {
      Config -> CL Double
confInterval :: St.CL Double
      -- ^ Confidence interval for bootstrap estimation (greater than
      -- 0, less than 1).
    , Config -> Double
timeLimit    :: Double
      -- ^ Number of seconds to run a single benchmark.  (In practice,
      -- execution time will very slightly exceed this limit.)
    , Config -> Int
resamples    :: Int
      -- ^ Number of resamples to perform when bootstrapping.
    , Config -> [([String], String)]
regressions  :: [([String], String)]
      -- ^ Regressions to perform.
    , Config -> Maybe String
rawDataFile  :: Maybe FilePath
      -- ^ File to write binary measurement and analysis data to.  If
      -- not specified, this will be a temporary file.
    , Config -> Maybe String
reportFile   :: Maybe FilePath
      -- ^ File to write report output to, with template expanded.
    , Config -> Maybe String
csvFile      :: Maybe FilePath
      -- ^ File to write CSV summary to.
    , Config -> Maybe String
jsonFile     :: Maybe FilePath
      -- ^ File to write JSON-formatted results to.
    , Config -> Maybe String
junitFile    :: Maybe FilePath
      -- ^ File to write JUnit-compatible XML results to.
    , Config -> Verbosity
verbosity    :: Verbosity
      -- ^ Verbosity level to use when running and analysing
      -- benchmarks.
    , Config -> String
template     :: FilePath
      -- ^ Template file to use if writing a report.
    } deriving (Config -> Config -> Bool
(Config -> Config -> Bool)
-> (Config -> Config -> Bool) -> Eq Config
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Config -> Config -> Bool
$c/= :: Config -> Config -> Bool
== :: Config -> Config -> Bool
$c== :: Config -> Config -> Bool
Eq, ReadPrec [Config]
ReadPrec Config
Int -> ReadS Config
ReadS [Config]
(Int -> ReadS Config)
-> ReadS [Config]
-> ReadPrec Config
-> ReadPrec [Config]
-> Read Config
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Config]
$creadListPrec :: ReadPrec [Config]
readPrec :: ReadPrec Config
$creadPrec :: ReadPrec Config
readList :: ReadS [Config]
$creadList :: ReadS [Config]
readsPrec :: Int -> ReadS Config
$creadsPrec :: Int -> ReadS Config
Read, Int -> Config -> ShowS
[Config] -> ShowS
Config -> String
(Int -> Config -> ShowS)
-> (Config -> String) -> ([Config] -> ShowS) -> Show Config
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Config] -> ShowS
$cshowList :: [Config] -> ShowS
show :: Config -> String
$cshow :: Config -> String
showsPrec :: Int -> Config -> ShowS
$cshowsPrec :: Int -> Config -> ShowS
Show, Typeable, Typeable Config
DataType
Constr
Typeable Config
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> Config -> c Config)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c Config)
-> (Config -> Constr)
-> (Config -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c Config))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Config))
-> ((forall b. Data b => b -> b) -> Config -> Config)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> Config -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> Config -> r)
-> (forall u. (forall d. Data d => d -> u) -> Config -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> Config -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> Config -> m Config)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Config -> m Config)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Config -> m Config)
-> Data Config
Config -> DataType
Config -> Constr
(forall b. Data b => b -> b) -> Config -> Config
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Config -> c Config
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Config
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) -> Config -> u
forall u. (forall d. Data d => d -> u) -> Config -> [u]
forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Config -> r
forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Config -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Config -> m Config
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Config -> m Config
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Config
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Config -> c Config
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Config)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Config)
$cConfig :: Constr
$tConfig :: DataType
gmapMo :: (forall d. Data d => d -> m d) -> Config -> m Config
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Config -> m Config
gmapMp :: (forall d. Data d => d -> m d) -> Config -> m Config
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Config -> m Config
gmapM :: (forall d. Data d => d -> m d) -> Config -> m Config
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Config -> m Config
gmapQi :: Int -> (forall d. Data d => d -> u) -> Config -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Config -> u
gmapQ :: (forall d. Data d => d -> u) -> Config -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> Config -> [u]
gmapQr :: (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Config -> r
$cgmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Config -> r
gmapQl :: (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Config -> r
$cgmapQl :: forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Config -> r
gmapT :: (forall b. Data b => b -> b) -> Config -> Config
$cgmapT :: (forall b. Data b => b -> b) -> Config -> Config
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Config)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Config)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c Config)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Config)
dataTypeOf :: Config -> DataType
$cdataTypeOf :: Config -> DataType
toConstr :: Config -> Constr
$ctoConstr :: Config -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Config
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Config
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Config -> c Config
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Config -> c Config
$cp1Data :: Typeable Config
Data, (forall x. Config -> Rep Config x)
-> (forall x. Rep Config x -> Config) -> Generic Config
forall x. Rep Config x -> Config
forall x. Config -> Rep Config x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Config x -> Config
$cfrom :: forall x. Config -> Rep Config x
Generic)


-- | Outliers from sample data, calculated using the boxplot
-- technique.
data Outliers = Outliers {
      Outliers -> Int64
samplesSeen :: !Int64
    , Outliers -> Int64
lowSevere   :: !Int64
    -- ^ More than 3 times the interquartile range (IQR) below the
    -- first quartile.
    , Outliers -> Int64
lowMild     :: !Int64
    -- ^ Between 1.5 and 3 times the IQR below the first quartile.
    , Outliers -> Int64
highMild    :: !Int64
    -- ^ Between 1.5 and 3 times the IQR above the third quartile.
    , Outliers -> Int64
highSevere  :: !Int64
    -- ^ More than 3 times the IQR above the third quartile.
    } deriving (Outliers -> Outliers -> Bool
(Outliers -> Outliers -> Bool)
-> (Outliers -> Outliers -> Bool) -> Eq Outliers
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Outliers -> Outliers -> Bool
$c/= :: Outliers -> Outliers -> Bool
== :: Outliers -> Outliers -> Bool
$c== :: Outliers -> Outliers -> Bool
Eq, ReadPrec [Outliers]
ReadPrec Outliers
Int -> ReadS Outliers
ReadS [Outliers]
(Int -> ReadS Outliers)
-> ReadS [Outliers]
-> ReadPrec Outliers
-> ReadPrec [Outliers]
-> Read Outliers
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Outliers]
$creadListPrec :: ReadPrec [Outliers]
readPrec :: ReadPrec Outliers
$creadPrec :: ReadPrec Outliers
readList :: ReadS [Outliers]
$creadList :: ReadS [Outliers]
readsPrec :: Int -> ReadS Outliers
$creadsPrec :: Int -> ReadS Outliers
Read, Int -> Outliers -> ShowS
[Outliers] -> ShowS
Outliers -> String
(Int -> Outliers -> ShowS)
-> (Outliers -> String) -> ([Outliers] -> ShowS) -> Show Outliers
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Outliers] -> ShowS
$cshowList :: [Outliers] -> ShowS
show :: Outliers -> String
$cshow :: Outliers -> String
showsPrec :: Int -> Outliers -> ShowS
$cshowsPrec :: Int -> Outliers -> ShowS
Show, Typeable, Typeable Outliers
DataType
Constr
Typeable Outliers
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> Outliers -> c Outliers)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c Outliers)
-> (Outliers -> Constr)
-> (Outliers -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c Outliers))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Outliers))
-> ((forall b. Data b => b -> b) -> Outliers -> Outliers)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> Outliers -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> Outliers -> r)
-> (forall u. (forall d. Data d => d -> u) -> Outliers -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> Outliers -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> Outliers -> m Outliers)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Outliers -> m Outliers)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Outliers -> m Outliers)
-> Data Outliers
Outliers -> DataType
Outliers -> Constr
(forall b. Data b => b -> b) -> Outliers -> Outliers
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Outliers -> c Outliers
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Outliers
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) -> Outliers -> u
forall u. (forall d. Data d => d -> u) -> Outliers -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Outliers -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Outliers -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Outliers -> m Outliers
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Outliers -> m Outliers
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Outliers
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Outliers -> c Outliers
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Outliers)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Outliers)
$cOutliers :: Constr
$tOutliers :: DataType
gmapMo :: (forall d. Data d => d -> m d) -> Outliers -> m Outliers
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Outliers -> m Outliers
gmapMp :: (forall d. Data d => d -> m d) -> Outliers -> m Outliers
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Outliers -> m Outliers
gmapM :: (forall d. Data d => d -> m d) -> Outliers -> m Outliers
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Outliers -> m Outliers
gmapQi :: Int -> (forall d. Data d => d -> u) -> Outliers -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Outliers -> u
gmapQ :: (forall d. Data d => d -> u) -> Outliers -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> Outliers -> [u]
gmapQr :: (r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Outliers -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Outliers -> r
gmapQl :: (r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Outliers -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Outliers -> r
gmapT :: (forall b. Data b => b -> b) -> Outliers -> Outliers
$cgmapT :: (forall b. Data b => b -> b) -> Outliers -> Outliers
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Outliers)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Outliers)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c Outliers)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Outliers)
dataTypeOf :: Outliers -> DataType
$cdataTypeOf :: Outliers -> DataType
toConstr :: Outliers -> Constr
$ctoConstr :: Outliers -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Outliers
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Outliers
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Outliers -> c Outliers
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Outliers -> c Outliers
$cp1Data :: Typeable Outliers
Data, (forall x. Outliers -> Rep Outliers x)
-> (forall x. Rep Outliers x -> Outliers) -> Generic Outliers
forall x. Rep Outliers x -> Outliers
forall x. Outliers -> Rep Outliers x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Outliers x -> Outliers
$cfrom :: forall x. Outliers -> Rep Outliers x
Generic)

instance FromJSON Outliers
instance ToJSON Outliers

instance Binary Outliers where
    put :: Outliers -> Put
put (Outliers Int64
v Int64
w Int64
x Int64
y Int64
z) = Int64 -> Put
forall t. Binary t => t -> Put
put Int64
v Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Int64 -> Put
forall t. Binary t => t -> Put
put Int64
w Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Int64 -> Put
forall t. Binary t => t -> Put
put Int64
x Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Int64 -> Put
forall t. Binary t => t -> Put
put Int64
y Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Int64 -> Put
forall t. Binary t => t -> Put
put Int64
z
    get :: Get Outliers
get = Int64 -> Int64 -> Int64 -> Int64 -> Int64 -> Outliers
Outliers (Int64 -> Int64 -> Int64 -> Int64 -> Int64 -> Outliers)
-> Get Int64 -> Get (Int64 -> Int64 -> Int64 -> Int64 -> Outliers)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Int64
forall t. Binary t => Get t
get Get (Int64 -> Int64 -> Int64 -> Int64 -> Outliers)
-> Get Int64 -> Get (Int64 -> Int64 -> Int64 -> Outliers)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get Int64
forall t. Binary t => Get t
get Get (Int64 -> Int64 -> Int64 -> Outliers)
-> Get Int64 -> Get (Int64 -> Int64 -> Outliers)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get Int64
forall t. Binary t => Get t
get Get (Int64 -> Int64 -> Outliers)
-> Get Int64 -> Get (Int64 -> Outliers)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get Int64
forall t. Binary t => Get t
get Get (Int64 -> Outliers) -> Get Int64 -> Get Outliers
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get Int64
forall t. Binary t => Get t
get
instance NFData Outliers

-- | A description of the extent to which outliers in the sample data
-- affect the sample mean and standard deviation.
data OutlierEffect = Unaffected -- ^ Less than 1% effect.
                   | Slight     -- ^ Between 1% and 10%.
                   | Moderate   -- ^ Between 10% and 50%.
                   | Severe     -- ^ Above 50% (i.e. measurements
                                -- are useless).
                     deriving (OutlierEffect -> OutlierEffect -> Bool
(OutlierEffect -> OutlierEffect -> Bool)
-> (OutlierEffect -> OutlierEffect -> Bool) -> Eq OutlierEffect
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: OutlierEffect -> OutlierEffect -> Bool
$c/= :: OutlierEffect -> OutlierEffect -> Bool
== :: OutlierEffect -> OutlierEffect -> Bool
$c== :: OutlierEffect -> OutlierEffect -> Bool
Eq, Eq OutlierEffect
Eq OutlierEffect
-> (OutlierEffect -> OutlierEffect -> Ordering)
-> (OutlierEffect -> OutlierEffect -> Bool)
-> (OutlierEffect -> OutlierEffect -> Bool)
-> (OutlierEffect -> OutlierEffect -> Bool)
-> (OutlierEffect -> OutlierEffect -> Bool)
-> (OutlierEffect -> OutlierEffect -> OutlierEffect)
-> (OutlierEffect -> OutlierEffect -> OutlierEffect)
-> Ord OutlierEffect
OutlierEffect -> OutlierEffect -> Bool
OutlierEffect -> OutlierEffect -> Ordering
OutlierEffect -> OutlierEffect -> OutlierEffect
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 :: OutlierEffect -> OutlierEffect -> OutlierEffect
$cmin :: OutlierEffect -> OutlierEffect -> OutlierEffect
max :: OutlierEffect -> OutlierEffect -> OutlierEffect
$cmax :: OutlierEffect -> OutlierEffect -> OutlierEffect
>= :: OutlierEffect -> OutlierEffect -> Bool
$c>= :: OutlierEffect -> OutlierEffect -> Bool
> :: OutlierEffect -> OutlierEffect -> Bool
$c> :: OutlierEffect -> OutlierEffect -> Bool
<= :: OutlierEffect -> OutlierEffect -> Bool
$c<= :: OutlierEffect -> OutlierEffect -> Bool
< :: OutlierEffect -> OutlierEffect -> Bool
$c< :: OutlierEffect -> OutlierEffect -> Bool
compare :: OutlierEffect -> OutlierEffect -> Ordering
$ccompare :: OutlierEffect -> OutlierEffect -> Ordering
$cp1Ord :: Eq OutlierEffect
Ord, ReadPrec [OutlierEffect]
ReadPrec OutlierEffect
Int -> ReadS OutlierEffect
ReadS [OutlierEffect]
(Int -> ReadS OutlierEffect)
-> ReadS [OutlierEffect]
-> ReadPrec OutlierEffect
-> ReadPrec [OutlierEffect]
-> Read OutlierEffect
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [OutlierEffect]
$creadListPrec :: ReadPrec [OutlierEffect]
readPrec :: ReadPrec OutlierEffect
$creadPrec :: ReadPrec OutlierEffect
readList :: ReadS [OutlierEffect]
$creadList :: ReadS [OutlierEffect]
readsPrec :: Int -> ReadS OutlierEffect
$creadsPrec :: Int -> ReadS OutlierEffect
Read, Int -> OutlierEffect -> ShowS
[OutlierEffect] -> ShowS
OutlierEffect -> String
(Int -> OutlierEffect -> ShowS)
-> (OutlierEffect -> String)
-> ([OutlierEffect] -> ShowS)
-> Show OutlierEffect
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [OutlierEffect] -> ShowS
$cshowList :: [OutlierEffect] -> ShowS
show :: OutlierEffect -> String
$cshow :: OutlierEffect -> String
showsPrec :: Int -> OutlierEffect -> ShowS
$cshowsPrec :: Int -> OutlierEffect -> ShowS
Show, Typeable, Typeable OutlierEffect
DataType
Constr
Typeable OutlierEffect
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> OutlierEffect -> c OutlierEffect)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c OutlierEffect)
-> (OutlierEffect -> Constr)
-> (OutlierEffect -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c OutlierEffect))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c OutlierEffect))
-> ((forall b. Data b => b -> b) -> OutlierEffect -> OutlierEffect)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> OutlierEffect -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> OutlierEffect -> r)
-> (forall u. (forall d. Data d => d -> u) -> OutlierEffect -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> OutlierEffect -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> OutlierEffect -> m OutlierEffect)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> OutlierEffect -> m OutlierEffect)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> OutlierEffect -> m OutlierEffect)
-> Data OutlierEffect
OutlierEffect -> DataType
OutlierEffect -> Constr
(forall b. Data b => b -> b) -> OutlierEffect -> OutlierEffect
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> OutlierEffect -> c OutlierEffect
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c OutlierEffect
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) -> OutlierEffect -> u
forall u. (forall d. Data d => d -> u) -> OutlierEffect -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> OutlierEffect -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> OutlierEffect -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> OutlierEffect -> m OutlierEffect
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> OutlierEffect -> m OutlierEffect
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c OutlierEffect
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> OutlierEffect -> c OutlierEffect
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c OutlierEffect)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c OutlierEffect)
$cSevere :: Constr
$cModerate :: Constr
$cSlight :: Constr
$cUnaffected :: Constr
$tOutlierEffect :: DataType
gmapMo :: (forall d. Data d => d -> m d) -> OutlierEffect -> m OutlierEffect
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> OutlierEffect -> m OutlierEffect
gmapMp :: (forall d. Data d => d -> m d) -> OutlierEffect -> m OutlierEffect
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> OutlierEffect -> m OutlierEffect
gmapM :: (forall d. Data d => d -> m d) -> OutlierEffect -> m OutlierEffect
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> OutlierEffect -> m OutlierEffect
gmapQi :: Int -> (forall d. Data d => d -> u) -> OutlierEffect -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> OutlierEffect -> u
gmapQ :: (forall d. Data d => d -> u) -> OutlierEffect -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> OutlierEffect -> [u]
gmapQr :: (r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> OutlierEffect -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> OutlierEffect -> r
gmapQl :: (r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> OutlierEffect -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> OutlierEffect -> r
gmapT :: (forall b. Data b => b -> b) -> OutlierEffect -> OutlierEffect
$cgmapT :: (forall b. Data b => b -> b) -> OutlierEffect -> OutlierEffect
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c OutlierEffect)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c OutlierEffect)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c OutlierEffect)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c OutlierEffect)
dataTypeOf :: OutlierEffect -> DataType
$cdataTypeOf :: OutlierEffect -> DataType
toConstr :: OutlierEffect -> Constr
$ctoConstr :: OutlierEffect -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c OutlierEffect
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c OutlierEffect
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> OutlierEffect -> c OutlierEffect
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> OutlierEffect -> c OutlierEffect
$cp1Data :: Typeable OutlierEffect
Data, (forall x. OutlierEffect -> Rep OutlierEffect x)
-> (forall x. Rep OutlierEffect x -> OutlierEffect)
-> Generic OutlierEffect
forall x. Rep OutlierEffect x -> OutlierEffect
forall x. OutlierEffect -> Rep OutlierEffect x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep OutlierEffect x -> OutlierEffect
$cfrom :: forall x. OutlierEffect -> Rep OutlierEffect x
Generic)

instance FromJSON OutlierEffect
instance ToJSON OutlierEffect

instance Binary OutlierEffect where
    put :: OutlierEffect -> Put
put OutlierEffect
Unaffected = Word8 -> Put
putWord8 Word8
0
    put OutlierEffect
Slight     = Word8 -> Put
putWord8 Word8
1
    put OutlierEffect
Moderate   = Word8 -> Put
putWord8 Word8
2
    put OutlierEffect
Severe     = Word8 -> Put
putWord8 Word8
3
    get :: Get OutlierEffect
get = do
        Word8
i <- Get Word8
getWord8
        case Word8
i of
            Word8
0 -> OutlierEffect -> Get OutlierEffect
forall (m :: * -> *) a. Monad m => a -> m a
return OutlierEffect
Unaffected
            Word8
1 -> OutlierEffect -> Get OutlierEffect
forall (m :: * -> *) a. Monad m => a -> m a
return OutlierEffect
Slight
            Word8
2 -> OutlierEffect -> Get OutlierEffect
forall (m :: * -> *) a. Monad m => a -> m a
return OutlierEffect
Moderate
            Word8
3 -> OutlierEffect -> Get OutlierEffect
forall (m :: * -> *) a. Monad m => a -> m a
return OutlierEffect
Severe
            Word8
_ -> String -> Get OutlierEffect
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Get OutlierEffect) -> String -> Get OutlierEffect
forall a b. (a -> b) -> a -> b
$ String
"get for OutlierEffect: unexpected " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Word8 -> String
forall a. Show a => a -> String
show Word8
i
instance NFData OutlierEffect

instance Semigroup Outliers where
    <> :: Outliers -> Outliers -> Outliers
(<>) = Outliers -> Outliers -> Outliers
addOutliers

instance Monoid Outliers where
    mempty :: Outliers
mempty  = Int64 -> Int64 -> Int64 -> Int64 -> Int64 -> Outliers
Outliers Int64
0 Int64
0 Int64
0 Int64
0 Int64
0
#if !(MIN_VERSION_base(4,11,0))
    mappend = addOutliers
#endif

addOutliers :: Outliers -> Outliers -> Outliers
addOutliers :: Outliers -> Outliers -> Outliers
addOutliers (Outliers Int64
s Int64
a Int64
b Int64
c Int64
d) (Outliers Int64
t Int64
w Int64
x Int64
y Int64
z) =
    Int64 -> Int64 -> Int64 -> Int64 -> Int64 -> Outliers
Outliers (Int64
sInt64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
+Int64
t) (Int64
aInt64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
+Int64
w) (Int64
bInt64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
+Int64
x) (Int64
cInt64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
+Int64
y) (Int64
dInt64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
+Int64
z)
{-# INLINE addOutliers #-}

-- | Analysis of the extent to which outliers in a sample affect its
-- standard deviation (and to some extent, its mean).
data OutlierVariance = OutlierVariance {
      OutlierVariance -> OutlierEffect
ovEffect   :: OutlierEffect
    -- ^ Qualitative description of effect.
    , OutlierVariance -> String
ovDesc     :: String
    -- ^ Brief textual description of effect.
    , OutlierVariance -> Double
ovFraction :: Double
    -- ^ Quantitative description of effect (a fraction between 0 and 1).
    } deriving (OutlierVariance -> OutlierVariance -> Bool
(OutlierVariance -> OutlierVariance -> Bool)
-> (OutlierVariance -> OutlierVariance -> Bool)
-> Eq OutlierVariance
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: OutlierVariance -> OutlierVariance -> Bool
$c/= :: OutlierVariance -> OutlierVariance -> Bool
== :: OutlierVariance -> OutlierVariance -> Bool
$c== :: OutlierVariance -> OutlierVariance -> Bool
Eq, ReadPrec [OutlierVariance]
ReadPrec OutlierVariance
Int -> ReadS OutlierVariance
ReadS [OutlierVariance]
(Int -> ReadS OutlierVariance)
-> ReadS [OutlierVariance]
-> ReadPrec OutlierVariance
-> ReadPrec [OutlierVariance]
-> Read OutlierVariance
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [OutlierVariance]
$creadListPrec :: ReadPrec [OutlierVariance]
readPrec :: ReadPrec OutlierVariance
$creadPrec :: ReadPrec OutlierVariance
readList :: ReadS [OutlierVariance]
$creadList :: ReadS [OutlierVariance]
readsPrec :: Int -> ReadS OutlierVariance
$creadsPrec :: Int -> ReadS OutlierVariance
Read, Int -> OutlierVariance -> ShowS
[OutlierVariance] -> ShowS
OutlierVariance -> String
(Int -> OutlierVariance -> ShowS)
-> (OutlierVariance -> String)
-> ([OutlierVariance] -> ShowS)
-> Show OutlierVariance
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [OutlierVariance] -> ShowS
$cshowList :: [OutlierVariance] -> ShowS
show :: OutlierVariance -> String
$cshow :: OutlierVariance -> String
showsPrec :: Int -> OutlierVariance -> ShowS
$cshowsPrec :: Int -> OutlierVariance -> ShowS
Show, Typeable, Typeable OutlierVariance
DataType
Constr
Typeable OutlierVariance
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> OutlierVariance -> c OutlierVariance)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c OutlierVariance)
-> (OutlierVariance -> Constr)
-> (OutlierVariance -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c OutlierVariance))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c OutlierVariance))
-> ((forall b. Data b => b -> b)
    -> OutlierVariance -> OutlierVariance)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> OutlierVariance -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> OutlierVariance -> r)
-> (forall u.
    (forall d. Data d => d -> u) -> OutlierVariance -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> OutlierVariance -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d)
    -> OutlierVariance -> m OutlierVariance)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> OutlierVariance -> m OutlierVariance)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> OutlierVariance -> m OutlierVariance)
-> Data OutlierVariance
OutlierVariance -> DataType
OutlierVariance -> Constr
(forall b. Data b => b -> b) -> OutlierVariance -> OutlierVariance
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> OutlierVariance -> c OutlierVariance
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c OutlierVariance
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) -> OutlierVariance -> u
forall u. (forall d. Data d => d -> u) -> OutlierVariance -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> OutlierVariance -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> OutlierVariance -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> OutlierVariance -> m OutlierVariance
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> OutlierVariance -> m OutlierVariance
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c OutlierVariance
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> OutlierVariance -> c OutlierVariance
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c OutlierVariance)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c OutlierVariance)
$cOutlierVariance :: Constr
$tOutlierVariance :: DataType
gmapMo :: (forall d. Data d => d -> m d)
-> OutlierVariance -> m OutlierVariance
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> OutlierVariance -> m OutlierVariance
gmapMp :: (forall d. Data d => d -> m d)
-> OutlierVariance -> m OutlierVariance
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> OutlierVariance -> m OutlierVariance
gmapM :: (forall d. Data d => d -> m d)
-> OutlierVariance -> m OutlierVariance
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> OutlierVariance -> m OutlierVariance
gmapQi :: Int -> (forall d. Data d => d -> u) -> OutlierVariance -> u
$cgmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> OutlierVariance -> u
gmapQ :: (forall d. Data d => d -> u) -> OutlierVariance -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> OutlierVariance -> [u]
gmapQr :: (r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> OutlierVariance -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> OutlierVariance -> r
gmapQl :: (r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> OutlierVariance -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> OutlierVariance -> r
gmapT :: (forall b. Data b => b -> b) -> OutlierVariance -> OutlierVariance
$cgmapT :: (forall b. Data b => b -> b) -> OutlierVariance -> OutlierVariance
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c OutlierVariance)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c OutlierVariance)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c OutlierVariance)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c OutlierVariance)
dataTypeOf :: OutlierVariance -> DataType
$cdataTypeOf :: OutlierVariance -> DataType
toConstr :: OutlierVariance -> Constr
$ctoConstr :: OutlierVariance -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c OutlierVariance
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c OutlierVariance
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> OutlierVariance -> c OutlierVariance
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> OutlierVariance -> c OutlierVariance
$cp1Data :: Typeable OutlierVariance
Data, (forall x. OutlierVariance -> Rep OutlierVariance x)
-> (forall x. Rep OutlierVariance x -> OutlierVariance)
-> Generic OutlierVariance
forall x. Rep OutlierVariance x -> OutlierVariance
forall x. OutlierVariance -> Rep OutlierVariance x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep OutlierVariance x -> OutlierVariance
$cfrom :: forall x. OutlierVariance -> Rep OutlierVariance x
Generic)

instance FromJSON OutlierVariance
instance ToJSON OutlierVariance

instance Binary OutlierVariance where
    put :: OutlierVariance -> Put
put (OutlierVariance OutlierEffect
x String
y Double
z) = OutlierEffect -> Put
forall t. Binary t => t -> Put
put OutlierEffect
x Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> String -> Put
forall t. Binary t => t -> Put
put String
y Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Double -> Put
forall t. Binary t => t -> Put
put Double
z
    get :: Get OutlierVariance
get = OutlierEffect -> String -> Double -> OutlierVariance
OutlierVariance (OutlierEffect -> String -> Double -> OutlierVariance)
-> Get OutlierEffect -> Get (String -> Double -> OutlierVariance)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get OutlierEffect
forall t. Binary t => Get t
get Get (String -> Double -> OutlierVariance)
-> Get String -> Get (Double -> OutlierVariance)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get String
forall t. Binary t => Get t
get Get (Double -> OutlierVariance)
-> Get Double -> Get OutlierVariance
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get Double
forall t. Binary t => Get t
get

instance NFData OutlierVariance where
    rnf :: OutlierVariance -> ()
rnf OutlierVariance{Double
String
OutlierEffect
ovFraction :: Double
ovDesc :: String
ovEffect :: OutlierEffect
ovFraction :: OutlierVariance -> Double
ovDesc :: OutlierVariance -> String
ovEffect :: OutlierVariance -> OutlierEffect
..} = OutlierEffect -> ()
forall a. NFData a => a -> ()
rnf OutlierEffect
ovEffect () -> () -> ()
`seq` String -> ()
forall a. NFData a => a -> ()
rnf String
ovDesc () -> () -> ()
`seq` Double -> ()
forall a. NFData a => a -> ()
rnf Double
ovFraction

-- | Results of a linear regression.
data Regression = Regression {
    Regression -> String
regResponder  :: String
    -- ^ Name of the responding variable.
  , Regression -> Map String (Estimate ConfInt Double)
regCoeffs     :: Map String (St.Estimate St.ConfInt Double)
    -- ^ Map from name to value of predictor coefficients.
  , Regression -> Estimate ConfInt Double
regRSquare    :: St.Estimate St.ConfInt Double
    -- ^ R&#0178; goodness-of-fit estimate.
  } deriving (Regression -> Regression -> Bool
(Regression -> Regression -> Bool)
-> (Regression -> Regression -> Bool) -> Eq Regression
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Regression -> Regression -> Bool
$c/= :: Regression -> Regression -> Bool
== :: Regression -> Regression -> Bool
$c== :: Regression -> Regression -> Bool
Eq, ReadPrec [Regression]
ReadPrec Regression
Int -> ReadS Regression
ReadS [Regression]
(Int -> ReadS Regression)
-> ReadS [Regression]
-> ReadPrec Regression
-> ReadPrec [Regression]
-> Read Regression
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Regression]
$creadListPrec :: ReadPrec [Regression]
readPrec :: ReadPrec Regression
$creadPrec :: ReadPrec Regression
readList :: ReadS [Regression]
$creadList :: ReadS [Regression]
readsPrec :: Int -> ReadS Regression
$creadsPrec :: Int -> ReadS Regression
Read, Int -> Regression -> ShowS
[Regression] -> ShowS
Regression -> String
(Int -> Regression -> ShowS)
-> (Regression -> String)
-> ([Regression] -> ShowS)
-> Show Regression
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Regression] -> ShowS
$cshowList :: [Regression] -> ShowS
show :: Regression -> String
$cshow :: Regression -> String
showsPrec :: Int -> Regression -> ShowS
$cshowsPrec :: Int -> Regression -> ShowS
Show, Typeable, (forall x. Regression -> Rep Regression x)
-> (forall x. Rep Regression x -> Regression) -> Generic Regression
forall x. Rep Regression x -> Regression
forall x. Regression -> Rep Regression x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Regression x -> Regression
$cfrom :: forall x. Regression -> Rep Regression x
Generic)

instance FromJSON Regression
instance ToJSON Regression

instance Binary Regression where
    put :: Regression -> Put
put Regression{String
Map String (Estimate ConfInt Double)
Estimate ConfInt Double
regRSquare :: Estimate ConfInt Double
regCoeffs :: Map String (Estimate ConfInt Double)
regResponder :: String
regRSquare :: Regression -> Estimate ConfInt Double
regCoeffs :: Regression -> Map String (Estimate ConfInt Double)
regResponder :: Regression -> String
..} =
      String -> Put
forall t. Binary t => t -> Put
put String
regResponder Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Map String (Estimate ConfInt Double) -> Put
forall t. Binary t => t -> Put
put Map String (Estimate ConfInt Double)
regCoeffs Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Estimate ConfInt Double -> Put
forall t. Binary t => t -> Put
put Estimate ConfInt Double
regRSquare
    get :: Get Regression
get = String
-> Map String (Estimate ConfInt Double)
-> Estimate ConfInt Double
-> Regression
Regression (String
 -> Map String (Estimate ConfInt Double)
 -> Estimate ConfInt Double
 -> Regression)
-> Get String
-> Get
     (Map String (Estimate ConfInt Double)
      -> Estimate ConfInt Double -> Regression)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get String
forall t. Binary t => Get t
get Get
  (Map String (Estimate ConfInt Double)
   -> Estimate ConfInt Double -> Regression)
-> Get (Map String (Estimate ConfInt Double))
-> Get (Estimate ConfInt Double -> Regression)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get (Map String (Estimate ConfInt Double))
forall t. Binary t => Get t
get Get (Estimate ConfInt Double -> Regression)
-> Get (Estimate ConfInt Double) -> Get Regression
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get (Estimate ConfInt Double)
forall t. Binary t => Get t
get

instance NFData Regression where
    rnf :: Regression -> ()
rnf Regression{String
Map String (Estimate ConfInt Double)
Estimate ConfInt Double
regRSquare :: Estimate ConfInt Double
regCoeffs :: Map String (Estimate ConfInt Double)
regResponder :: String
regRSquare :: Regression -> Estimate ConfInt Double
regCoeffs :: Regression -> Map String (Estimate ConfInt Double)
regResponder :: Regression -> String
..} =
      String -> ()
forall a. NFData a => a -> ()
rnf String
regResponder () -> () -> ()
`seq` Map String (Estimate ConfInt Double) -> ()
forall a. NFData a => a -> ()
rnf Map String (Estimate ConfInt Double)
regCoeffs () -> () -> ()
`seq` Estimate ConfInt Double -> ()
forall a. NFData a => a -> ()
rnf Estimate ConfInt Double
regRSquare

-- | Result of a bootstrap analysis of a non-parametric sample.
data SampleAnalysis = SampleAnalysis {
      SampleAnalysis -> [Regression]
anRegress    :: [Regression]
      -- ^ Estimates calculated via linear regression.
    , SampleAnalysis -> Estimate ConfInt Double
anMean       :: St.Estimate St.ConfInt Double
      -- ^ Estimated mean.
    , SampleAnalysis -> Estimate ConfInt Double
anStdDev     :: St.Estimate St.ConfInt Double
      -- ^ Estimated standard deviation.
    , SampleAnalysis -> OutlierVariance
anOutlierVar :: OutlierVariance
      -- ^ Description of the effects of outliers on the estimated
      -- variance.
    } deriving (SampleAnalysis -> SampleAnalysis -> Bool
(SampleAnalysis -> SampleAnalysis -> Bool)
-> (SampleAnalysis -> SampleAnalysis -> Bool) -> Eq SampleAnalysis
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SampleAnalysis -> SampleAnalysis -> Bool
$c/= :: SampleAnalysis -> SampleAnalysis -> Bool
== :: SampleAnalysis -> SampleAnalysis -> Bool
$c== :: SampleAnalysis -> SampleAnalysis -> Bool
Eq, ReadPrec [SampleAnalysis]
ReadPrec SampleAnalysis
Int -> ReadS SampleAnalysis
ReadS [SampleAnalysis]
(Int -> ReadS SampleAnalysis)
-> ReadS [SampleAnalysis]
-> ReadPrec SampleAnalysis
-> ReadPrec [SampleAnalysis]
-> Read SampleAnalysis
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [SampleAnalysis]
$creadListPrec :: ReadPrec [SampleAnalysis]
readPrec :: ReadPrec SampleAnalysis
$creadPrec :: ReadPrec SampleAnalysis
readList :: ReadS [SampleAnalysis]
$creadList :: ReadS [SampleAnalysis]
readsPrec :: Int -> ReadS SampleAnalysis
$creadsPrec :: Int -> ReadS SampleAnalysis
Read, Int -> SampleAnalysis -> ShowS
[SampleAnalysis] -> ShowS
SampleAnalysis -> String
(Int -> SampleAnalysis -> ShowS)
-> (SampleAnalysis -> String)
-> ([SampleAnalysis] -> ShowS)
-> Show SampleAnalysis
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SampleAnalysis] -> ShowS
$cshowList :: [SampleAnalysis] -> ShowS
show :: SampleAnalysis -> String
$cshow :: SampleAnalysis -> String
showsPrec :: Int -> SampleAnalysis -> ShowS
$cshowsPrec :: Int -> SampleAnalysis -> ShowS
Show, Typeable, (forall x. SampleAnalysis -> Rep SampleAnalysis x)
-> (forall x. Rep SampleAnalysis x -> SampleAnalysis)
-> Generic SampleAnalysis
forall x. Rep SampleAnalysis x -> SampleAnalysis
forall x. SampleAnalysis -> Rep SampleAnalysis x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep SampleAnalysis x -> SampleAnalysis
$cfrom :: forall x. SampleAnalysis -> Rep SampleAnalysis x
Generic)

instance FromJSON SampleAnalysis
instance ToJSON SampleAnalysis

instance Binary SampleAnalysis where
    put :: SampleAnalysis -> Put
put SampleAnalysis{[Regression]
Estimate ConfInt Double
OutlierVariance
anOutlierVar :: OutlierVariance
anStdDev :: Estimate ConfInt Double
anMean :: Estimate ConfInt Double
anRegress :: [Regression]
anOutlierVar :: SampleAnalysis -> OutlierVariance
anStdDev :: SampleAnalysis -> Estimate ConfInt Double
anMean :: SampleAnalysis -> Estimate ConfInt Double
anRegress :: SampleAnalysis -> [Regression]
..} = do
      [Regression] -> Put
forall t. Binary t => t -> Put
put [Regression]
anRegress; Estimate ConfInt Double -> Put
forall t. Binary t => t -> Put
put Estimate ConfInt Double
anMean; Estimate ConfInt Double -> Put
forall t. Binary t => t -> Put
put Estimate ConfInt Double
anStdDev; OutlierVariance -> Put
forall t. Binary t => t -> Put
put OutlierVariance
anOutlierVar
    get :: Get SampleAnalysis
get = [Regression]
-> Estimate ConfInt Double
-> Estimate ConfInt Double
-> OutlierVariance
-> SampleAnalysis
SampleAnalysis ([Regression]
 -> Estimate ConfInt Double
 -> Estimate ConfInt Double
 -> OutlierVariance
 -> SampleAnalysis)
-> Get [Regression]
-> Get
     (Estimate ConfInt Double
      -> Estimate ConfInt Double -> OutlierVariance -> SampleAnalysis)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get [Regression]
forall t. Binary t => Get t
get Get
  (Estimate ConfInt Double
   -> Estimate ConfInt Double -> OutlierVariance -> SampleAnalysis)
-> Get (Estimate ConfInt Double)
-> Get
     (Estimate ConfInt Double -> OutlierVariance -> SampleAnalysis)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get (Estimate ConfInt Double)
forall t. Binary t => Get t
get Get (Estimate ConfInt Double -> OutlierVariance -> SampleAnalysis)
-> Get (Estimate ConfInt Double)
-> Get (OutlierVariance -> SampleAnalysis)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get (Estimate ConfInt Double)
forall t. Binary t => Get t
get Get (OutlierVariance -> SampleAnalysis)
-> Get OutlierVariance -> Get SampleAnalysis
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get OutlierVariance
forall t. Binary t => Get t
get

instance NFData SampleAnalysis where
    rnf :: SampleAnalysis -> ()
rnf SampleAnalysis{[Regression]
Estimate ConfInt Double
OutlierVariance
anOutlierVar :: OutlierVariance
anStdDev :: Estimate ConfInt Double
anMean :: Estimate ConfInt Double
anRegress :: [Regression]
anOutlierVar :: SampleAnalysis -> OutlierVariance
anStdDev :: SampleAnalysis -> Estimate ConfInt Double
anMean :: SampleAnalysis -> Estimate ConfInt Double
anRegress :: SampleAnalysis -> [Regression]
..} =
        [Regression] -> ()
forall a. NFData a => a -> ()
rnf [Regression]
anRegress () -> () -> ()
`seq` Estimate ConfInt Double -> ()
forall a. NFData a => a -> ()
rnf Estimate ConfInt Double
anMean () -> () -> ()
`seq`
        Estimate ConfInt Double -> ()
forall a. NFData a => a -> ()
rnf Estimate ConfInt Double
anStdDev () -> () -> ()
`seq` OutlierVariance -> ()
forall a. NFData a => a -> ()
rnf OutlierVariance
anOutlierVar

-- | Data for a KDE chart of performance.
data KDE = KDE {
      KDE -> String
kdeType   :: String
    , KDE -> Vector Double
kdeValues :: U.Vector Double
    , KDE -> Vector Double
kdePDF    :: U.Vector Double
    } deriving (KDE -> KDE -> Bool
(KDE -> KDE -> Bool) -> (KDE -> KDE -> Bool) -> Eq KDE
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: KDE -> KDE -> Bool
$c/= :: KDE -> KDE -> Bool
== :: KDE -> KDE -> Bool
$c== :: KDE -> KDE -> Bool
Eq, ReadPrec [KDE]
ReadPrec KDE
Int -> ReadS KDE
ReadS [KDE]
(Int -> ReadS KDE)
-> ReadS [KDE] -> ReadPrec KDE -> ReadPrec [KDE] -> Read KDE
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [KDE]
$creadListPrec :: ReadPrec [KDE]
readPrec :: ReadPrec KDE
$creadPrec :: ReadPrec KDE
readList :: ReadS [KDE]
$creadList :: ReadS [KDE]
readsPrec :: Int -> ReadS KDE
$creadsPrec :: Int -> ReadS KDE
Read, Int -> KDE -> ShowS
[KDE] -> ShowS
KDE -> String
(Int -> KDE -> ShowS)
-> (KDE -> String) -> ([KDE] -> ShowS) -> Show KDE
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [KDE] -> ShowS
$cshowList :: [KDE] -> ShowS
show :: KDE -> String
$cshow :: KDE -> String
showsPrec :: Int -> KDE -> ShowS
$cshowsPrec :: Int -> KDE -> ShowS
Show, Typeable, Typeable KDE
DataType
Constr
Typeable KDE
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> KDE -> c KDE)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c KDE)
-> (KDE -> Constr)
-> (KDE -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c KDE))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c KDE))
-> ((forall b. Data b => b -> b) -> KDE -> KDE)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> KDE -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> KDE -> r)
-> (forall u. (forall d. Data d => d -> u) -> KDE -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> KDE -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> KDE -> m KDE)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> KDE -> m KDE)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> KDE -> m KDE)
-> Data KDE
KDE -> DataType
KDE -> Constr
(forall b. Data b => b -> b) -> KDE -> KDE
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> KDE -> c KDE
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c KDE
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) -> KDE -> u
forall u. (forall d. Data d => d -> u) -> KDE -> [u]
forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> KDE -> r
forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> KDE -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> KDE -> m KDE
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> KDE -> m KDE
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c KDE
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> KDE -> c KDE
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c KDE)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c KDE)
$cKDE :: Constr
$tKDE :: DataType
gmapMo :: (forall d. Data d => d -> m d) -> KDE -> m KDE
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> KDE -> m KDE
gmapMp :: (forall d. Data d => d -> m d) -> KDE -> m KDE
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> KDE -> m KDE
gmapM :: (forall d. Data d => d -> m d) -> KDE -> m KDE
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> KDE -> m KDE
gmapQi :: Int -> (forall d. Data d => d -> u) -> KDE -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> KDE -> u
gmapQ :: (forall d. Data d => d -> u) -> KDE -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> KDE -> [u]
gmapQr :: (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> KDE -> r
$cgmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> KDE -> r
gmapQl :: (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> KDE -> r
$cgmapQl :: forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> KDE -> r
gmapT :: (forall b. Data b => b -> b) -> KDE -> KDE
$cgmapT :: (forall b. Data b => b -> b) -> KDE -> KDE
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c KDE)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c KDE)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c KDE)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c KDE)
dataTypeOf :: KDE -> DataType
$cdataTypeOf :: KDE -> DataType
toConstr :: KDE -> Constr
$ctoConstr :: KDE -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c KDE
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c KDE
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> KDE -> c KDE
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> KDE -> c KDE
$cp1Data :: Typeable KDE
Data, (forall x. KDE -> Rep KDE x)
-> (forall x. Rep KDE x -> KDE) -> Generic KDE
forall x. Rep KDE x -> KDE
forall x. KDE -> Rep KDE x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep KDE x -> KDE
$cfrom :: forall x. KDE -> Rep KDE x
Generic)

instance FromJSON KDE
instance ToJSON KDE

instance Binary KDE where
    put :: KDE -> Put
put KDE{String
Vector Double
kdePDF :: Vector Double
kdeValues :: Vector Double
kdeType :: String
kdePDF :: KDE -> Vector Double
kdeValues :: KDE -> Vector Double
kdeType :: KDE -> String
..} = String -> Put
forall t. Binary t => t -> Put
put String
kdeType Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Vector Double -> Put
forall t. Binary t => t -> Put
put Vector Double
kdeValues Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Vector Double -> Put
forall t. Binary t => t -> Put
put Vector Double
kdePDF
    get :: Get KDE
get = String -> Vector Double -> Vector Double -> KDE
KDE (String -> Vector Double -> Vector Double -> KDE)
-> Get String -> Get (Vector Double -> Vector Double -> KDE)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get String
forall t. Binary t => Get t
get Get (Vector Double -> Vector Double -> KDE)
-> Get (Vector Double) -> Get (Vector Double -> KDE)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get (Vector Double)
forall t. Binary t => Get t
get Get (Vector Double -> KDE) -> Get (Vector Double) -> Get KDE
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get (Vector Double)
forall t. Binary t => Get t
get

instance NFData KDE where
    rnf :: KDE -> ()
rnf KDE{String
Vector Double
kdePDF :: Vector Double
kdeValues :: Vector Double
kdeType :: String
kdePDF :: KDE -> Vector Double
kdeValues :: KDE -> Vector Double
kdeType :: KDE -> String
..} = String -> ()
forall a. NFData a => a -> ()
rnf String
kdeType () -> () -> ()
`seq` Vector Double -> ()
forall a. NFData a => a -> ()
rnf Vector Double
kdeValues () -> () -> ()
`seq` Vector Double -> ()
forall a. NFData a => a -> ()
rnf Vector Double
kdePDF

-- | Report of a sample analysis.
data Report = Report {
      Report -> Int
reportNumber   :: Int
      -- ^ A simple index indicating that this is the /n/th report.
    , Report -> String
reportName     :: String
      -- ^ The name of this report.
    , Report -> [String]
reportKeys     :: [String]
      -- ^ See 'measureKeys'.
    , Report -> Vector Measured
reportMeasured :: V.Vector Measured
      -- ^ Raw measurements.
    , Report -> SampleAnalysis
reportAnalysis :: SampleAnalysis
      -- ^ Report analysis.
    , Report -> Outliers
reportOutliers :: Outliers
      -- ^ Analysis of outliers.
    , Report -> [KDE]
reportKDEs     :: [KDE]
      -- ^ Data for a KDE of times.
    } deriving (Report -> Report -> Bool
(Report -> Report -> Bool)
-> (Report -> Report -> Bool) -> Eq Report
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Report -> Report -> Bool
$c/= :: Report -> Report -> Bool
== :: Report -> Report -> Bool
$c== :: Report -> Report -> Bool
Eq, ReadPrec [Report]
ReadPrec Report
Int -> ReadS Report
ReadS [Report]
(Int -> ReadS Report)
-> ReadS [Report]
-> ReadPrec Report
-> ReadPrec [Report]
-> Read Report
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Report]
$creadListPrec :: ReadPrec [Report]
readPrec :: ReadPrec Report
$creadPrec :: ReadPrec Report
readList :: ReadS [Report]
$creadList :: ReadS [Report]
readsPrec :: Int -> ReadS Report
$creadsPrec :: Int -> ReadS Report
Read, Int -> Report -> ShowS
[Report] -> ShowS
Report -> String
(Int -> Report -> ShowS)
-> (Report -> String) -> ([Report] -> ShowS) -> Show Report
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Report] -> ShowS
$cshowList :: [Report] -> ShowS
show :: Report -> String
$cshow :: Report -> String
showsPrec :: Int -> Report -> ShowS
$cshowsPrec :: Int -> Report -> ShowS
Show, Typeable, (forall x. Report -> Rep Report x)
-> (forall x. Rep Report x -> Report) -> Generic Report
forall x. Rep Report x -> Report
forall x. Report -> Rep Report x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Report x -> Report
$cfrom :: forall x. Report -> Rep Report x
Generic)

instance FromJSON Report
instance ToJSON Report

instance Binary Report where
    put :: Report -> Put
put Report{Int
String
[String]
[KDE]
Vector Measured
SampleAnalysis
Outliers
reportKDEs :: [KDE]
reportOutliers :: Outliers
reportAnalysis :: SampleAnalysis
reportMeasured :: Vector Measured
reportKeys :: [String]
reportName :: String
reportNumber :: Int
reportKDEs :: Report -> [KDE]
reportOutliers :: Report -> Outliers
reportAnalysis :: Report -> SampleAnalysis
reportMeasured :: Report -> Vector Measured
reportKeys :: Report -> [String]
reportName :: Report -> String
reportNumber :: Report -> Int
..} =
      Int -> Put
forall t. Binary t => t -> Put
put Int
reportNumber Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> String -> Put
forall t. Binary t => t -> Put
put String
reportName Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> [String] -> Put
forall t. Binary t => t -> Put
put [String]
reportKeys Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
      Vector Measured -> Put
forall t. Binary t => t -> Put
put Vector Measured
reportMeasured Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> SampleAnalysis -> Put
forall t. Binary t => t -> Put
put SampleAnalysis
reportAnalysis Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Outliers -> Put
forall t. Binary t => t -> Put
put Outliers
reportOutliers Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
      [KDE] -> Put
forall t. Binary t => t -> Put
put [KDE]
reportKDEs

    get :: Get Report
get = Int
-> String
-> [String]
-> Vector Measured
-> SampleAnalysis
-> Outliers
-> [KDE]
-> Report
Report (Int
 -> String
 -> [String]
 -> Vector Measured
 -> SampleAnalysis
 -> Outliers
 -> [KDE]
 -> Report)
-> Get Int
-> Get
     (String
      -> [String]
      -> Vector Measured
      -> SampleAnalysis
      -> Outliers
      -> [KDE]
      -> Report)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Int
forall t. Binary t => Get t
get Get
  (String
   -> [String]
   -> Vector Measured
   -> SampleAnalysis
   -> Outliers
   -> [KDE]
   -> Report)
-> Get String
-> Get
     ([String]
      -> Vector Measured
      -> SampleAnalysis
      -> Outliers
      -> [KDE]
      -> Report)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get String
forall t. Binary t => Get t
get Get
  ([String]
   -> Vector Measured
   -> SampleAnalysis
   -> Outliers
   -> [KDE]
   -> Report)
-> Get [String]
-> Get
     (Vector Measured -> SampleAnalysis -> Outliers -> [KDE] -> Report)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get [String]
forall t. Binary t => Get t
get Get
  (Vector Measured -> SampleAnalysis -> Outliers -> [KDE] -> Report)
-> Get (Vector Measured)
-> Get (SampleAnalysis -> Outliers -> [KDE] -> Report)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get (Vector Measured)
forall t. Binary t => Get t
get Get (SampleAnalysis -> Outliers -> [KDE] -> Report)
-> Get SampleAnalysis -> Get (Outliers -> [KDE] -> Report)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get SampleAnalysis
forall t. Binary t => Get t
get Get (Outliers -> [KDE] -> Report)
-> Get Outliers -> Get ([KDE] -> Report)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get Outliers
forall t. Binary t => Get t
get Get ([KDE] -> Report) -> Get [KDE] -> Get Report
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get [KDE]
forall t. Binary t => Get t
get

instance NFData Report where
    rnf :: Report -> ()
rnf Report{Int
String
[String]
[KDE]
Vector Measured
SampleAnalysis
Outliers
reportKDEs :: [KDE]
reportOutliers :: Outliers
reportAnalysis :: SampleAnalysis
reportMeasured :: Vector Measured
reportKeys :: [String]
reportName :: String
reportNumber :: Int
reportKDEs :: Report -> [KDE]
reportOutliers :: Report -> Outliers
reportAnalysis :: Report -> SampleAnalysis
reportMeasured :: Report -> Vector Measured
reportKeys :: Report -> [String]
reportName :: Report -> String
reportNumber :: Report -> Int
..} =
      Int -> ()
forall a. NFData a => a -> ()
rnf Int
reportNumber () -> () -> ()
`seq` String -> ()
forall a. NFData a => a -> ()
rnf String
reportName () -> () -> ()
`seq` [String] -> ()
forall a. NFData a => a -> ()
rnf [String]
reportKeys () -> () -> ()
`seq`
      Vector Measured -> ()
forall a. NFData a => a -> ()
rnf Vector Measured
reportMeasured () -> () -> ()
`seq` SampleAnalysis -> ()
forall a. NFData a => a -> ()
rnf SampleAnalysis
reportAnalysis () -> () -> ()
`seq` Outliers -> ()
forall a. NFData a => a -> ()
rnf Outliers
reportOutliers () -> () -> ()
`seq`
      [KDE] -> ()
forall a. NFData a => a -> ()
rnf [KDE]
reportKDEs

data DataRecord = Measurement Int String (V.Vector Measured)
                | Analysed Report
                deriving (DataRecord -> DataRecord -> Bool
(DataRecord -> DataRecord -> Bool)
-> (DataRecord -> DataRecord -> Bool) -> Eq DataRecord
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DataRecord -> DataRecord -> Bool
$c/= :: DataRecord -> DataRecord -> Bool
== :: DataRecord -> DataRecord -> Bool
$c== :: DataRecord -> DataRecord -> Bool
Eq, ReadPrec [DataRecord]
ReadPrec DataRecord
Int -> ReadS DataRecord
ReadS [DataRecord]
(Int -> ReadS DataRecord)
-> ReadS [DataRecord]
-> ReadPrec DataRecord
-> ReadPrec [DataRecord]
-> Read DataRecord
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [DataRecord]
$creadListPrec :: ReadPrec [DataRecord]
readPrec :: ReadPrec DataRecord
$creadPrec :: ReadPrec DataRecord
readList :: ReadS [DataRecord]
$creadList :: ReadS [DataRecord]
readsPrec :: Int -> ReadS DataRecord
$creadsPrec :: Int -> ReadS DataRecord
Read, Int -> DataRecord -> ShowS
[DataRecord] -> ShowS
DataRecord -> String
(Int -> DataRecord -> ShowS)
-> (DataRecord -> String)
-> ([DataRecord] -> ShowS)
-> Show DataRecord
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DataRecord] -> ShowS
$cshowList :: [DataRecord] -> ShowS
show :: DataRecord -> String
$cshow :: DataRecord -> String
showsPrec :: Int -> DataRecord -> ShowS
$cshowsPrec :: Int -> DataRecord -> ShowS
Show, Typeable, (forall x. DataRecord -> Rep DataRecord x)
-> (forall x. Rep DataRecord x -> DataRecord) -> Generic DataRecord
forall x. Rep DataRecord x -> DataRecord
forall x. DataRecord -> Rep DataRecord x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep DataRecord x -> DataRecord
$cfrom :: forall x. DataRecord -> Rep DataRecord x
Generic)

instance Binary DataRecord where
  put :: DataRecord -> Put
put (Measurement Int
i String
n Vector Measured
v) = Word8 -> Put
putWord8 Word8
0 Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Int -> Put
forall t. Binary t => t -> Put
put Int
i Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> String -> Put
forall t. Binary t => t -> Put
put String
n Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Vector Measured -> Put
forall t. Binary t => t -> Put
put Vector Measured
v
  put (Analysed Report
r)        = Word8 -> Put
putWord8 Word8
1 Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Report -> Put
forall t. Binary t => t -> Put
put Report
r

  get :: Get DataRecord
get = do
    Word8
w <- Get Word8
getWord8
    case Word8
w of
      Word8
0 -> Int -> String -> Vector Measured -> DataRecord
Measurement (Int -> String -> Vector Measured -> DataRecord)
-> Get Int -> Get (String -> Vector Measured -> DataRecord)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Int
forall t. Binary t => Get t
get Get (String -> Vector Measured -> DataRecord)
-> Get String -> Get (Vector Measured -> DataRecord)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get String
forall t. Binary t => Get t
get Get (Vector Measured -> DataRecord)
-> Get (Vector Measured) -> Get DataRecord
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get (Vector Measured)
forall t. Binary t => Get t
get
      Word8
1 -> Report -> DataRecord
Analysed    (Report -> DataRecord) -> Get Report -> Get DataRecord
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Report
forall t. Binary t => Get t
get
      Word8
_ -> String -> Get DataRecord
forall a. HasCallStack => String -> a
error (String
"bad tag " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Word8 -> String
forall a. Show a => a -> String
show Word8
w)

instance NFData DataRecord where
  rnf :: DataRecord -> ()
rnf (Measurement Int
i String
n Vector Measured
v) = Int -> ()
forall a. NFData a => a -> ()
rnf Int
i () -> () -> ()
`seq` String -> ()
forall a. NFData a => a -> ()
rnf String
n () -> () -> ()
`seq` Vector Measured -> ()
forall a. NFData a => a -> ()
rnf Vector Measured
v
  rnf (Analysed Report
r)        = Report -> ()
forall a. NFData a => a -> ()
rnf Report
r

instance FromJSON DataRecord
instance ToJSON DataRecord