{-# LANGUAGE BangPatterns       #-}
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE DeriveFoldable     #-}
{-# LANGUAGE DeriveFunctor      #-}
{-# LANGUAGE DeriveGeneric      #-}
{-# LANGUAGE DeriveTraversable  #-}
{-# LANGUAGE FlexibleContexts   #-}
{-# LANGUAGE TypeFamilies       #-}

-- |
-- Module    : Statistics.Resampling
-- Copyright : (c) 2009, 2010 Bryan O'Sullivan
-- License   : BSD3
--
-- Maintainer  : bos@serpentine.com
-- Stability   : experimental
-- Portability : portable
--
-- Resampling statistics.

module Statistics.Resampling
    ( -- * Data types
      Resample(..)
    , Bootstrap(..)
    , Estimator(..)
    , estimate
      -- * Resampling
    , resampleST
    , resample
    , resampleVector
      -- * Jackknife
    , jackknife
    , jackknifeMean
    , jackknifeVariance
    , jackknifeVarianceUnb
    , jackknifeStdDev
      -- * Helper functions
    , splitGen
    ) where

import Data.Aeson (FromJSON, ToJSON)
import Control.Concurrent.Async (forConcurrently_)
import Control.Monad (forM_, forM, replicateM, liftM2)
import Control.Monad.Primitive (PrimMonad(..))
import Data.Binary (Binary(..))
import Data.Data (Data, Typeable)
import Data.Vector.Algorithms.Intro (sort)
import Data.Vector.Binary ()
import Data.Vector.Generic (unsafeFreeze,unsafeThaw)
import Data.Word (Word32)
import qualified Data.Foldable as T
import qualified Data.Traversable as T
import qualified Data.Vector.Generic as G
import qualified Data.Vector.Unboxed as U
import qualified Data.Vector.Unboxed.Mutable as MU

import GHC.Conc (numCapabilities)
import GHC.Generics (Generic)
import Numeric.Sum (Summation(..), kbn)
import Statistics.Function (indices)
import Statistics.Sample (mean, stdDev, variance, varianceUnbiased)
import Statistics.Types (Sample)
import System.Random.MWC (Gen, GenIO, initialize, uniformR, uniformVector)


----------------------------------------------------------------
-- Data types
----------------------------------------------------------------

-- | A resample drawn randomly, with replacement, from a set of data
-- points.  Distinct from a normal array to make it harder for your
-- humble author's brain to go wrong.
newtype Resample = Resample {
      Resample -> Vector Double
fromResample :: U.Vector Double
    } deriving (Resample -> Resample -> Bool
(Resample -> Resample -> Bool)
-> (Resample -> Resample -> Bool) -> Eq Resample
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Resample -> Resample -> Bool
$c/= :: Resample -> Resample -> Bool
== :: Resample -> Resample -> Bool
$c== :: Resample -> Resample -> Bool
Eq, ReadPrec [Resample]
ReadPrec Resample
Int -> ReadS Resample
ReadS [Resample]
(Int -> ReadS Resample)
-> ReadS [Resample]
-> ReadPrec Resample
-> ReadPrec [Resample]
-> Read Resample
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Resample]
$creadListPrec :: ReadPrec [Resample]
readPrec :: ReadPrec Resample
$creadPrec :: ReadPrec Resample
readList :: ReadS [Resample]
$creadList :: ReadS [Resample]
readsPrec :: Int -> ReadS Resample
$creadsPrec :: Int -> ReadS Resample
Read, Int -> Resample -> ShowS
[Resample] -> ShowS
Resample -> String
(Int -> Resample -> ShowS)
-> (Resample -> String) -> ([Resample] -> ShowS) -> Show Resample
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Resample] -> ShowS
$cshowList :: [Resample] -> ShowS
show :: Resample -> String
$cshow :: Resample -> String
showsPrec :: Int -> Resample -> ShowS
$cshowsPrec :: Int -> Resample -> ShowS
Show, Typeable, Typeable Resample
DataType
Constr
Typeable Resample
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> Resample -> c Resample)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c Resample)
-> (Resample -> Constr)
-> (Resample -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c Resample))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Resample))
-> ((forall b. Data b => b -> b) -> Resample -> Resample)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> Resample -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> Resample -> r)
-> (forall u. (forall d. Data d => d -> u) -> Resample -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> Resample -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> Resample -> m Resample)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Resample -> m Resample)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Resample -> m Resample)
-> Data Resample
Resample -> DataType
Resample -> Constr
(forall b. Data b => b -> b) -> Resample -> Resample
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Resample -> c Resample
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Resample
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) -> Resample -> u
forall u. (forall d. Data d => d -> u) -> Resample -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Resample -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Resample -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Resample -> m Resample
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Resample -> m Resample
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Resample
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Resample -> c Resample
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Resample)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Resample)
$cResample :: Constr
$tResample :: DataType
gmapMo :: (forall d. Data d => d -> m d) -> Resample -> m Resample
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Resample -> m Resample
gmapMp :: (forall d. Data d => d -> m d) -> Resample -> m Resample
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Resample -> m Resample
gmapM :: (forall d. Data d => d -> m d) -> Resample -> m Resample
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Resample -> m Resample
gmapQi :: Int -> (forall d. Data d => d -> u) -> Resample -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Resample -> u
gmapQ :: (forall d. Data d => d -> u) -> Resample -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> Resample -> [u]
gmapQr :: (r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Resample -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Resample -> r
gmapQl :: (r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Resample -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Resample -> r
gmapT :: (forall b. Data b => b -> b) -> Resample -> Resample
$cgmapT :: (forall b. Data b => b -> b) -> Resample -> Resample
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Resample)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Resample)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c Resample)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Resample)
dataTypeOf :: Resample -> DataType
$cdataTypeOf :: Resample -> DataType
toConstr :: Resample -> Constr
$ctoConstr :: Resample -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Resample
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Resample
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Resample -> c Resample
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Resample -> c Resample
$cp1Data :: Typeable Resample
Data, (forall x. Resample -> Rep Resample x)
-> (forall x. Rep Resample x -> Resample) -> Generic Resample
forall x. Rep Resample x -> Resample
forall x. Resample -> Rep Resample x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Resample x -> Resample
$cfrom :: forall x. Resample -> Rep Resample x
Generic)

instance FromJSON Resample
instance ToJSON Resample

instance Binary Resample where
    put :: Resample -> Put
put = Vector Double -> Put
forall t. Binary t => t -> Put
put (Vector Double -> Put)
-> (Resample -> Vector Double) -> Resample -> Put
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Resample -> Vector Double
fromResample
    get :: Get Resample
get = (Vector Double -> Resample) -> Get (Vector Double) -> Get Resample
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Vector Double -> Resample
Resample Get (Vector Double)
forall t. Binary t => Get t
get

