{-# 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
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]
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
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
Resample -> DataType
Resample -> Constr
(forall b. Data b => b -> b) -> Resample -> 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)
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(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 (m :: * -> *).
MonadPlus m =>
(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 (m :: * -> *).
Monad m =>
(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 :: forall u. Int -> (forall d. Data d => d -> u) -> Resample -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Resample -> u
gmapQ :: forall u. (forall d. Data d => d -> u) -> Resample -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> Resample -> [u]
gmapQr :: forall r r'.
(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 :: forall r r'.
(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 (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(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 (t :: * -> *) (c :: * -> *).
Typeable t =>
(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 (c :: * -> *).
(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 (c :: * -> *).
(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
Data, 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 = forall t. Binary t => t -> Put
put forall b c a. (b -> c) -> (a -> b) -> a -> c
. Resample -> Vector Double
fromResample
    get :: Get Resample
get = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Vector Double -> Resample
Resample forall t. Binary t => Get t
get

data Bootstrap v a = Bootstrap
  { forall (v :: * -> *) a. Bootstrap v a -> a
fullSample :: !a
  , forall (v :: * -> *) a. Bootstrap v a -> v a
resamples  :: v a
  }
  deriving (Bootstrap v a -> Bootstrap v a -> Bool
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)
ReadS [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
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 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, 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
<$ :: forall a b. a -> Bootstrap v b -> Bootstrap v a
$c<$ :: forall (v :: * -> *) a b.
Functor v =>
a -> Bootstrap v b -> Bootstrap v a
fmap :: forall a b. (a -> b) -> Bootstrap v a -> Bootstrap v b
$cfmap :: forall (v :: * -> *) a b.
Functor v =>
(a -> b) -> Bootstrap v a -> Bootstrap v b
Functor, forall a. Bootstrap v a -> Bool
forall m a. Monoid m => (a -> m) -> Bootstrap v a -> m
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 :: forall a. Num a => Bootstrap v a -> a
$cproduct :: forall (v :: * -> *) a. (Foldable v, Num a) => Bootstrap v a -> a
sum :: forall a. Num a => Bootstrap v a -> a
$csum :: forall (v :: * -> *) a. (Foldable v, Num a) => Bootstrap v a -> a
minimum :: forall a. Ord a => Bootstrap v a -> a
$cminimum :: forall (v :: * -> *) a. (Foldable v, Ord a) => Bootstrap v a -> a
maximum :: forall a. Ord a => Bootstrap v a -> a
$cmaximum :: forall (v :: * -> *) a. (Foldable v, Ord a) => Bootstrap v a -> a
elem :: forall a. Eq a => a -> Bootstrap v a -> Bool
$celem :: forall (v :: * -> *) a.
(Foldable v, Eq a) =>
a -> Bootstrap v a -> Bool
length :: forall a. Bootstrap v a -> Int
$clength :: forall (v :: * -> *) a. Foldable v => Bootstrap v a -> Int
null :: forall a. Bootstrap v a -> Bool
$cnull :: forall (v :: * -> *) a. Foldable v => Bootstrap v a -> Bool
toList :: forall a. Bootstrap v a -> [a]
$ctoList :: forall (v :: * -> *) a. Foldable v => Bootstrap v a -> [a]
foldl1 :: forall a. (a -> a -> a) -> Bootstrap v a -> a
$cfoldl1 :: forall (v :: * -> *) a.
Foldable v =>
(a -> a -> a) -> Bootstrap v a -> a
foldr1 :: forall a. (a -> a -> a) -> Bootstrap v a -> a
$cfoldr1 :: forall (v :: * -> *) a.
Foldable v =>
(a -> a -> a) -> Bootstrap v a -> a
foldl' :: forall b a. (b -> a -> b) -> b -> Bootstrap v a -> b
$cfoldl' :: forall (v :: * -> *) b a.
Foldable v =>
(b -> a -> b) -> b -> Bootstrap v a -> b
foldl :: forall b a. (b -> a -> b) -> b -> Bootstrap v a -> b
$cfoldl :: forall (v :: * -> *) b a.
Foldable v =>
(b -> a -> b) -> b -> Bootstrap v a -> b
foldr' :: forall a b. (a -> b -> b) -> b -> Bootstrap v a -> b
$cfoldr' :: forall (v :: * -> *) a b.
Foldable v =>
(a -> b -> b) -> b -> Bootstrap v a -> b
foldr :: forall a b. (a -> b -> b) -> b -> Bootstrap v a -> b
$cfoldr :: forall (v :: * -> *) a b.
Foldable v =>
(a -> b -> b) -> b -> Bootstrap v a -> b
foldMap' :: forall m a. Monoid m => (a -> m) -> Bootstrap v a -> m
$cfoldMap' :: forall (v :: * -> *) m a.
(Foldable v, Monoid m) =>
(a -> m) -> Bootstrap v a -> m
foldMap :: forall m a. Monoid m => (a -> m) -> Bootstrap v a -> m
$cfoldMap :: forall (v :: * -> *) m a.
(Foldable v, Monoid m) =>
(a -> m) -> Bootstrap v a -> m
fold :: forall m. Monoid m => Bootstrap v m -> m
$cfold :: forall (v :: * -> *) m.
(Foldable v, Monoid m) =>
Bootstrap v m -> m
T.Foldable, 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 (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Bootstrap v a -> f (Bootstrap v b)
sequence :: forall (m :: * -> *) a.
Monad m =>
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 :: forall (m :: * -> *) a b.
Monad m =>
(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 :: forall (f :: * -> *) a.
Applicative f =>
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 :: forall (f :: * -> *) a b.
Applicative f =>
(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)
T.Traversable
           , Typeable, Bootstrap v a -> DataType
Bootstrap v a -> Constr
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (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))
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(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 (m :: * -> *).
MonadPlus m =>
(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 (m :: * -> *).
Monad m =>
(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 :: forall u. 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 u. (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 :: forall r r'.
(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 :: forall r r'.
(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 (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(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 (t :: * -> *) (c :: * -> *).
Typeable t =>
(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 (c :: * -> *).
(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 (c :: * -> *).
(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)
Data
           )

instance (Binary a,   Binary   (v a)) => Binary   (Bootstrap v a) where
  get :: Get (Bootstrap v a)
get = forall (m :: * -> *) a1 a2 r.
Monad m =>
(a1 -> a2 -> r) -> m a1 -> m a2 -> m r
liftM2 forall (v :: * -> *) a. a -> v a -> Bootstrap v a
Bootstrap forall t. Binary t => Get t
get forall t. Binary t => Get t
get
  put :: Bootstrap v a -> Put
put (Bootstrap a
fs v a
rs) = forall t. Binary t => t -> Put
put a
fs forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> 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             = forall (v :: * -> *). Vector v Double => v Double -> Double
mean
estimate Estimator
Variance         = forall (v :: * -> *). Vector v Double => v Double -> Double
variance
estimate Estimator
VarianceUnbiased = forall (v :: * -> *). Vector v Double => v Double -> Double
varianceUnbiased
estimate Estimator
StdDev           = 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 :: forall (m :: * -> *).
PrimMonad m =>
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 <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [Estimator]
ests forall a b. (a -> b) -> a -> b
$ \Estimator
e -> forall (m :: * -> *) a.
(Monad m, Unbox a) =>
Int -> m a -> m (Vector a)
U.replicateM Int
numResamples forall a b. (a -> b) -> a -> b
$ do
    Vector Double
v <- 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
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$! Estimator -> Vector Double -> Double
estimate Estimator
e Vector Double
v
  -- Sort resamples
  [MVector (PrimState m) Double]
resM <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM forall (m :: * -> *) (v :: * -> *) a.
(PrimMonad m, Vector v a) =>
v a -> m (Mutable v (PrimState m) a)
unsafeThaw [Vector Double]
res
  forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ 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 <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM forall (m :: * -> *) (v :: * -> *) a.
(PrimMonad m, Vector v a) =>
Mutable v (PrimState m) a -> m (v a)
unsafeFreeze [MVector (PrimState m) Double]
resM
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith 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 = forall b a. (b -> a -> b) -> b -> [a] -> [b]
scanl forall a. Num a => a -> a -> a
(+) Int
0 forall a b. (a -> b) -> a -> b
$
            forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith forall a. Num a => a -> a -> a
(+) (forall a. Int -> a -> [a]
replicate Int
numCapabilities Int
q)
                        (forall a. Int -> a -> [a]
replicate Int
r Int
1 forall a. [a] -> [a] -> [a]
++ forall a. a -> [a]
repeat Int
0)
          where (Int
q,Int
r) = Int
numResamples forall a. Integral a => a -> a -> (a, a)
`quotRem` Int
numCapabilities
  [MVector RealWorld Double]
results <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (forall a b. a -> b -> a
const (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
  forall (f :: * -> *) a b. Foldable f => f a -> (a -> IO b) -> IO ()
forConcurrently_ (forall a b c. [a] -> [b] -> [c] -> [(a, b, c)]
zip3 [Int]
ixs (forall a. [a] -> [a]
tail [Int]
ixs) [Gen RealWorld]
gens) 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 forall a. Ord a => a -> a -> Bool
>= Int
end = forall (m :: * -> *) a. Monad m => a -> m a
return ()
                     | Bool
otherwise = do
            Vector Double
re <- forall (m :: * -> *) (v :: * -> *) a.
(PrimMonad m, Vector v a) =>
Gen (PrimState m) -> v a -> m (v a)
resampleVector Gen RealWorld
gen' Vector Double
samples
            forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [(Vector Double -> Double, MVector RealWorld Double)]
ers forall a b. (a -> b) -> a -> b
$ \(Vector Double -> Double
est,MVector RealWorld Double
arr) ->
                forall (m :: * -> *) a.
(PrimMonad m, Unbox a) =>
MVector (PrimState m) a -> Int -> a -> m ()
MU.write MVector RealWorld Double
arr Int
k forall b c a. (b -> c) -> (a -> b) -> a -> c
. Vector Double -> Double
est forall a b. (a -> b) -> a -> b
$ Vector Double
re
            Int
-> [(Vector Double -> Double, MVector RealWorld Double)] -> IO ()
loop (Int
kforall 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 (forall a b. [a] -> [b] -> [(a, b)]
zip [Vector Double -> Double]
ests' [MVector RealWorld Double]
results)
  forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ 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 <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM forall (m :: * -> *) (v :: * -> *) a.
(PrimMonad m, Vector v a) =>
Mutable v (PrimState m) a -> m (v a)
unsafeFreeze [MVector RealWorld Double]
results
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a b. [a] -> [b] -> [(a, b)]
zip [Estimator]
ests
         forall a b. (a -> b) -> a -> b
$ forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith 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' = 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 :: forall (m :: * -> *) (v :: * -> *) a.
(PrimMonad m, Vector v a) =>
Gen (PrimState m) -> v a -> m (v a)
resampleVector Gen (PrimState m)
gen v a
v
  = forall (m :: * -> *) (v :: * -> *) a.
(Monad m, Vector v a) =>
Int -> m a -> m (v a)
G.replicateM Int
n forall a b. (a -> b) -> a -> b
$ do Int
i <- forall a (m :: * -> *).
(Variate a, PrimMonad m) =>
(a, a) -> Gen (PrimState m) -> m a
uniformR (Int
0,Int
nforall a. Num a => a -> a -> a
-Int
1) Gen (PrimState m)
gen
                        forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$! forall (v :: * -> *) a. Vector v a => v a -> Int -> a
G.unsafeIndex v a
v Int
i
  where
    n :: Int
n = 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
  | forall (v :: * -> *) a. Vector v a => v a -> Int
G.length Vector Double
sample forall a. Eq a => a -> a -> Bool
== Int
1 = forall a. String -> a
singletonErr String
"jackknife"
  | Bool
otherwise            = forall a b. (Unbox a, Unbox b) => (a -> b) -> Vector a -> Vector b
U.map Int -> Double
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (v :: * -> *) a. (Vector v a, Vector v Int) => v a -> v Int
indices forall a b. (a -> b) -> a -> b
$ Vector Double
sample
  where f :: Int -> Double
f Int
i = Vector Double -> Double
est (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 forall a. Eq a => a -> a -> Bool
== Int
1  = forall a. String -> a
singletonErr String
"jackknifeMean"
  | Bool
otherwise = forall (v :: * -> *) a b.
(Vector v a, Vector v b) =>
(a -> b) -> v a -> v b
G.map (forall a. Fractional a => a -> a -> a
/Double
l) forall a b. (a -> b) -> a -> b
$ 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 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   = forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int
len forall a. Num a => a -> a -> a
- Int
1)
    len :: Int
len = 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 forall a. Eq a => a -> a -> Bool
== Int
1  = forall a. String -> a
singletonErr String
"jackknifeVariance"
  | Bool
otherwise = 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 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (v :: * -> *) a b.
(Vector v a, Vector v b) =>
(a -> b) -> v a -> v b
G.map Double -> Double
goa forall a b. (a -> b) -> a -> b
$ Vector Double
samp
    ars :: Vector Double
ars = Vector Double -> Vector Double
pfxSumR forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (v :: * -> *) a b.
(Vector v a, Vector v b) =>
(a -> b) -> v a -> v b
G.map Double -> Double
goa forall a b. (a -> b) -> a -> b
$ Vector Double
samp
    goa :: Double -> Double
goa Double
x = Double
v forall a. Num a => a -> a -> a
* Double
v where v :: Double
v = Double
x forall a. Num a => a -> a -> a
- Double
m
    bls :: Vector Double
bls = Vector Double -> Vector Double
pfxSumL forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (v :: * -> *) a b.
(Vector v a, Vector v b) =>
(a -> b) -> v a -> v b
G.map (forall a. Num a => a -> a -> a
subtract Double
m) forall a b. (a -> b) -> a -> b
$ Vector Double
samp
    brs :: Vector Double
brs = Vector Double -> Vector Double
pfxSumR forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (v :: * -> *) a b.
(Vector v a, Vector v b) =>
(a -> b) -> v a -> v b
G.map (forall a. Num a => a -> a -> a
subtract Double
m) forall a b. (a -> b) -> a -> b
$ Vector Double
samp
    m :: Double
m = forall (v :: * -> *). Vector v Double => v Double -> Double
mean Vector Double
samp
    n :: Double
n = 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 forall a. Num a => a -> a -> a
+ Double
ar forall a. Num a => a -> a -> a
- (Double
b forall a. Num a => a -> a -> a
* Double
b) forall a. Fractional a => a -> a -> a
/ Double
q) forall a. Fractional a => a -> a -> a
/ (Double
q forall a. Num a => a -> a -> a
- Double
c)
      where b :: Double
b = Double
bl forall a. Num a => a -> a -> a
+ Double
br
            q :: Double
q = Double
n forall a. Num a => a -> a -> a
- Double
1
    len :: Int
len = 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
  | forall (v :: * -> *) a. Vector v a => v a -> Int
G.length Vector Double
samp forall a. Eq a => a -> a -> Bool
== Int
2  = 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 = forall (v :: * -> *) a b.
(Vector v a, Vector v b) =>
(a -> b) -> v a -> v b
G.map forall a. Floating a => a -> a
sqrt 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 = forall (v :: * -> *) a b.
(Vector v a, Vector v b) =>
(a -> b) -> v a -> v b
G.map KBNSum -> Double
kbn forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (v :: * -> *) a b.
(Vector v a, Vector v b) =>
(a -> b -> a) -> a -> v b -> v a
G.scanl forall s. Summation s => s -> Double -> s
add forall s. Summation s => s
zero

pfxSumR :: U.Vector Double -> U.Vector Double
pfxSumR :: Vector Double -> Vector Double
pfxSumR = forall (v :: * -> *) a. Vector v a => v a -> v a
G.tail forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (v :: * -> *) a b.
(Vector v a, Vector v b) =>
(a -> b) -> v a -> v b
G.map KBNSum -> Double
kbn forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (v :: * -> *) a b.
(Vector v a, Vector v b) =>
(a -> b -> b) -> b -> v a -> v b
G.scanr (forall a b c. (a -> b -> c) -> b -> a -> c
flip forall s. Summation s => s -> Double -> s
add) 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 :: forall e. Unbox e => Int -> Vector e -> Vector e
dropAt Int
n Vector e
v = forall a. Unbox a => Int -> Int -> Vector a -> Vector a
U.slice Int
0 Int
n Vector e
v forall a. Unbox a => Vector a -> Vector a -> Vector a
U.++ forall a. Unbox a => Int -> Int -> Vector a -> Vector a
U.slice (Int
nforall a. Num a => a -> a -> a
+Int
1) (forall a. Unbox a => Vector a -> Int
U.length Vector e
v forall a. Num a => a -> a -> a
- Int
n forall a. Num a => a -> a -> a
- Int
1) Vector e
v

singletonErr :: String -> a
singletonErr :: forall a. String -> a
singletonErr String
func = forall a. HasCallStack => String -> a
error forall a b. (a -> b) -> a -> b
$
                    String
"Statistics.Resampling." forall a. [a] -> [a] -> [a]
++ String
func 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 forall a. Ord a => a -> a -> Bool
<= Int
0    = forall (m :: * -> *) a. Monad m => a -> m a
return []
  | Bool
otherwise =
  forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (GenIO
genforall a. a -> [a] -> [a]
:) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
replicateM (Int
nforall a. Num a => a -> a -> a
-Int
1) forall a b. (a -> b) -> a -> b
$
  forall (m :: * -> *) (v :: * -> *).
(PrimMonad m, Vector v Word32) =>
v Word32 -> m (Gen (PrimState m))
initialize forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< (forall (m :: * -> *) g a (v :: * -> *).
(PrimMonad m, StatefulGen g m, Uniform a, Vector v a) =>
g -> Int -> m (v a)
uniformVector GenIO
gen Int
256 :: IO (U.Vector Word32))