data Bootstrap v a = Bootstrap
  { Bootstrap v a -> a
fullSample :: !a
  , Bootstrap v a -> v a
resamples  :: v a
  }
  deriving (Bootstrap v a -> Bootstrap v a -> Bool
(Bootstrap v a -> Bootstrap v a -> Bool)
-> (Bootstrap v a -> Bootstrap v a -> Bool) -> Eq (Bootstrap v a)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall (v :: * -> *) a.
(Eq a, Eq (v a)) =>
Bootstrap v a -> Bootstrap v a -> Bool
/= :: Bootstrap v a -> Bootstrap v a -> Bool
$c/= :: forall (v :: * -> *) a.
(Eq a, Eq (v a)) =>
Bootstrap v a -> Bootstrap v a -> Bool
== :: Bootstrap v a -> Bootstrap v a -> Bool
$c== :: forall (v :: * -> *) a.
(Eq a, Eq (v a)) =>
Bootstrap v a -> Bootstrap v a -> Bool
Eq, ReadPrec [Bootstrap v a]
ReadPrec (Bootstrap v a)
Int -> ReadS (Bootstrap v a)
ReadS [Bootstrap v a]
(Int -> ReadS (Bootstrap v a))
-> ReadS [Bootstrap v a]
-> ReadPrec (Bootstrap v a)
-> ReadPrec [Bootstrap v a]
-> Read (Bootstrap v a)
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
forall (v :: * -> *) a.
(Read a, Read (v a)) =>
ReadPrec [Bootstrap v a]
forall (v :: * -> *) a.
(Read a, Read (v a)) =>
ReadPrec (Bootstrap v a)
forall (v :: * -> *) a.
(Read a, Read (v a)) =>
Int -> ReadS (Bootstrap v a)
forall (v :: * -> *) a.
(Read a, Read (v a)) =>
ReadS [Bootstrap v a]
readListPrec :: ReadPrec [Bootstrap v a]
$creadListPrec :: forall (v :: * -> *) a.
(Read a, Read (v a)) =>
ReadPrec [Bootstrap v a]
readPrec :: ReadPrec (Bootstrap v a)
$creadPrec :: forall (v :: * -> *) a.
(Read a, Read (v a)) =>
ReadPrec (Bootstrap v a)
readList :: ReadS [Bootstrap v a]
$creadList :: forall (v :: * -> *) a.
(Read a, Read (v a)) =>
ReadS [Bootstrap v a]
readsPrec :: Int -> ReadS (Bootstrap v a)
$creadsPrec :: forall (v :: * -> *) a.
(Read a, Read (v a)) =>
Int -> ReadS (Bootstrap v a)
Read, Int -> Bootstrap v a -> ShowS
[Bootstrap v a] -> ShowS
Bootstrap v a -> String
(Int -> Bootstrap v a -> ShowS)
-> (Bootstrap v a -> String)
-> ([Bootstrap v a] -> ShowS)
-> Show (Bootstrap v a)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall (v :: * -> *) a.
(Show a, Show (v a)) =>
Int -> Bootstrap v a -> ShowS
forall (v :: * -> *) a.
(Show a, Show (v a)) =>
[Bootstrap v a] -> ShowS
forall (v :: * -> *) a.
(Show a, Show (v a)) =>
Bootstrap v a -> String
showList :: [Bootstrap v a] -> ShowS
$cshowList :: forall (v :: * -> *) a.
(Show a, Show (v a)) =>
[Bootstrap v a] -> ShowS
show :: Bootstrap v a -> String
$cshow :: forall (v :: * -> *) a.
(Show a, Show (v a)) =>
Bootstrap v a -> String
showsPrec :: Int -> Bootstrap v a -> ShowS
$cshowsPrec :: forall (v :: * -> *) a.
(Show a, Show (v a)) =>
Int -> Bootstrap v a -> ShowS
Show , (forall x. Bootstrap v a -> Rep (Bootstrap v a) x)
-> (forall x. Rep (Bootstrap v a) x -> Bootstrap v a)
-> Generic (Bootstrap v a)
forall x. Rep (Bootstrap v a) x -> Bootstrap v a
forall x. Bootstrap v a -> Rep (Bootstrap v a) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall (v :: * -> *) a x. Rep (Bootstrap v a) x -> Bootstrap v a
forall (v :: * -> *) a x. Bootstrap v a -> Rep (Bootstrap v a) x
$cto :: forall (v :: * -> *) a x. Rep (Bootstrap v a) x -> Bootstrap v a
$cfrom :: forall (v :: * -> *) a x. Bootstrap v a -> Rep (Bootstrap v a) x
Generic, a -> Bootstrap v b -> Bootstrap v a
(a -> b) -> Bootstrap v a -> Bootstrap v b
(forall a b. (a -> b) -> Bootstrap v a -> Bootstrap v b)
-> (forall a b. a -> Bootstrap v b -> Bootstrap v a)
-> Functor (Bootstrap v)
forall a b. a -> Bootstrap v b -> Bootstrap v a
forall a b. (a -> b) -> Bootstrap v a -> Bootstrap v b
forall (v :: * -> *) a b.
Functor v =>
a -> Bootstrap v b -> Bootstrap v a
forall (v :: * -> *) a b.
Functor v =>
(a -> b) -> Bootstrap v a -> Bootstrap v b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> Bootstrap v b -> Bootstrap v a
$c<$ :: forall (v :: * -> *) a b.
Functor v =>
a -> Bootstrap v b -> Bootstrap v a
fmap :: (a -> b) -> Bootstrap v a -> Bootstrap v b
$cfmap :: forall (v :: * -> *) a b.
Functor v =>
(a -> b) -> Bootstrap v a -> Bootstrap v b
Functor, Bootstrap v a -> Bool
(a -> m) -> Bootstrap v a -> m
(a -> b -> b) -> b -> Bootstrap v a -> b
(forall m. Monoid m => Bootstrap v m -> m)
-> (forall m a. Monoid m => (a -> m) -> Bootstrap v a -> m)
-> (forall m a. Monoid m => (a -> m) -> Bootstrap v a -> m)
-> (forall a b. (a -> b -> b) -> b -> Bootstrap v a -> b)
-> (forall a b. (a -> b -> b) -> b -> Bootstrap v a -> b)
-> (forall b a. (b -> a -> b) -> b -> Bootstrap v a -> b)
-> (forall b a. (b -> a -> b) -> b -> Bootstrap v a -> b)
-> (forall a. (a -> a -> a) -> Bootstrap v a -> a)
-> (forall a. (a -> a -> a) -> Bootstrap v a -> a)
-> (forall a. Bootstrap v a -> [a])
-> (forall a. Bootstrap v a -> Bool)
-> (forall a. Bootstrap v a -> Int)
-> (forall a. Eq a => a -> Bootstrap v a -> Bool)
-> (forall a. Ord a => Bootstrap v a -> a)
-> (forall a. Ord a => Bootstrap v a -> a)
-> (forall a. Num a => Bootstrap v a -> a)
-> (forall a. Num a => Bootstrap v a -> a)
-> Foldable (Bootstrap v)
forall a. Eq a => a -> Bootstrap v a -> Bool
forall a. Num a => Bootstrap v a -> a
forall a. Ord a => Bootstrap v a -> a
forall m. Monoid m => Bootstrap v m -> m
forall a. Bootstrap v a -> Bool
forall a. Bootstrap v a -> Int
forall a. Bootstrap v a -> [a]
forall a. (a -> a -> a) -> Bootstrap v a -> a
forall m a. Monoid m => (a -> m) -> Bootstrap v a -> m
forall b a. (b -> a -> b) -> b -> Bootstrap v a -> b
forall a b. (a -> b -> b) -> b -> Bootstrap v a -> b
forall (v :: * -> *) a.
(Foldable v, Eq a) =>
a -> Bootstrap v a -> Bool
forall (v :: * -> *) a. (Foldable v, Num a) => Bootstrap v a -> a
forall (v :: * -> *) a. (Foldable v, Ord a) => Bootstrap v a -> a
forall (v :: * -> *) m.
(Foldable v, Monoid m) =>
Bootstrap v m -> m
forall (v :: * -> *) a. Foldable v => Bootstrap v a -> Bool
forall (v :: * -> *) a. Foldable v => Bootstrap v a -> Int
forall (v :: * -> *) a. Foldable v => Bootstrap v a -> [a]
forall (v :: * -> *) a.
Foldable v =>
(a -> a -> a) -> Bootstrap v a -> a
forall (v :: * -> *) m a.
(Foldable v, Monoid m) =>
(a -> m) -> Bootstrap v a -> m
forall (v :: * -> *) b a.
Foldable v =>
(b -> a -> b) -> b -> Bootstrap v a -> b
forall (v :: * -> *) a b.
Foldable v =>
(a -> b -> b) -> b -> Bootstrap v a -> b
forall (t :: * -> *).
(forall m. Monoid m => t m -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. t a -> [a])
-> (forall a. t a -> Bool)
-> (forall a. t a -> Int)
-> (forall a. Eq a => a -> t a -> Bool)
-> (forall a. Ord a => t a -> a)
-> (forall a. Ord a => t a -> a)
-> (forall a. Num a => t a -> a)
-> (forall a. Num a => t a -> a)
-> Foldable t
product :: Bootstrap v a -> a
$cproduct :: forall (v :: * -> *) a. (Foldable v, Num a) => Bootstrap v a -> a
sum :: Bootstrap v a -> a
$csum :: forall (v :: * -> *) a. (Foldable v, Num a) => Bootstrap v a -> a
minimum :: Bootstrap v a -> a
$cminimum :: forall (v :: * -> *) a. (Foldable v, Ord a) => Bootstrap v a -> a
maximum :: Bootstrap v a -> a
$cmaximum :: forall (v :: * -> *) a. (Foldable v, Ord a) => Bootstrap v a -> a
elem :: a -> Bootstrap v a -> Bool
$celem :: forall (v :: * -> *) a.
(Foldable v, Eq a) =>
a -> Bootstrap v a -> Bool
length :: Bootstrap v a -> Int
$clength :: forall (v :: * -> *) a. Foldable v => Bootstrap v a -> Int
null :: Bootstrap v a -> Bool
$cnull :: forall (v :: * -> *) a. Foldable v => Bootstrap v a -> Bool
toList :: Bootstrap v a -> [a]
$ctoList :: forall (v :: * -> *) a. Foldable v => Bootstrap v a -> [a]
foldl1 :: (a -> a -> a) -> Bootstrap v a -> a
$cfoldl1 :: forall (v :: * -> *) a.
Foldable v =>
(a -> a -> a) -> Bootstrap v a -> a
foldr1 :: (a -> a -> a) -> Bootstrap v a -> a
$cfoldr1 :: forall (v :: * -> *) a.
Foldable v =>
(a -> a -> a) -> Bootstrap v a -> a
foldl' :: (b -> a -> b) -> b -> Bootstrap v a -> b
$cfoldl' :: forall (v :: * -> *) b a.
Foldable v =>
(b -> a -> b) -> b -> Bootstrap v a -> b
foldl :: (b -> a -> b) -> b -> Bootstrap v a -> b
$cfoldl :: forall (v :: * -> *) b a.
Foldable v =>
(b -> a -> b) -> b -> Bootstrap v a -> b
foldr' :: (a -> b -> b) -> b -> Bootstrap v a -> b
$cfoldr' :: forall (v :: * -> *) a b.
Foldable v =>
(a -> b -> b) -> b -> Bootstrap v a -> b
foldr :: (a -> b -> b) -> b -> Bootstrap v a -> b
$cfoldr :: forall (v :: * -> *) a b.
Foldable v =>
(a -> b -> b) -> b -> Bootstrap v a -> b
foldMap' :: (a -> m) -> Bootstrap v a -> m
$cfoldMap' :: forall (v :: * -> *) m a.
(Foldable v, Monoid m) =>
(a -> m) -> Bootstrap v a -> m
foldMap :: (a -> m) -> Bootstrap v a -> m
$cfoldMap :: forall (v :: * -> *) m a.
(Foldable v, Monoid m) =>
(a -> m) -> Bootstrap v a -> m
fold :: Bootstrap v m -> m
$cfold :: forall (v :: * -> *) m.
(Foldable v, Monoid m) =>
Bootstrap v m -> m
T.Foldable, Functor (Bootstrap v)
Foldable (Bootstrap v)
Functor (Bootstrap v)
-> Foldable (Bootstrap v)
-> (forall (f :: * -> *) a b.
    Applicative f =>
    (a -> f b) -> Bootstrap v a -> f (Bootstrap v b))
-> (forall (f :: * -> *) a.
    Applicative f =>
    Bootstrap v (f a) -> f (Bootstrap v a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> Bootstrap v a -> m (Bootstrap v b))
-> (forall (m :: * -> *) a.
    Monad m =>
    Bootstrap v (m a) -> m (Bootstrap v a))
-> Traversable (Bootstrap v)
(a -> f b) -> Bootstrap v a -> f (Bootstrap v b)
forall (t :: * -> *).
Functor t
-> Foldable t
-> (forall (f :: * -> *) a b.
    Applicative f =>
    (a -> f b) -> t a -> f (t b))
-> (forall (f :: * -> *) a. Applicative f => t (f a) -> f (t a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> t a -> m (t b))
-> (forall (m :: * -> *) a. Monad m => t (m a) -> m (t a))
-> Traversable t
forall (v :: * -> *). Traversable v => Functor (Bootstrap v)
forall (v :: * -> *). Traversable v => Foldable (Bootstrap v)
forall (v :: * -> *) (m :: * -> *) a.
(Traversable v, Monad m) =>
Bootstrap v (m a) -> m (Bootstrap v a)
forall (v :: * -> *) (f :: * -> *) a.
(Traversable v, Applicative f) =>
Bootstrap v (f a) -> f (Bootstrap v a)
forall (v :: * -> *) (m :: * -> *) a b.
(Traversable v, Monad m) =>
(a -> m b) -> Bootstrap v a -> m (Bootstrap v b)
forall (v :: * -> *) (f :: * -> *) a b.
(Traversable v, Applicative f) =>
(a -> f b) -> Bootstrap v a -> f (Bootstrap v b)
forall (m :: * -> *) a.
Monad m =>
Bootstrap v (m a) -> m (Bootstrap v a)
forall (f :: * -> *) a.
Applicative f =>
Bootstrap v (f a) -> f (Bootstrap v a)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Bootstrap v a -> m (Bootstrap v b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Bootstrap v a -> f (Bootstrap v b)
sequence :: Bootstrap v (m a) -> m (Bootstrap v a)
$csequence :: forall (v :: * -> *) (m :: * -> *) a.
(Traversable v, Monad m) =>
Bootstrap v (m a) -> m (Bootstrap v a)
mapM :: (a -> m b) -> Bootstrap v a -> m (Bootstrap v b)
$cmapM :: forall (v :: * -> *) (m :: * -> *) a b.
(Traversable v, Monad m) =>
(a -> m b) -> Bootstrap v a -> m (Bootstrap v b)
sequenceA :: Bootstrap v (f a) -> f (Bootstrap v a)
$csequenceA :: forall (v :: * -> *) (f :: * -> *) a.
(Traversable v, Applicative f) =>
Bootstrap v (f a) -> f (Bootstrap v a)
traverse :: (a -> f b) -> Bootstrap v a -> f (Bootstrap v b)
$ctraverse :: forall (v :: * -> *) (f :: * -> *) a b.
(Traversable v, Applicative f) =>
(a -> f b) -> Bootstrap v a -> f (Bootstrap v b)
$cp2Traversable :: forall (v :: * -> *). Traversable v => Foldable (Bootstrap v)
$cp1Traversable :: forall (v :: * -> *). Traversable v => Functor (Bootstrap v)
T.Traversable
           , Typeable, Typeable (Bootstrap v a)
DataType
Constr
Typeable (Bootstrap v a)
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> Bootstrap v a -> c (Bootstrap v a))
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c (Bootstrap v a))
-> (Bootstrap v a -> Constr)
-> (Bootstrap v a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c (Bootstrap v a)))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c (Bootstrap v a)))
-> ((forall b. Data b => b -> b) -> Bootstrap v a -> Bootstrap v a)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> Bootstrap v a -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> Bootstrap v a -> r)
-> (forall u. (forall d. Data d => d -> u) -> Bootstrap v a -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> Bootstrap v a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d)
    -> Bootstrap v a -> m (Bootstrap v a))
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> Bootstrap v a -> m (Bootstrap v a))
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> Bootstrap v a -> m (Bootstrap v a))
-> Data (Bootstrap v a)
Bootstrap v a -> DataType
Bootstrap v a -> Constr
(forall b. Data b => b -> b) -> Bootstrap v a -> Bootstrap v a
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Bootstrap v a -> c (Bootstrap v a)
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (Bootstrap v a)
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) -> Bootstrap v a -> u
forall u. (forall d. Data d => d -> u) -> Bootstrap v a -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Bootstrap v a -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Bootstrap v a -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> Bootstrap v a -> m (Bootstrap v a)
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> Bootstrap v a -> m (Bootstrap v a)
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (Bootstrap v a)
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Bootstrap v a -> c (Bootstrap v a)
forall (v :: * -> *) a.
(Typeable v, Data a, Data (v a)) =>
Typeable (Bootstrap v a)
forall (v :: * -> *) a.
(Typeable v, Data a, Data (v a)) =>
Bootstrap v a -> DataType
forall (v :: * -> *) a.
(Typeable v, Data a, Data (v a)) =>
Bootstrap v a -> Constr
forall (v :: * -> *) a.
(Typeable v, Data a, Data (v a)) =>
(forall b. Data b => b -> b) -> Bootstrap v a -> Bootstrap v a
forall (v :: * -> *) a u.
(Typeable v, Data a, Data (v a)) =>
Int -> (forall d. Data d => d -> u) -> Bootstrap v a -> u
forall (v :: * -> *) a u.
(Typeable v, Data a, Data (v a)) =>
(forall d. Data d => d -> u) -> Bootstrap v a -> [u]
forall (v :: * -> *) a r r'.
(Typeable v, Data a, Data (v a)) =>
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Bootstrap v a -> r
forall (v :: * -> *) a r r'.
(Typeable v, Data a, Data (v a)) =>
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Bootstrap v a -> r
forall (v :: * -> *) a (m :: * -> *).
(Typeable v, Data a, Data (v a), Monad m) =>
(forall d. Data d => d -> m d)
-> Bootstrap v a -> m (Bootstrap v a)
forall (v :: * -> *) a (m :: * -> *).
(Typeable v, Data a, Data (v a), MonadPlus m) =>
(forall d. Data d => d -> m d)
-> Bootstrap v a -> m (Bootstrap v a)
forall (v :: * -> *) a (c :: * -> *).
(Typeable v, Data a, Data (v a)) =>
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (Bootstrap v a)
forall (v :: * -> *) a (c :: * -> *).
(Typeable v, Data a, Data (v a)) =>
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Bootstrap v a -> c (Bootstrap v a)
forall (v :: * -> *) a (t :: * -> *) (c :: * -> *).
(Typeable v, Data a, Data (v a), Typeable t) =>
(forall d. Data d => c (t d)) -> Maybe (c (Bootstrap v a))
forall (v :: * -> *) a (t :: * -> * -> *) (c :: * -> *).
(Typeable v, Data a, Data (v a), Typeable t) =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (Bootstrap v a))
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c (Bootstrap v a))
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (Bootstrap v a))
$cBootstrap :: Constr
$tBootstrap :: DataType
gmapMo :: (forall d. Data d => d -> m d)
-> Bootstrap v a -> m (Bootstrap v a)
$cgmapMo :: forall (v :: * -> *) a (m :: * -> *).
(Typeable v, Data a, Data (v a), MonadPlus m) =>
(forall d. Data d => d -> m d)
-> Bootstrap v a -> m (Bootstrap v a)
gmapMp :: (forall d. Data d => d -> m d)
-> Bootstrap v a -> m (Bootstrap v a)
$cgmapMp :: forall (v :: * -> *) a (m :: * -> *).
(Typeable v, Data a, Data (v a), MonadPlus m) =>
(forall d. Data d => d -> m d)
-> Bootstrap v a -> m (Bootstrap v a)
gmapM :: (forall d. Data d => d -> m d)
-> Bootstrap v a -> m (Bootstrap v a)
$cgmapM :: forall (v :: * -> *) a (m :: * -> *).
(Typeable v, Data a, Data (v a), Monad m) =>
(forall d. Data d => d -> m d)
-> Bootstrap v a -> m (Bootstrap v a)
gmapQi :: Int -> (forall d. Data d => d -> u) -> Bootstrap v a -> u
$cgmapQi :: forall (v :: * -> *) a u.
(Typeable v, Data a, Data (v a)) =>
Int -> (forall d. Data d => d -> u) -> Bootstrap v a -> u
gmapQ :: (forall d. Data d => d -> u) -> Bootstrap v a -> [u]
$cgmapQ :: forall (v :: * -> *) a u.
(Typeable v, Data a, Data (v a)) =>
(forall d. Data d => d -> u) -> Bootstrap v a -> [u]
gmapQr :: (r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Bootstrap v a -> r
$cgmapQr :: forall (v :: * -> *) a r r'.
(Typeable v, Data a, Data (v a)) =>
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Bootstrap v a -> r
gmapQl :: (r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Bootstrap v a -> r
$cgmapQl :: forall (v :: * -> *) a r r'.
(Typeable v, Data a, Data (v a)) =>
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Bootstrap v a -> r
gmapT :: (forall b. Data b => b -> b) -> Bootstrap v a -> Bootstrap v a
$cgmapT :: forall (v :: * -> *) a.
(Typeable v, Data a, Data (v a)) =>
(forall b. Data b => b -> b) -> Bootstrap v a -> Bootstrap v a
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (Bootstrap v a))
$cdataCast2 :: forall (v :: * -> *) a (t :: * -> * -> *) (c :: * -> *).
(Typeable v, Data a, Data (v a), Typeable t) =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (Bootstrap v a))
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c (Bootstrap v a))
$cdataCast1 :: forall (v :: * -> *) a (t :: * -> *) (c :: * -> *).
(Typeable v, Data a, Data (v a), Typeable t) =>
(forall d. Data d => c (t d)) -> Maybe (c (Bootstrap v a))
dataTypeOf :: Bootstrap v a -> DataType
$cdataTypeOf :: forall (v :: * -> *) a.
(Typeable v, Data a, Data (v a)) =>
Bootstrap v a -> DataType
toConstr :: Bootstrap v a -> Constr
$ctoConstr :: forall (v :: * -> *) a.
(Typeable v, Data a, Data (v a)) =>
Bootstrap v a -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (Bootstrap v a)
$cgunfold :: forall (v :: * -> *) a (c :: * -> *).
(Typeable v, Data a, Data (v a)) =>
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (Bootstrap v a)
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Bootstrap v a -> c (Bootstrap v a)
$cgfoldl :: forall (v :: * -> *) a (c :: * -> *).
(Typeable v, Data a, Data (v a)) =>
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Bootstrap v a -> c (Bootstrap v a)
$cp1Data :: forall (v :: * -> *) a.
(Typeable v, Data a, Data (v a)) =>
Typeable (Bootstrap v a)
Data
           )

instance (Binary a,   Binary   (v a)) => Binary   (Bootstrap v a) where
  get :: Get (Bootstrap v a)
get = (a -> v a -> Bootstrap v a)
-> Get a -> Get (v a) -> Get (Bootstrap v a)
forall (m :: * -> *) a1 a2 r.
Monad m =>
(a1 -> a2 -> r) -> m a1 -> m a2 -> m r
liftM2 a -> v a -> Bootstrap v a
forall (v :: * -> *) a. a -> v a -> Bootstrap v a
Bootstrap Get a
forall t. Binary t => Get t
get Get (v a)
forall t. Binary t => Get t
get
  put :: Bootstrap v a -> Put
put (Bootstrap a
fs v a
rs) = a -> Put
forall t. Binary t => t -> Put
put a
fs Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> v a -> Put
forall t. Binary t => t -> Put
put v a
rs
instance (FromJSON a, FromJSON (v a)) => FromJSON (Bootstrap v a)
instance (ToJSON a,   ToJSON   (v a)) => ToJSON   (Bootstrap v a)



-- | An estimator of a property of a sample, such as its 'mean'.
--
-- The use of an algebraic data type here allows functions such as
-- 'jackknife' and 'bootstrapBCA' to use more efficient algorithms
-- when possible.
data Estimator = Mean
               | Variance
               | VarianceUnbiased
               | StdDev
               | Function (Sample -> Double)

-- | Run an 'Estimator' over a sample.
estimate :: Estimator -> Sample -> Double
estimate :: Estimator -> Vector Double -> Double
estimate Estimator
Mean             = Vector Double -> Double
forall (v :: * -> *). Vector v Double => v Double -> Double
mean
estimate Estimator
Variance         = Vector Double -> Double
forall (v :: * -> *). Vector v Double => v Double -> Double
variance
estimate Estimator
VarianceUnbiased = Vector Double -> Double
forall (v :: * -> *). Vector v Double => v Double -> Double
varianceUnbiased
estimate Estimator
StdDev           = Vector Double -> Double
forall (v :: * -> *). Vector v Double => v Double -> Double
stdDev
estimate (Function Vector Double -> Double
est) = Vector Double -> Double
est


----------------------------------------------------------------
-- Resampling
----------------------------------------------------------------

-- | Single threaded and deterministic version of resample.
resampleST :: PrimMonad m
           => Gen (PrimState m)
           -> [Estimator]         -- ^ Estimation functions.
           -> Int                 -- ^ Number of resamples to compute.
           -> U.Vector Double     -- ^ Original sample.
           -> m [Bootstrap U.Vector Double]
resampleST :: Gen (PrimState m)
-> [Estimator]
-> Int
-> Vector Double
-> m [Bootstrap Vector Double]
resampleST Gen (PrimState m)
gen [Estimator]
ests Int
numResamples Vector Double
sample = do
  -- Generate resamples
  [Vector Double]
res <- [Estimator]
-> (Estimator -> m (Vector Double)) -> m [Vector Double]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [Estimator]
ests ((Estimator -> m (Vector Double)) -> m [Vector Double])
-> (Estimator -> m (Vector Double)) -> m [Vector Double]
forall a b. (a -> b) -> a -> b
$ \Estimator
e -> Int -> m Double -> m (Vector Double)
forall (m :: * -> *) a.
(Monad m, Unbox a) =>
Int -> m a -> m (Vector a)
U.replicateM Int
numResamples (m Double -> m (Vector Double)) -> m Double -> m (Vector Double)
forall a b. (a -> b) -> a -> b
$ do
    Vector Double
v <- Gen (PrimState m) -> Vector Double -> m (Vector Double)
forall (m :: * -> *) (v :: * -> *) a.
(PrimMonad m, Vector v a) =>
Gen (PrimState m) -> v a -> m (v a)
resampleVector Gen (PrimState m)
gen Vector Double
sample
    Double -> m Double
forall (m :: * -> *) a. Monad m => a -> m a
return (Double -> m Double) -> Double -> m Double
forall a b. (a -> b) -> a -> b
$! Estimator -> Vector Double -> Double
estimate Estimator
e Vector Double
v
  -- Sort resamples
  [MVector (PrimState m) Double]
resM <- (Vector Double -> m (MVector (PrimState m) Double))
-> [Vector Double] -> m [MVector (PrimState m) Double]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Vector Double -> m (MVector (PrimState m) Double)
forall (m :: * -> *) (v :: * -> *) a.
(PrimMonad m, Vector v a) =>
v a -> m (Mutable v (PrimState m) a)
unsafeThaw [Vector Double]
res
  (MVector (PrimState m) Double -> m ())
-> [MVector (PrimState m) Double] -> m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ MVector (PrimState m) Double -> m ()
forall (m :: * -> *) (v :: * -> * -> *) e.
(PrimMonad m, MVector v e, Ord e) =>
v (PrimState m) e -> m ()
sort [MVector (PrimState m) Double]
resM
  [Vector Double]
resSorted <- (MVector (PrimState m) Double -> m (Vector Double))
-> [MVector (PrimState m) Double] -> m [Vector Double]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM MVector (PrimState m) Double -> m (Vector Double)
forall (m :: * -> *) (v :: * -> *) a.
(PrimMonad m, Vector v a) =>
Mutable v (PrimState m) a -> m (v a)
unsafeFreeze [MVector (PrimState m) Double]
resM
  [Bootstrap Vector Double] -> m [Bootstrap Vector Double]
forall (m :: * -> *) a. Monad m => a -> m a
return ([Bootstrap Vector Double] -> m [Bootstrap Vector Double])
-> [Bootstrap Vector Double] -> m [Bootstrap Vector Double]
forall a b. (a -> b) -> a -> b
$ (Double -> Vector Double -> Bootstrap Vector Double)
-> [Double] -> [Vector Double] -> [Bootstrap Vector Double]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith Double -> Vector Double -> Bootstrap Vector Double
forall (v :: * -> *) a. a -> v a -> Bootstrap v a
Bootstrap [Estimator -> Vector Double -> Double
estimate Estimator
e Vector Double
sample | Estimator
e <- [Estimator]
ests]
                             [Vector Double]
resSorted


-- | /O(e*r*s)/ Resample a data set repeatedly, with replacement,
-- computing each estimate over the resampled data.
--
-- This function is expensive; it has to do work proportional to
-- /e*r*s/, where /e/ is the number of estimation functions, /r/ is
-- the number of resamples to compute, and /s/ is the number of
-- original samples.
--
-- To improve performance, this function will make use of all
-- available CPUs.  At least with GHC 7.0, parallel performance seems
-- best if the parallel garbage collector is disabled (RTS option
-- @-qg@).
resample :: GenIO
         -> [Estimator]         -- ^ Estimation functions.
         -> Int                 -- ^ Number of resamples to compute.
         -> U.Vector Double     -- ^ Original sample.
         -> IO [(Estimator, Bootstrap U.Vector Double)]
resample :: GenIO
-> [Estimator]
-> Int
-> Vector Double
-> IO [(Estimator, Bootstrap Vector Double)]
resample GenIO
gen [Estimator]
ests Int
numResamples Vector Double
samples = do
  let ixs :: [Int]
ixs = (Int -> Int -> Int) -> Int -> [Int] -> [Int]
forall b a. (b -> a -> b) -> b -> [a] -> [b]
scanl Int -> Int -> Int
forall a. Num a => a -> a -> a
(+) Int
0 ([Int] -> [Int]) -> [Int] -> [Int]
forall a b. (a -> b) -> a -> b
$
            (Int -> Int -> Int) -> [Int] -> [Int] -> [Int]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith Int -> Int -> Int
forall a. Num a => a -> a -> a
(+) (Int -> Int -> [Int]
forall a. Int -> a -> [a]
replicate Int
numCapabilities Int
q)
                        (Int -> Int -> [Int]
forall a. Int -> a -> [a]
replicate Int
r Int
1 [Int] -> [Int] -> [Int]
forall a. [a] -> [a] -> [a]
++ Int -> [Int]
forall a. a -> [a]
repeat Int
0)
          where (Int
q,Int
r) = Int
numResamples Int -> Int -> (Int, Int)
forall a. Integral a => a -> a -> (a, a)
`quotRem` Int
numCapabilities
  [MVector RealWorld Double]
results <- (Estimator -> IO (MVector RealWorld Double))
-> [Estimator] -> IO [MVector RealWorld Double]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (IO (MVector RealWorld Double)
-> Estimator -> IO (MVector RealWorld Double)
forall a b. a -> b -> a
const (Int -> IO (MVector (PrimState IO) Double)
forall (m :: * -> *) a.
(PrimMonad m, Unbox a) =>
Int -> m (MVector (PrimState m) a)
MU.new Int
numResamples)) [Estimator]
ests
  [Gen RealWorld]
gens <- Int -> GenIO -> IO [GenIO]
splitGen Int
numCapabilities GenIO
gen
  [(Int, Int, Gen RealWorld)]
-> ((Int, Int, Gen RealWorld) -> IO ()) -> IO ()
forall (f :: * -> *) a b. Foldable f => f a -> (a -> IO b) -> IO ()
forConcurrently_ ([Int] -> [Int] -> [Gen RealWorld] -> [(Int, Int, Gen RealWorld)]
forall a b c. [a] -> [b] -> [c] -> [(a, b, c)]
zip3 [Int]
ixs ([Int] -> [Int]
forall a. [a] -> [a]
tail [Int]
ixs) [Gen RealWorld]
gens) (((Int, Int, Gen RealWorld) -> IO ()) -> IO ())
-> ((Int, Int, Gen RealWorld) -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \ (Int
start,!Int
end,Gen RealWorld
gen') -> do
    -- on GHCJS it doesn't make sense to do any forking.
    -- JavaScript runtime has only single capability.
      let loop :: Int
-> [(Vector Double -> Double, MVector RealWorld Double)] -> IO ()
loop Int
k [(Vector Double -> Double, MVector RealWorld Double)]
ers | Int
k Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
end = () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
                     | Bool
otherwise = do
            Vector Double
re <- GenIO -> Vector Double -> IO (Vector Double)
forall (m :: * -> *) (v :: * -> *) a.
(PrimMonad m, Vector v a) =>
Gen (PrimState m) -> v a -> m (v a)
resampleVector Gen RealWorld
GenIO
gen' Vector Double
samples
            [(Vector Double -> Double, MVector RealWorld Double)]
-> ((Vector Double -> Double, MVector RealWorld Double) -> IO ())
-> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [(Vector Double -> Double, MVector RealWorld Double)]
ers (((Vector Double -> Double, MVector RealWorld Double) -> IO ())
 -> IO ())
-> ((Vector Double -> Double, MVector RealWorld Double) -> IO ())
-> IO ()
forall a b. (a -> b) -> a -> b
$ \(Vector Double -> Double
est,MVector RealWorld Double
arr) ->
                MVector (PrimState IO) Double -> Int -> Double -> IO ()
forall (m :: * -> *) a.
(PrimMonad m, Unbox a) =>
MVector (PrimState m) a -> Int -> a -> m ()
MU.write MVector RealWorld Double
MVector (PrimState IO) Double
arr Int
k (Double -> IO ())
-> (Vector Double -> Double) -> Vector Double -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Vector Double -> Double
est (Vector Double -> IO ()) -> Vector Double -> IO ()
forall a b. (a -> b) -> a -> b
$ Vector Double
re
            Int
-> [(Vector Double -> Double, MVector RealWorld Double)] -> IO ()
loop (Int
kInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) [(Vector Double -> Double, MVector RealWorld Double)]
ers
      Int
-> [(Vector Double -> Double, MVector RealWorld Double)] -> IO ()
loop Int
start ([Vector Double -> Double]
-> [MVector RealWorld Double]
-> [(Vector Double -> Double, MVector RealWorld Double)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Vector Double -> Double]
ests' [MVector RealWorld Double]
results)
  (MVector RealWorld Double -> IO ())
-> [MVector RealWorld Double] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ MVector RealWorld Double -> IO ()
forall (m :: * -> *) (v :: * -> * -> *) e.
(PrimMonad m, MVector v e, Ord e) =>
v (PrimState m) e -> m ()
sort [MVector RealWorld Double]
results
  -- Build resamples
  [Vector Double]
res <- (MVector RealWorld Double -> IO (Vector Double))
-> [MVector RealWorld Double] -> IO [Vector Double]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM MVector RealWorld Double -> IO (Vector Double)
forall (m :: * -> *) (v :: * -> *) a.
(PrimMonad m, Vector v a) =>
Mutable v (PrimState m) a -> m (v a)
unsafeFreeze [MVector RealWorld Double]
results
  [(Estimator, Bootstrap Vector Double)]
-> IO [(Estimator, Bootstrap Vector Double)]
forall (m :: * -> *) a. Monad m => a -> m a
return ([(Estimator, Bootstrap Vector Double)]
 -> IO [(Estimator, Bootstrap Vector Double)])
-> [(Estimator, Bootstrap Vector Double)]
-> IO [(Estimator, Bootstrap Vector Double)]
forall a b. (a -> b) -> a -> b
$ [Estimator]
-> [Bootstrap Vector Double]
-> [(Estimator, Bootstrap Vector Double)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Estimator]
ests
         ([Bootstrap Vector Double]
 -> [(Estimator, Bootstrap Vector Double)])
-> [Bootstrap Vector Double]
-> [(Estimator, Bootstrap Vector Double)]
forall a b. (a -> b) -> a -> b
$ (Double -> Vector Double -> Bootstrap Vector Double)
-> [Double] -> [Vector Double] -> [Bootstrap Vector Double]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith Double -> Vector Double -> Bootstrap Vector Double
forall (v :: * -> *) a. a -> v a -> Bootstrap v a
Bootstrap [Estimator -> Vector Double -> Double
estimate Estimator
e Vector Double
samples | Estimator
e <- [Estimator]
ests]
                             [Vector Double]
res
 where
  ests' :: [Vector Double -> Double]
ests' = (Estimator -> Vector Double -> Double)
-> [Estimator] -> [Vector Double -> Double]
forall a b. (a -> b) -> [a] -> [b]
map Estimator -> Vector Double -> Double
estimate [Estimator]
ests

-- | Create vector using resamples
resampleVector :: (PrimMonad m, G.Vector v a)
               => Gen (PrimState m) -> v a -> m (v a)
resampleVector :: Gen (PrimState m) -> v a -> m (v a)
resampleVector Gen (PrimState m)
gen v a
v
  = Int -> m a -> m (v a)
forall (m :: * -> *) (v :: * -> *) a.
(Monad m, Vector v a) =>
Int -> m a -> m (v a)
G.replicateM Int
n (m a -> m (v a)) -> m a -> m (v a)
forall a b. (a -> b) -> a -> b
$ do Int
i <- (Int, Int) -> Gen (PrimState m) -> m Int
forall a (m :: * -> *).
(Variate a, PrimMonad m) =>
(a, a) -> Gen (PrimState m) -> m a
uniformR (Int
0,Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) Gen (PrimState m)
gen
                        a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (a -> m a) -> a -> m a
forall a b. (a -> b) -> a -> b
$! v a -> Int -> a
forall (v :: * -> *) a. Vector v a => v a -> Int -> a
G.unsafeIndex v a
v Int
i
  where
    n :: Int
n = v a -> Int
forall (v :: * -> *) a. Vector v a => v a -> Int
G.length v a
v


----------------------------------------------------------------
-- Jackknife
----------------------------------------------------------------

-- | /O(n) or O(n^2)/ Compute a statistical estimate repeatedly over a
-- sample, each time omitting a successive element.
jackknife :: Estimator -> Sample -> U.Vector Double
jackknife :: Estimator -> Vector Double -> Vector Double
jackknife Estimator
Mean Vector Double
sample             = Vector Double -> Vector Double
jackknifeMean Vector Double
sample
jackknife Estimator
Variance Vector Double
sample         = Vector Double -> Vector Double
jackknifeVariance Vector Double
sample
jackknife Estimator
VarianceUnbiased Vector Double
sample = Vector Double -> Vector Double
jackknifeVarianceUnb Vector Double
sample
jackknife Estimator
StdDev Vector Double
sample = Vector Double -> Vector Double
jackknifeStdDev Vector Double
sample
jackknife (Function Vector Double -> Double
est) Vector Double
sample
  | Vector Double -> Int
forall (v :: * -> *) a. Vector v a => v a -> Int
G.length Vector Double
sample Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
1 = String -> Vector Double
forall a. String -> a
singletonErr String
"jackknife"
  | Bool
otherwise            = (Int -> Double) -> Vector Int -> Vector Double
forall a b. (Unbox a, Unbox b) => (a -> b) -> Vector a -> Vector b
U.map Int -> Double
f (Vector Int -> Vector Double)
-> (Vector Double -> Vector Int) -> Vector Double -> Vector Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Vector Double -> Vector Int
forall (v :: * -> *) a. (Vector v a, Vector v Int) => v a -> v Int
indices (Vector Double -> Vector Double) -> Vector Double -> Vector Double
forall a b. (a -> b) -> a -> b
$ Vector Double
sample
  where f :: Int -> Double
f Int
i = Vector Double -> Double
est (Int -> Vector Double -> Vector Double
forall e. Unbox e => Int -> Vector e -> Vector e
dropAt Int
i Vector Double
sample)

-- | /O(n)/ Compute the jackknife mean of a sample.
jackknifeMean :: Sample -> U.Vector Double
jackknifeMean :: Vector Double -> Vector Double
jackknifeMean Vector Double
samp
  | Int
len Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
1  = String -> Vector Double
forall a. String -> a
singletonErr String
"jackknifeMean"
  | Bool
otherwise = (Double -> Double) -> Vector Double -> Vector Double
forall (v :: * -> *) a b.
(Vector v a, Vector v b) =>
(a -> b) -> v a -> v b
G.map (Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/Double
l) (Vector Double -> Vector Double) -> Vector Double -> Vector Double
forall a b. (a -> b) -> a -> b
$ (Double -> Double -> Double)
-> Vector Double -> Vector Double -> Vector Double
forall (v :: * -> *) a b c.
(Vector v a, Vector v b, Vector v c) =>
(a -> b -> c) -> v a -> v b -> v c
G.zipWith Double -> Double -> Double
forall a. Num a => a -> a -> a
(+) (Vector Double -> Vector Double
pfxSumL Vector Double
samp) (Vector Double -> Vector Double
pfxSumR Vector Double
samp)
  where
    l :: Double
l   = Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int
len Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)
    len :: Int
len = Vector Double -> Int
forall (v :: * -> *) a. Vector v a => v a -> Int
G.length Vector Double
samp

-- | /O(n)/ Compute the jackknife variance of a sample with a
-- correction factor @c@, so we can get either the regular or
-- \"unbiased\" variance.
jackknifeVariance_ :: Double -> Sample -> U.Vector Double
jackknifeVariance_ :: Double -> Vector Double -> Vector Double
jackknifeVariance_ Double
c Vector Double
samp
  | Int
len Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
1  = String -> Vector Double
forall a. String -> a
singletonErr String
"jackknifeVariance"
  | Bool
otherwise = (Double -> Double -> Double -> Double -> Double)
-> Vector Double
-> Vector Double
-> Vector Double
-> Vector Double
-> Vector Double
forall (v :: * -> *) a b c d e.
(Vector v a, Vector v b, Vector v c, Vector v d, Vector v e) =>
(a -> b -> c -> d -> e) -> v a -> v b -> v c -> v d -> v e
G.zipWith4 Double -> Double -> Double -> Double -> Double
go Vector Double
als Vector Double
ars Vector Double
bls Vector Double
brs
  where
    als :: Vector Double
als = Vector Double -> Vector Double
pfxSumL (Vector Double -> Vector Double)
-> (Vector Double -> Vector Double)
-> Vector Double
-> Vector Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Double -> Double) -> Vector Double -> Vector Double
forall (v :: * -> *) a b.
(Vector v a, Vector v b) =>
(a -> b) -> v a -> v b
G.map Double -> Double
goa (Vector Double -> Vector Double) -> Vector Double -> Vector Double
forall a b. (a -> b) -> a -> b
$ Vector Double
samp
    ars :: Vector Double
ars = Vector Double -> Vector Double
pfxSumR (Vector Double -> Vector Double)
-> (Vector Double -> Vector Double)
-> Vector Double
-> Vector Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Double -> Double) -> Vector Double -> Vector Double
forall (v :: * -> *) a b.
(Vector v a, Vector v b) =>
(a -> b) -> v a -> v b
G.map Double -> Double
goa (Vector Double -> Vector Double) -> Vector Double -> Vector Double
forall a b. (a -> b) -> a -> b
$ Vector Double
samp
    goa :: Double -> Double
goa Double
x = Double
v Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
v where v :: Double
v = Double
x Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
m
    bls :: Vector Double
bls = Vector Double -> Vector Double
pfxSumL (Vector Double -> Vector Double)
-> (Vector Double -> Vector Double)
-> Vector Double
-> Vector Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Double -> Double) -> Vector Double -> Vector Double
forall (v :: * -> *) a b.
(Vector v a, Vector v b) =>
(a -> b) -> v a -> v b
G.map (Double -> Double -> Double
forall a. Num a => a -> a -> a
subtract Double
m) (Vector Double -> Vector Double) -> Vector Double -> Vector Double
forall a b. (a -> b) -> a -> b
$ Vector Double
samp
    brs :: Vector Double
brs = Vector Double -> Vector Double
pfxSumR (Vector Double -> Vector Double)
-> (Vector Double -> Vector Double)
-> Vector Double
-> Vector Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Double -> Double) -> Vector Double -> Vector Double
forall (v :: * -> *) a b.
(Vector v a, Vector v b) =>
(a -> b) -> v a -> v b
G.map (Double -> Double -> Double
forall a. Num a => a -> a -> a
subtract Double
m) (Vector Double -> Vector Double) -> Vector Double -> Vector Double
forall a b. (a -> b) -> a -> b
$ Vector Double
samp
    m :: Double
m = Vector Double -> Double
forall (v :: * -> *). Vector v Double => v Double -> Double
mean Vector Double
samp
    n :: Double
n = Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
len
    go :: Double -> Double -> Double -> Double -> Double
go Double
al Double
ar Double
bl Double
br = (Double
al Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
ar Double -> Double -> Double
forall a. Num a => a -> a -> a
- (Double
b Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
b) Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
q) Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ (Double
q Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
c)
      where b :: Double
b = Double
bl Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
br
            q :: Double
q = Double
n Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
1
    len :: Int
len = Vector Double -> Int
forall (v :: * -> *) a. Vector v a => v a -> Int
G.length Vector Double
samp

-- | /O(n)/ Compute the unbiased jackknife variance of a sample.
jackknifeVarianceUnb :: Sample -> U.Vector Double
jackknifeVarianceUnb :: Vector Double -> Vector Double
jackknifeVarianceUnb Vector Double
samp
  | Vector Double -> Int
forall (v :: * -> *) a. Vector v a => v a -> Int
G.length Vector Double
samp Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
2  = String -> Vector Double
forall a. String -> a
singletonErr String
"jackknifeVariance"
  | Bool
otherwise           = Double -> Vector Double -> Vector Double
jackknifeVariance_ Double
1 Vector Double
samp

-- | /O(n)/ Compute the jackknife variance of a sample.
jackknifeVariance :: Sample -> U.Vector Double
jackknifeVariance :: Vector Double -> Vector Double
jackknifeVariance = Double -> Vector Double -> Vector Double
jackknifeVariance_ Double
0

-- | /O(n)/ Compute the jackknife standard deviation of a sample.
jackknifeStdDev :: Sample -> U.Vector Double
jackknifeStdDev :: Vector Double -> Vector Double
jackknifeStdDev = (Double -> Double) -> Vector Double -> Vector Double
forall (v :: * -> *) a b.
(Vector v a, Vector v b) =>
(a -> b) -> v a -> v b
G.map Double -> Double
forall a. Floating a => a -> a
sqrt (Vector Double -> Vector Double)
-> (Vector Double -> Vector Double)
-> Vector Double
-> Vector Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Vector Double -> Vector Double
jackknifeVarianceUnb

pfxSumL :: U.Vector Double -> U.Vector Double
pfxSumL :: Vector Double -> Vector Double
pfxSumL = (KBNSum -> Double) -> Vector KBNSum -> Vector Double
forall (v :: * -> *) a b.
(Vector v a, Vector v b) =>
(a -> b) -> v a -> v b
G.map KBNSum -> Double
kbn (Vector KBNSum -> Vector Double)
-> (Vector Double -> Vector KBNSum)
-> Vector Double
-> Vector Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (KBNSum -> Double -> KBNSum)
-> KBNSum -> Vector Double -> Vector KBNSum
forall (v :: * -> *) a b.
(Vector v a, Vector v b) =>
(a -> b -> a) -> a -> v b -> v a
G.scanl KBNSum -> Double -> KBNSum
forall s. Summation s => s -> Double -> s
add KBNSum
forall s. Summation s => s
zero

pfxSumR :: U.Vector Double -> U.Vector Double
pfxSumR :: Vector Double -> Vector Double
pfxSumR = Vector Double -> Vector Double
forall (v :: * -> *) a. Vector v a => v a -> v a
G.tail (Vector Double -> Vector Double)
-> (Vector Double -> Vector Double)
-> Vector Double
-> Vector Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (KBNSum -> Double) -> Vector KBNSum -> Vector Double
forall (v :: * -> *) a b.
(Vector v a, Vector v b) =>
(a -> b) -> v a -> v b
G.map KBNSum -> Double
kbn (Vector KBNSum -> Vector Double)
-> (Vector Double -> Vector KBNSum)
-> Vector Double
-> Vector Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Double -> KBNSum -> KBNSum)
-> KBNSum -> Vector Double -> Vector KBNSum
forall (v :: * -> *) a b.
(Vector v a, Vector v b) =>
(a -> b -> b) -> b -> v a -> v b
G.scanr ((KBNSum -> Double -> KBNSum) -> Double -> KBNSum -> KBNSum
forall a b c. (a -> b -> c) -> b -> a -> c
flip KBNSum -> Double -> KBNSum
forall s. Summation s => s -> Double -> s
add) KBNSum
forall s. Summation s => s
zero

-- | Drop the /k/th element of a vector.
dropAt :: U.Unbox e => Int -> U.Vector e -> U.Vector e
dropAt :: Int -> Vector e -> Vector e
dropAt Int
n Vector e
v = Int -> Int -> Vector e -> Vector e
forall a. Unbox a => Int -> Int -> Vector a -> Vector a
U.slice Int
0 Int
n Vector e
v Vector e -> Vector e -> Vector e
forall a. Unbox a => Vector a -> Vector a -> Vector a
U.++ Int -> Int -> Vector e -> Vector e
forall a. Unbox a => Int -> Int -> Vector a -> Vector a
U.slice (Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) (Vector e -> Int
forall a. Unbox a => Vector a -> Int
U.length Vector e
v Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) Vector e
v

singletonErr :: String -> a
singletonErr :: String -> a
singletonErr String
func = String -> a
forall a. HasCallStack => String -> a
error (String -> a) -> String -> a
forall a b. (a -> b) -> a -> b
$
                    String
"Statistics.Resampling." String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
func String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
": not enough elements in sample"

-- | Split a generator into several that can run independently.
splitGen :: Int -> GenIO -> IO [GenIO]
splitGen :: Int -> GenIO -> IO [GenIO]
splitGen Int
n GenIO
gen
  | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0    = [Gen RealWorld] -> IO [Gen RealWorld]
forall (m :: * -> *) a. Monad m => a -> m a
return []
  | Bool
otherwise =
  ([Gen RealWorld] -> [Gen RealWorld])
-> IO [Gen RealWorld] -> IO [Gen RealWorld]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Gen RealWorld
GenIO
genGen RealWorld -> [Gen RealWorld] -> [Gen RealWorld]
forall a. a -> [a] -> [a]
:) (IO [Gen RealWorld] -> IO [Gen RealWorld])
-> (IO (Gen RealWorld) -> IO [Gen RealWorld])
-> IO (Gen RealWorld)
-> IO [Gen RealWorld]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> IO (Gen RealWorld) -> IO [Gen RealWorld]
forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
replicateM (Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) (IO (Gen RealWorld) -> IO [Gen RealWorld])
-> IO (Gen RealWorld) -> IO [Gen RealWorld]
forall a b. (a -> b) -> a -> b
$
  Vector Word32 -> IO (Gen RealWorld)
forall (m :: * -> *) (v :: * -> *).
(PrimMonad m, Vector v Word32) =>
v Word32 -> m (Gen (PrimState m))
initialize (Vector Word32 -> IO (Gen RealWorld))
-> IO (Vector Word32) -> IO (Gen RealWorld)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< (Gen RealWorld -> Int -> IO (Vector Word32)
forall (m :: * -> *) g a (v :: * -> *).
(PrimMonad m, StatefulGen g m, Uniform a, Vector v a) =>
g -> Int -> m (v a)
uniformVector Gen RealWorld
GenIO
gen Int
256 :: IO (U.Vector Word32))